Challenge 33 (liste <-> arbre)

(gile) · le 1 décembre 2010

Salut,

Ce sujet m'a donné une idée de challenge.

Pour représenter une arborescence, on peut, soit utiliser une liste constituée des "chemins complets" de toutes les entrées :

(setq lst
      '(("1" "1.1" "1.1.1")
 ("1" "1.1" "1.1.2")
 ("1" "1.2")
 ("1" "1.3" "1.3.1" "1.3.1.1")
 ("1" "1.3" "1.3.1" "1.3.1.2")
 ("2")
 ("3" "3.1")
 ("3" "3.2" "3.2.1")
 ("3" "3.2" "3.2.2")
 ("3" "3.2" "3.2.3")
)
)

soit utiliser une liste de sous-listes dont chaque premier élément représente un nœud dans l'arborescence:

(setq tree
      '(("1"
  ("1.1"
   ("1.1.1")
   ("1.1.2")
  )
  ("1.2")
  ("1.3"
   ("1.3.1"
    ("1.3.1.1")
    ("1.3.1.2")
   )
  )
 )
 ("2")
 ("3"
  ("3.1")
  ("3.2"
   ("3.2.1")
   ("3.2.2")
   ("3.2.3")
  )
 )
)
)

Ce challenge consiste donc à créer deux routines : une qui transformerait lst en tree et une autre qui ferait la transformation inverse :

(lst2tree lst) => tree

(tree2lst tree) => lst

Tramber · le 1 décembre 2010

Salut !

Avec le peu de moyens que j'ai, j'arrive facilement à isoler :

(("1" "1.3" "1.3.1" "1.3.1.1") ("1" "1.3" "1.3.1" "1.3.1.2") ("1" "1.1" "1.1.1") ("1" "1.1" "1.1.2") ("1" "1.2"))

et ainsi de suite pour "2" et "3".

Mais j'avoue que je bloque à traiter cette liste. Ce qui, selon moi, revient au problème principal.

Bref, ma langue au chat à quart-parcours ! Mais je regarde encore un peu :cool:

(gile) · le 2 décembre 2010

Un petit 'up' et un petit coup de pouce.

Quand il s'agit de traiter un nombre indéterminé d'imbrications, je pense tout de suite : récursivité.

Tramber · le 3 décembre 2010

Sans blague :cool:

Allez Tramber, reprends du café :cool:

ElpanovEvgeniy · le 3 décembre 2010

Merci! :)

J'adore ces discussions.

J'ai hâte aux premières décisions...

(gile) · le 3 décembre 2010

Salut Evgeniy,

Je suis content que tu participes.

J'attends aussi pour poster mes réponses.

Patrick_35 · le 3 décembre 2010

Salut

Quand il s'agit de traiter un nombre indéterminé d'imbrications, je pense tout de suite : récursivité.

Je ne vois pas comment faire autrement.

C'est l'un des cas qui impose la récursivité, mais je manque de temps en ce moment.

ps : une partie de la solution doit se trouver dans le lien que tu as donné ;)

@+

sbosarl · le 3 décembre 2010

bonjour,

 (defun c:listtest ()
(setq list00
      '(("1" "1.1" "1.1.1")
 ("1" "1.1" "1.1.2")
 ("1" "1.2")
 ("1" "1.3" "1.3.1" "1.3.1.1")
 ("1" "1.3" "1.3.1" "1.3.1.2")
 ("2")
 ("3" "3.1")
 ("3" "3.2" "3.2.1")
 ("3" "3.2" "3.2.2")
 ("3" "3.2" "3.2.3")
)
)
;(princ list00)
(setq ix 0 iy 0)
(repeat (length list00)
	(setq fichet1 (nth ix list00))
	(setq iy 0)
	(repeat (length fichet1)
	(setq fichet2 (nth iy fichet1))
	(setq iy (+ iy 1))
	(princ "\n")(princ fichet2);(princ (cdr fichet2))
	
	)

	(setq ix (+ ix 1))
))

(gile) · le 3 décembre 2010

Bien essayé sbosarl, mais le but du jeu est de définir une routine qui, quand on lui passe une liste de type lst retourne une liste imbriquée de type tree et/ou la routine inverse.

bonuscad · le 4 décembre 2010

Bon pour une fois, j'essaye de participer au challenge.

Puiff ! pas facile.

Je suis bien arrivé a quelque chose, mais mon arbre est imbriqué à l'envers.

Je livre quand même mon bout de code bien qu'il ne réponde pas à la demande, je me suis bien grillé les neurones...

(defun lst2tree (lst / tmp_l lx l_t)
 (while (setq lx (mapcar 'car lst))
   (while (car lx)
     (setq
       l_t (cons (car lx) (vl-remove nil l_t))
       lx (vl-remove (car lx) lx)
     )
   )
   (if (setq lst (vl-remove nil (mapcar 'cdr lst)))
     (setq l_t (cons (list l_t) (lst2tree lx)))
     (setq lst nil)
   )
 )
 (vl-remove nil l_t)
)

(gile) · le 4 décembre 2010

Je l'accorde, ce challenge n'est pas facile.

Peut-être est un peu moins compliqué dans l'autre sens (tree -> lst), je ne saurais dire...

En tout cas je suis content que certains participent, j'attends encore pour poster mes réponses.

VDH-Bruno · le 4 décembre 2010

Bonsoir,

Je me suis un peu essayé sur ce chalenge, force et de constater que je suis encore un peu tendre pour ce type d’exercice.

Faute de pouvoir présenter un code fonctionnel, je peux essayer de vous donné la direction dans laquelle je suis partie.

Pour (tree -> lst)

Je me suis représenté l’arbre graphiquement (ce qui me laisse croire que nil et la clef) , dans ma tentative de codage je parcours toutes ses extrémités sans problème de façon récursive avec car et cdr.

Ce que je n’arrive pas à implémenter dans mes appels récursifs c’est le stockage de la parenté, pour que :

Si une feuille est suivi d’un nil --> renvoyer la feuille (atome) et tous ses parents dans une liste.

Si un nil est suivi d’un nil --> renvoyer nil.

Pour (lst-> tree), J’ai pas encore vraiment commencé à coder

Il m’apparait que la clef du problème ce situe sur la répétition des termes, je pense regarder une solution qui mettrais la liste à plat (tous les éléments aux mêmes niveaux), puis avec member (comme fonction de teste de présence d’un élément d’un la liste). Tenter une reconstruction de cette dernière en commençant par la fin.

Voilà ce que j’ai de plus simple en tête mais je n’arrive pas à le coder même de façon maladroite, en espérant être meilleur pour de prochains chalenges.

Carboleum · le 5 décembre 2010

(defun bl:uniq (lst)
(if (cdr lst) 
	(cons (car lst) (bl:uniq (vl-remove (car lst) (cdr lst))))
   lst))

(defun bl:massoc (n lst)
(mapcar 'cdr (vl-remove-if-not '(lambda (el) (= n (car el))) lst)))

(defun bl:lst->tree (lst)
(cond
	((not (car lst)) nil)
	(t (mapcar
		'(lambda (el / m) (cons el (bl:lst->tree (bl:massoc el lst))))
		(bl:uniq (mapcar 'car lst))))))

Bon, j'imagine qu'il y a plus esthétique, mais ça marche bien ;-)

Command: (lst->tree lst)
(("1" ("1.1" ("1.1.1") ("1.1.2")) ("1.2") ("1.3" ("1.3.1" ("1.3.1.1") 
("1.3.1.2")))) ("2") ("3" ("3.1") ("3.2" ("3.2.1") ("3.2.2") ("3.2.3"))))

Petite explication:

uniq renvoie la liste sans les doublons:

(uniq (mapcar 'car lst)) -> ("1" "2" "3")

massoc est une sorte de fonction assoc multiple, et renvoie tous les cdr des listes dont le car vaut la valeur en argument:

(massoc "3" lst) -> (("3.1") ("3.2" "3.2.1") ("3.2" "3.2.2") ("3.2" "3.2.3"))

lst->tree renvoie, pour chaque valeur unique des car de la liste, l'assoc multiple de cette valeur issus de la liste. Si ces résultats sont des listes, on refait appel à lst->tree. Et ainsi de suite jusqu'à ce qu'il n'y ait plus de liste.

C'est pas très clair, mais j'ai toujours eu du mal à exprimer une fonction récursive en français ;-)

[Edité le 5/12/2010 par Carboleum]

(gile) · le 5 décembre 2010

Bravo !

C'est exactement l'algo que j'utilise :

(defun gc:lst2tree	(lst)
 (if (car lst)
   (mapcar '(lambda (x)
       (cons x (gc:lst2tree (gc:massoc x lst)))
     )
    (gc:remove_doubles (mapcar 'car lst))
   )
 )
)

(defun gc:massoc (code alst)
 (if (setq alst (member (assoc code alst) alst))
   (cons (cdar alst) (gc:massoc code (cdr alst)))
 )
)

(defun gc:remove_doubles (lst)
 (if lst
   (cons (car lst) (gc:remove_doubles (vl-remove (car lst) lst)))
 )
)

Comme toi je ne trouve pas ça très élégant, j'ai essayé de n'en faire qu'une routine, mais résultat semble beaucoup plus lent.

(defun gc2:lst2tree (lst)
 (if (car lst)
   (cons
     (cons (caar lst)
    (if	(cdar lst)
      (gc2:lst2tree (mapcar 'cdr
		 (vl-remove-if-not
		   '(lambda (x) (= (car x) (caar lst)))
		   lst
		 )
	 )
      )
    )
     )
     (gc2:lst2tree (vl-remove-if
   '(lambda (x) (= (car x) (caar lst)))
   lst
 )
     )
   )
 )
)

Carboleum · le 5 décembre 2010

C'est exactement l'algo que j'utilise :

Les grands esprits se rencontrent ;-)

(gile) · le 5 décembre 2010

Il reste la fonction inverse et j'attends avec impatience la leçon que va immanquablement nous donner Evgeniy.

VDH-Bruno · le 14 décembre 2010

Bonjour,

La fonction inverse basée sur l’algorithme décrit précédemment (le codage fut laborieux..).

(defun bv:tree2lst (Ltree / L t2l)
 (defun t2l (LtP Lt)
   (cond
     ((null Lt) (setq L (cdr L)) nil)
     ((atom Lt) (setq L (cons Lt L)) (if (null (cdr LtP)) (list L)))
     (T (append (t2l  Lt (car Lt)) (t2l nil (cdr Lt))))
   )
 )
 (mapcar 'reverse (t2l nil Ltree))
)

A l’occasion je me pencherai sur les optimisations.. Car cela reste trés lent au regard de la fonction réciproque livré précédemment (plus un problème du à un algorithme un peu trop "naïf", qu'aux imbrications de listes).

Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):

(GC:LST2TREE LST).......1532 / 27.53
(BV:TREE2LST TREE).....42172 / 1.00

Edit du 14/06/2011 : Simplifié l’expression (t2l (setq LtP Lt) (car Lt)) en (t2l Lt (car Lt))

[Edité le 14/6/2011 par VDH-Bruno]

(gile) · le 14 décembre 2010

Super :D :D

Je suis carrément impressionné par la vitesse à laquelle tu a appris !

cela reste trés lent au regard de la fonction réciproque livré précédemment

Je pense que c'est surtout dû au fait que tu devais avoir fait (trace t2l) avant de lancer ton benchmark. C'est l'écriture dans la fenêtre de suivi qui ralentit considérablement l'exécution.

Ton code est très bien.

Comme ça ne se bouscule pas au portillon, je donne ce que j'avais fait :

(defun gc:tree2lst (tree)
 (apply
   'append
   (mapcar
     '(lambda (n)
 (if (cdr n)
   (mapcar
     '(lambda (x) (cons (car n) x))
     (gc:tree2lst (cdr n))
   )
   (list n)
 )
      )
     tree
   )
 )
)

VDH-Bruno · le 15 décembre 2010

Merci (gile),

Je suis carrément impressionné par la vitesse à laquelle tu a appris !

Tu peux t’en féliciter, disons que je m’efforce de comprendre (souvent dans la douleur) deux trois petites choses qui me semblent essentiel, et pour ça ta disponibilité sur ce forum est d’un grand secours.

tu devais avoir fait (trace t2l) avant de lancer ton benchmark

Oupss !! Bien vu effectivement c'était ça..

J’ai recommencé mon benchmark, les résultats sont plus en adéquation avec mes espérances. :)

Comme quoi dans certains cas même avec des appels récursifs plus profonds, le résultat n’est pas plus lent si les traitements sont plus immédiats..

[Edité le 15/12/2010 par VDH-Bruno]

VDH-Bruno · le 14 juin 2011

Bonjour,

Je revisite ce challenge étant bien incapable à l’époque d’écrire la fonction réciproque bv:lst2tree ( même si j’avais l’intuition qu’une autre voie bien plus simple était possible…)

Je publie donc aujourd’hui ma solution, elle utilise deux fonctions mutuellement récursives afin d’économiser des allers et retours inutiles dans le traitement de la liste fourni en argument ( au benchmark le traitement est 2 fois plus rapide).

 
(defun bv:lst2tree (lst / tree etete)

  (defun tree (lst)
   (cond
     ((null lst) nil)
     ((= (caar lst) (caadr lst))
      ((lambda (x) (cons (cons (caar lst) (tree (car x))) (cdr x)))
            (etete lst)
      )
     )
     (T (cons (car lst) (tree (cdr lst))))
   )
 )

 (defun etete (lst)
   (if     (= (caar lst) (caadr lst))  
     ((lambda (acc) (cons (cons (cdar lst) (car acc)) (cdr acc)))
           (etete (cdr lst))
     )
     (cons (list (cdar lst)) (tree (cdr lst)))
   )
 )

 (tree lst)
)

Pour le fun, je donne également une version plus «fonctionnelle» de bv:tree2lst que celle donné précédemment ( au passage j’ai corrigé cette version), contrairement à la version précédent la liste lst ne se construit plus à la descente mais à la remonté des appels..

 
(defun bv:tree2lst (tree)
 (cond
   ((null tree) nil)
   ((atom tree) tree)
   (T
    ((lambda (a d)
           (cond
              ((and (atom a) d)(mapcar '(lambda (x) (cons a x)) d))
              ((or (atom a) (atom (car a))) (cons a d)) 
              (T  (append a d))
           )
     )
      (bv:tree2lst (car tree))
      (bv:tree2lst (cdr tree))
    )
   )
 )
)

(gile) · le 14 juin 2011

Chapeau bas !...

VDH-Bruno · le 14 juin 2011

Merci (gile) je tempérerai tout de même en rappelant qu’il m’aura tout de même fallu 6 mois.. :casstet:

Et avouer que si tu ne m’avais pas fait comprendre certains concepts clef du Lisp, je chercherai encore.. Alors chapeau bas à toi également !.. ;)

VDH-Bruno · le 15 juin 2011

Bonjour,

Chalenge oblige, un petit point me titillais, je n’étais pas totalement satisfait de ma version bv:lst2tree.

Je donne donc une nouvelle version optimisant les appels de fonctions ( modification d’un appel que je qualifiais de fainéant), et hop + 10% au benchmark :D , et au traçage des fonctions ça fait tout de même plus beau.. ;)

 
(defun bv:lst2tree (lst / tree etete)

 (defun tree (lst)
   (cond
     ((null lst) nil)
     ((= (caar lst) (caadr lst))
      ((lambda (x) (cons (cons (caar lst) (tree [b](cons (cdar lst) (car x)))[/b]) (cdr x)))
            (etete [b](cdr lst)[/b])
      )
     )
     (T (cons (car lst) (tree (cdr lst))))
   )
 )

 (defun etete (lst)
   (if  (= (caar lst) (caadr lst))  
     ((lambda (acc) (cons (cons (cdar lst) (car acc)) (cdr acc)))
           (etete (cdr lst))
     )
     (cons (list (cdar lst)) (tree (cdr lst)))
   )
 )

 (tree lst)
)

Ps: Me voilà un peu plus à la hauteur du chapeau bas de (gile)

Connexion

Challenge 33 (liste <-> arbre)

Messages recommandés

(gile)

Tramber

(gile)

Tramber

ElpanovEvgeniy

(gile)

Patrick_35

sbosarl

(gile)

bonuscad

(gile)

VDH-Bruno

Carboleum

(gile)

Carboleum

(gile)

VDH-Bruno

(gile)

VDH-Bruno

VDH-Bruno

(gile)

VDH-Bruno

VDH-Bruno

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante