Challenge

[Patrick_35]

Bonjour

 

Une idée de challenge (Ca faisait longtemps)

C'est d'associer deux listes et de savoir si une même personne fait plusieurs choses.

 

Exemples :

(asso '("pierre" "patrick" "sébastien" "sophie" "patrick" "julie") '("compta" "be" "chantier" "secrétaire" "autocad" "facturation")) --> (("pierre" "compta") ("patrick" "be" "autocad") ("sébastien" "chantier") ("sophie" "secrétaire") ("julie" "facturation"))

(asso '("pauline" "mathieu" "pauline" "jym" "feat") '("phylo" "algebre" "math" "python" "archi")) --> (("pauline" "phylo" "math") ("mathieu" "algebre") ("jym" "python") ("feat" "archi"))

(asso '("e1" "e2" "e4" "e3" "e2" "e5") '("c1" "c2" "c3" "c4" "c5" "c6")) --> (("e1" "c1") ("e2" "c2" "c5") ("e4" "c3") ("e3" "c4") ("e5" "c6"))

 

@+

[bonuscad]

Bonjour,

 

A mon avis pas vraiment un chalenge car la fonction de base fait cela très bien: (mapcar 'list liste1 liste2)

 

(mapcar 'list
'("pierre" "patrick" "sébastien" "sophie" "patrick" "julie" "toto")
'("compta" "be" "chantier" "secrétaire" "autocad" "facturation")
)

 

Edit: Je crois que je n'ai pas compris... (lu trop vite)

question: comment sait tu que par exemple? ("patrick" "be" "autocad")

Il n'y a pas de données d'entrée permettant de connaitre cet état!

[Patrick_35]

Salut

 

Sauf que tu n'as pas regroupé les deux patrick

On considère que chaque élément d'une liste corresponds à l'autre

 

@+

[(gile)]

Bump !

[bonuscad]

Comme j'ai donné une réponse incomplète, je donne une version qui est surement perfectible.

 

(defun asso (l1 l2 / lst dbl)
(setq lst
	(mapcar 'list
		l1
		l2
	)
)
(foreach n lst
	(if (setq dbl (member (assoc (car n) (cdr (member n lst))) (cdr (member n lst))))
		(setq
			lst (vl-remove (car (member n lst)) lst)
			lst (subst (list (caar dbl) (cadr n) (cadar dbl)) (assoc (car n) lst) lst)
		)
	)
)
lst
)

 

Edit : Je m'incline bien sur devant (gile) qui l'a fait sous une forme récursive

(J'avais pas vu qu'il l'avais posté sur test)

Ma version s'arrête à la double activité, si il y a une triple activité (dans les choux)

Avec sa forme récursive (gile) traite bien les liste...

Modifié le 28 septembre 2015 par bonuscad

[Patrick_35]

Bravo pour ta double récursive (gile). Toujours au top :D

 

Bravo Bonus, mais si tu as plus de deux doublons dans la liste des personnes, cela ne fonctionne plus.

(asso '("pierre" "patrick" "sébastien" "sophie" "patrick" "julie" "patrick") '("compta" "be" "chantier" "secrétaire" "autocad" "facturation" "grumph..je reste poli"))

 

@+

 

ps : comme d'habitude, je reste sur des itératives ;)

 

pps : Bonus, je sais que tu vas le faire :D

Modifié le 28 septembre 2015 par Patrick_35

[bonuscad]

Bonus, je sais que tu vas le faire

Alors sous forme itérative.

 

(defun asso (l1 l2 / nwlst)
 (foreach n (mapcar 'list l1 l2)
   (cond
     ((assoc (car n) nwlst)
       
       (setq nwlst (subst (append (assoc (car n) nwlst) (list (cadr n))) (assoc (car n) nwlst) nwlst))
     )
     (T
       (setq nwlst (cons n nwlst))
     )
   )
 )
 (reverse nwlst)
)

 

Ce coup-ci devrait faire plus que les doublon ;)

[Patrick_35]

Bravo Bonus, la tienne est plus concise que la mienne

 

(defun asso (l1 l2 / a b e l n)
 (setq l (mapcar 'list l1 l2))
 (while l
   (setq e (car l)
  l (cdr l)
   )
   (while (setq n (assoc (car e) l))
     (setq a (cons (cadr n) a)
    l (vl-remove n l)
     )
   )
   (and a (setq e (append e (reverse a))))
   (setq a nil
  b (append b (list e))
   )
 )
)

 

@+

[(gile)]

Bump ! Bump !

[GEGEMATIC]

Salut,

si j'ai bien compris, j'en ai deux pour ça :

regroup assoc

REGROUP_ASSOC_MULTI

Pour la concision,

vous me battez à plate couture !

(defun pw_regroup_assoc ( lassoc / res l tmp nl cd pairpoint)
 (foreach l lassoc
   (setq pairpoint (pw_estpairpoint l))
   ;;si déja répertorié
   (if (setq tmp (assoc (setq cd (car l)) res))
     (progn
(if pairpoint
 (setq nl (append tmp (list (cdr l))))
 (setq nl (append tmp (list (cadr l))))
)
(setq res (subst nl tmp res))
     )
     (if pairpoint
(setq res (cons (list (car l)(cdr l)) res))
(setq res (cons l res))
     )
    )
   )
 (reverse res)
)

et

(defun pw_regroup_assoc_multi ( lassoc / res l tmp nl cd)
 (foreach l lassoc
   ;;si déja répertorié
   (if (setq tmp (assoc (setq cd (car l)) res))
     (progn
(setq nl (append tmp (list (cdr l))))
(setq res (subst nl tmp res))
     )
     (progn
(setq res (cons (list (car l) (cdr l)) res))
     )
    )
   )
 (reverse res)
)

[(gile)]

Salut,

 

Je mets ici celles que j'avais si mal cachées là.

 

(defun asso (l1 l2 / massoc group)
 (defun massoc (k l)
   (if (setq l (member (assoc k l) l))
     (cons (cadar l) (massoc k (cdr l)))
   )
 )
 (defun group (l / k)
   (if (setq k (caar l))
     (cons (cons k (massoc k l))
           (group (vl-remove-if '(lambda (x) (= k (car x))) l))
     )
   )
 )
 (group (mapcar 'list l1 l2))
)

 

Avec une fonction auxillaire à recursion terminale (tail recursive) :

 

(defun asso (l1 l2 / loop)
 (defun loop (l1 l2 acc / sub)
   (if	l1
     (loop
(cdr l1)
(cdr l2)
(if (setq sub (assoc (car l1) acc))
  (subst (append sub (list (car l2))) sub acc)
  (cons (list (car l1) (car l2)) acc)
)
     )
     (reverse acc)
   )
 )
 (loop l1 l2 nil)
)

 

Si la machine LISP d'AutoCAD optimisait la recursion terminale, la fonction ci-dessus n'atteindrait jamais de "dépassement de la pile" (stack overflow) parce qu'elle serit interprétée comme la fonction itérative ci-dessous :

 

(defun asso (l1 l2 / sub res)
 (while l1
   (setq res (if (setq sub (assoc (car l1) res))
	(subst (append sub (list (car l2))) sub res)
	(cons (list (car l1) (car l2)) res)
      )
  l1  (cdr l1)
  l2  (cdr l2)
   )
 )
 (reverse res)
)

[VDH-Bruno]

Bonjour,

 

Le retour des challenges super!!! Pour saluer cette initiative ma petite contribution…

La première qui vient à l'esprit pour sa concision (à condition d'avoir une bibliothèque de fonction prédéfinie bien fournie), avec massoc et remove_doubles(/distinct), perso j'ai utilisé les fonctions de (gile) ici.

(defun asso (l m)
 (setq m (mapcar 'cons l m))
 (mapcar '(lambda (x) (append (list x) (gc:massoc x m))) (gc:distinct l))
)

(@Patrick_35: c'est l'écriture de l'algorithme décrit par stendhal666 sur le forum developpez.com, au passage il me semble qu'il faut ajouter un # devant 'cons pour que ton exemple soit compatible en Clisp ;-). Pour la syntaxe en Clisp http://www.lispworks.com/documentation/HyperSpec/Body/f_mapc_.htm)

 

 

Sinon pour une proposition de code plus personnel, avec une variante mutuellement récursive pour optimiser le parcours sans avoir recours à la bibliothéque de fonction vl- et n'employer principalement que les fonctions primitives du lisp que sont car, cdr, cons..,

(defun asso (l m / g f)
 (defun f (a acc l m)
   (cond ((null l) (list (cons a acc)))
         ((member a l) (g acc l m nil nil))
         (T (cons (cons a acc) (f (car l) (list (car m)) (cdr l) (cdr m))))
   )
 )
 (defun g (acc l1 m1 l2 m2)
   (if (eq a (car l1))
     (f a (cons (car m1) acc) (append l2 (cdr l1)) (append m2 (cdr m1)))
     (g acc (cdr l1) (cdr m1) (cons (car l1) l2) (cons (car m1) m2))
   )
 )
 (f (car l) (list (car m)) (cdr l) (cdr m))
)

 

Pour le jeu et pour ceux qui considèreraient que j'ai pris des libertés avec l'emploi de member et append, ci-dessous des versions "equivalentes" :-)

(defun e-member (e l)
 (cond ((null l) nil)
       ((equal e (car l)) l) ;ou eq 
       (T (e-member e (cdr l)))
 )
)

(defun e-append (l m)
 (if l
   (cons (car l) (e-append (cdr l) m))
   m
 )
)

 

(Ps: Désolé de n'avoir pu participer dans les temps, un rapide coup d'œil sur l'autre challenge me fait penser que ça m'étonnerai que je puisse encore inscrire quelques lignes de code donc toutes mes félicitations aux participants)

 

Amicalement Bruno