Trier/Ranger une liste.

Bred · le 19 décembre 2006

Salut,

Je n'y arrive pas !!!!

j'ai une liste sous la forme :

((243.62 . < Nom d'entité: 7ef6df58 >) (24.25 . < Nom d'entité: 7ef990f8 >) (243.62 . < Nom d'entité: 7ef991b0 >) (243.62 . < Nom d'entité: 7ef991b8 >) (24.25 . < Nom d'entité: 7ef991c0 >) ...etc....)

et je voudrais la rangée sous la forme :

((243.62 . < Nom d'entité: 7ef6df58 >< Nom d'entité: 7ef991b0 >< Nom d'entité: 7ef991b8 >) (24.25 . < Nom d'entité: 7ef990f8 > < Nom d'entité: 7ef991c0 >) ...etc....)

j'ai essayé (foreach... , (mapcar .... mais j'avoues planter sur la logique....

Pour expliquer plus précisement : j'ai une sélection de bloc que je range en liste de manière à avoir en sous liste : (coordX_ent1 . ent1)

(setq sel (ssget '((0 . "INSERT"))))
(repeat (sslength sel)
 (setq lst (append	      
	(list
	  (cons
	  (car (cdr (assoc 10 (entget (ssname sel x)))))
	  (cdr (assoc -1 (entget (ssname sel x)))))) lst)	
x (+ 1 x)
)
 )

Puis je veux ranger cette liste de manière que tous les blocs ayant le même X soit regroupés ensemble. ((coordX_ent1 ent1 ent2 ent3)(coordX_ent4 ent5 ent6 ent7)...)

merci de votre aide!

[Edité le 19/12/2006 par Bred]

Patrick_35 · le 19 décembre 2006

Salut

(while sel
 (setq lst (append lst (list (cons (caar sel) (mapcar 'cdr (vl-remove-if-not '(lambda(x) (eq (car x) (caar sel))) sel)))))
       sel (vl-remove-if '(lambda(x) (eq (car x) (caar sel))) sel))
)
(setq sel lst)

@+

[Edité le 19/12/2006 par Patrick_35]

Tramber · le 19 décembre 2006

(setq lis (list(list 243.62  "7ef6df58")
    (list 24.25  "7ef6df58") (list 243.62  "7ef6df58")
    (list 243.62  "7ef6df58") (list 24.25  "7ef6df58")(list 18  "7ef6df58")))
(setq lis(vl-sort lis(function (lambda (e1 e2)((setq lisortie nil prem(car lis) lis(cdr lis))
(while lis; boucle sur la totalité -1
 (if(=(car prem)(car(car lis)))
   (setq prem(append prem(cdr (car lis))))
   (setq lisortie(append lisortie(list prem))prem(car lis)))
 (setq lis(cdr lis))
 )
(setq lisortie(append lisortie(list prem)))

renvoie :

((18 "7ef6df58") (24.25 "7ef6df58" "7ef6df58") (243.62 "7ef6df58" "7ef6df58" "7ef6df58"))

Tramber · le 19 décembre 2006

Tiens, doublé !

Mon code est plus didactique car il traite la liste après ta sélection, mais avec Patrick, t'as quelque chose de tout fait à glisser dans ta fonction, veinard !

(gile) · le 19 décembre 2006

Un peu en retard mais je réponds quand même

(defun test (lst)
 (if lst
   (cons
     (cons (caar lst)
    (mapcar
      'cdr
      (vl-remove-if-not '(lambda (x) (= (caar lst) (car x))) lst)
    )
     )
     (test
(vl-remove-if '(lambda (x) (= (caar lst) (car x))) lst)
     )
   )
 )
)

(test '((1 . "a") (2 . "b") (3 . "c") (1 . "d") (3 . "e"))) retourne ((1 "a" "d") (2 "b") (3 "c" "e"))

[Edité le 19/12/2006 par (gile)]

Bred · le 19 décembre 2006

Rassurer moi.... vous aviez ces bouts de routine classé quelque part, hein ??? ou vous venez de me les taper à la volée ?

(attention : votre réponse peut gravement atteindre ma santé mentale, et me sentir abaisser au viveau de l'amibe !....)

(Par contre il y a un souci de parenthèse au code de Patrick_35... Hoouuuu ! ) ;) ....)

merci !!!!

Bred · le 19 décembre 2006

Mon dieu !! et (gile) qui me sort une fonction récursive les doigts dans le nez....

Bon.... je vais en rester à expliquer comment fairedes drapeaux japonnais, moi, c'est beaucoup plus de mon niveau !!! (snif!) :(

merci²

bonuscad · le 19 décembre 2006

Et j'y vais de mon bout de code aussi :P

(setq x_order (mapcar 'min (mapcar 'car lst)))
(foreach n x_order
(setq lst_result (cons (assoc n lst) lst_result))
)

Patrick_35 · le 19 décembre 2006

ou vous venez de me les taper à la volée ?

Ben, à la demande :D

La preuve --> (Par contre il y a un souci de parenthèse au code de Patrick_35... Hoouuuu ! )

et donc c'est corrigé ;)

Tiens, doublé !

C'est le hazard

@+

ps : et en regardant le code de (gile), je viens de me rendre compte que j'avais oublié la fonction caar, je re-corrige

Patrick_35 · le 19 décembre 2006

A ce rythme, j'en connais un qui va perdre ses cheveux :cool:

ps : ma fonction est elle aussi récursive ;)

@+

[Edité le 19/12/2006 par Patrick_35]

(gile) · le 19 décembre 2006

En tout cas merci Bred pour ce petit "contest".

ma fonction est elle aussi récursive

Stricto sensu, je dirais non, while est plutôt une fonction itérative.

En informatique et en logique, une fonction ou plus généralement un algorithme qui contient un appel à elle-même est dite récursive.

source Wikipedia

Mais les deux fonctions se ressemblent beaucoup.

Patrick_35 · le 19 décembre 2006

Oui, exacte

Je pensais au résutat de la variable comme au résultat de la fonction

Erratum

@+

Bred · le 19 décembre 2006

Bon, alors, dans le désordre :

- bonuscad : merci - mais ta routine ne donne pas le bon classement (je pense - après tests)

- Patrick_35 : merci - mais j'ai un souci pour la faire fonctionner : tu fait un (car sel) dans ta routine, avec sel étant un " < selection set ... > ", donc ça bug....

- Trambert : merci - ça fonctionne (en adaptant ma liste comme tu la construit)

(repeat (sslength sel)
 (setq lis (append	      
	(list
	  (list
	  (car (cdr (assoc 10 (entget (ssname sel x)))))
	  (cdr (assoc -1 (entget (ssname sel x)))))) lis)	
x (+ 1 x)
)
 )

- (gile) : merci - mais c'est parfait.

.... bon, les gars.... je décrete qu'à partir de cette heure, je rentre en dépréssion !!!!

Patrick_35 · le 19 décembre 2006

Il faut que la variable sel soit ta liste à traiter

Pour ce qui est de la dépression, je pense qu'elle peut attendre. Garde la pour que la neige tombe pour ceux qui partent au ski ;)

@+

(gile) · le 19 décembre 2006

Re,

Petite correction : il faut une tolérance pour comparer les coordonnées (equal ... 1e-9)

Petite proposition : traiter directement la liste (ssnamex sel).

(defun test (lst)
 (if lst
   (cons
     (cons (caar lst)
    (mapcar
      'cdr
      (vl-remove-if-not '(lambda (x) (equal (caar lst) (car x) 1e-9)) lst)
    )
     )
     (test
(vl-remove-if '(lambda (x) (equal (caar lst) (car x) 1e-9)) lst)
     )
   )
 )
)

(if (setq sel (ssget '((0 . "INSERT"))))
 (setq
   lst	(test
  (mapcar '(lambda (x) (cons (cadr (assoc 10 (entget x))) x))
	  (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel)))
  )
)
 )
)

Et ne déprime pas, tu as appris à un vitesse considérable (et je suis content d'avoir participé avec les autres à tes progrès), mais pendant ce temps, nous aussi on essayait de progresser ;)

[Edité le 19/12/2006 par (gile)]

Bred · le 19 décembre 2006

Il faut que la variable sel soit ta liste à traiter

A un moment c'est ce que je faisais, mais j'avais un résultat bizarre... jusquà ce que je passe lst à nil avant...

Tu veux vraiment m'enfoncer on dirait, à me faire des trucs comme ça! :(

Pour ce qui est de la dépression, je pense qu'elle peut attendre. Garde la pour que la neige tombe pour ceux qui partent au ski

... Tiens.... il neige.... (... et non, pas encore : mais les sommets sont blancs.... comme quelques cheveux suplémentaire depuis quelque minute...)

MERCI !

--------------------------------

edit - croisement (gile)

--------------------------------

c'est vraiment le genre de routine que je trouve génial : à l'égal de ton post sur les matrices, (gile)... tiens.... une idée.... ce genre de routine de classement ne pourrais pas faire partis d'un post réalisé par l'un des Merveilleux lispeur que vous êtes ??? (slurp !) ;) avec des exemples du même type ....

[Edité le 19/12/2006 par Bred]

ElpanovEvgeniy · le 20 décembre 2006

Bon, alors, dans le désordre :

(repeat (sslength sel)
 (setq lis (append	      
	(list
	  (list
	  (car (cdr (assoc 10 (entget (ssname sel x)))))
	  (cdr (assoc -1 (entget (ssname sel x)))))) lis)	
x (+ 1 x)
)
 )

 (cdr (assoc -1 (entget (ssname sel x)))) = (ssname sel x)

Patrick_35 · le 20 décembre 2006

Tu veux vraiment m'enfoncer on dirait, à me faire des trucs comme ça! :(

Au moins, tu cherches à comprendre et à approfondir la routine ;)

@+

Bred · le 20 décembre 2006

(cdr (assoc -1 (entget (ssname sel x)))) = (ssname sel x)

Bien-sûr !!!!...

merci.... !

(c'est bon, arrêtezr ! vous m'avez achevé !!!) :P

Bred · le 20 décembre 2006

J'ai essayer de comprendre la fonction de (gile).... et je rend ici ma conclusion (non arrété) si d'autre ont l'envies d'essayer de la comprendre....

J'ai compris (ce qui ne veux pas dire que je saurais remettre en place un code comme ça...) les fonctions de "traitement de liste"

(cons (caar lst)(mapcar'cdr (vl-remove-if-not '(lambda (x) (= (caar lst) (car x))) lst)))

(Création de la première liste)

et

(vl-remove-if '(lambda (x) (= (caar lst) (car x))) lst)

(enlève les éléments utilisés pour créer la liste précédement créer)

Puis j'ai essayé de comprendre le pourquoi du résultat de la récursivité....

J'ai re-trouvé l'exlication de (gile) ici....

Si j'utilise la console de suivi avec (fact test) et lst = '((1 . "a") (2 . "b") (3 . "c") (1 . "d") (3 . "e"))

j'obtient ça :

Saisie (TEST ((1 . "a") (2 . "b") (3 . "c") (1 . "d") (3 . "e")))
Saisie (TEST ((2 . "b") (3 . "c") (3 . "e")))
Saisie (TEST ((3 . "c") (3 . "e")))
Saisie (TEST nil)
Résultat: nil
Résultat: ((3 "c" "e"))
Résultat: ((2 "b") (3 "c" "e"))
Résultat: ((1 "a" "d") (2 "b") (3 "c" "e"))

Ce qui est juste....

J'ai eu du mal à comprendre pourquoi ça "empile" les résultats trouvés, dans ma logique ça aurait plûtot tendance à "écraser" le résultat précédent à chaque passage...

Puis j'ai compris que c'était le rôle du premier "cons"...

Donc la logique est parfaite :

- Création du début de la liste = (1 "a" "d")

- Retrait élément ayant servis à créer liste précédente, puis traitement par fonction TEST de la liste trouvé, donc Ajout à la première liste la seconde = ((1 "a" "d") (2 "b"))

- - Retrait élément ayant servis à créer liste précédente, puis traitement par fonction TEST de la liste trouvé, donc Ajout à la première liste la seconde = ((1 "a" "d") (2 "b") (3 "c" "e"))

...

c'est Fa-bu-leux !!!

... je rêve du jour où j'arriverais à mettre ça en place tout seul...

MERCI !!!!

[Edité le 21/12/2006 par Bred]

(gile) · le 20 décembre 2006

c'est Fa-bu-leux !!!

Hé oui, je trouve aussi qu'il y a quelque chose de magique avec la récursivité et surtout quelle élégance ! Ça me fait plaisir que tu partages cette sensibilité.

Une fois qu'on a bien pigé le principe, ce n'est pas plus difficile que ça à utiliser.

Un petit exemple plus simple à comprendre avec la fonction remove_doubles qui supprime les doublons dans une liste.

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

Pour évaluer une expression, l'interpréteur LISP doit d'abord évaluer l'expression la plus profondément imbriquée et en retourner le résultat comme argument à l'expression.

par exemple : (* 2 (+ 3 (/ 6 2))) -> (* 2 (+ 3 3)) -> (* 2 6) -> 12

avec une fonction récursive, l'évaluation retourne une nouvelle évaluation et un résultat n'est retourné que quand la condition d'arrêt est remplie (lst = nil pour remove_double) d'où la notion d'empilement/dépilement :

Empilement

(remove_doubles '(1 2 1 3 3))

(cons 1 (remove_doubles '(2 3 3)))

(cons 1 (cons 2 (remove_doubles '(3 3))))

(cons 1 (cons 2 (cons 3 (remove_doubles '()))))

Dépilement

(cons 1 (cons 2 (cons 3 nil)))

(cons 1 (cons 2 '(3)))

(cons 1 '(2 3))

(1 2 3)

Patrick_35 · le 20 décembre 2006

Moi, j'aurai plutôt cette préference ;)

(setq a '(1 2 1 3 3) b nil)
(while a
 (setq b (append b (list (car a)))
       a (vl-remove (car a) a))
)

Ce qui revient à peu près à la même chose, sauf que ce n'est pas une fonction mais sur la variable

@+

(gile) · le 21 décembre 2006

Moi, j'aurai plutôt cette préference

Oui, ça marche pareil.

Je pense que c'est bien une histoire de "préférence" entre deux tournures de style/tournures d'esprit.

Connexion

Trier/Ranger une liste.

Messages recommandés

Bred

Patrick_35

Tramber

Tramber

(gile)

Bred

Bred

bonuscad

Patrick_35

Patrick_35

(gile)

Patrick_35

Bred

Patrick_35

(gile)

Bred

ElpanovEvgeniy

Patrick_35

Bred

Bred

(gile)

Patrick_35

(gile)

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante