classification des points suivant X et Y

[Invité spartacuss]

Bonjour

 

salut tout le monde: j'ai une liste de cordonnés de la forme suivante :

[code
((((20.0 1649.5) (418.0 1649.5) (343.0 1612.0) (418.0 1574.5) (343.0 1537.0) (418.0 1499.5) (343.0 1462.0) (418.0 1424.5) (343.0 1387.0)(418.0 1349.5) (343.0 1312.0) (418.0 1274.5) (343.0 1237.0) (418.0 1199.5) (343.0 1162.0) (418.0 1124.5) (343.0 1087.0) (418.0 1049.5)
(343.0 1012.0) (418.0 974.5) (343.0 937.0) (418.0 899.5) (343.0 862.0) (418.0 824.5) (343.0 787.0) (418.0 749.5) (343.0 712.0) (418.0 674.5)(343.0 637.0) (418.0 599.5) (343.0 562.0) (343.0 462.75) (463.0 342.75) (567.75 342.75) (605.25 417.75) (642.75 342.75) (680.25 417.75)
(717.75 342.75) (755.25 417.75) (792.75 342.75) (830.25 417.75) (867.75 342.75) (905.25 417.75) (942.75 342.75) (980.25 417.75)(1017.75 342.75) (1055.25 417.75) (1092.75 342.75) (1130.25 417.75) (1167.75 342.75) (1205.25 417.75) (1242.75 342.75) (1280.25 417.75)
(1317.75 342.75) (1355.25 417.75) (1392.75 342.75) (1430.25 417.75) (1467.75 342.75) (1505.25 417.75) (1542.75 342.75) (1580.25 417.75)(1617.75 342.75) (1655.38 417.5) (1655.5 20.0) (20.0 20.0) (20.0 1649.5)) ((.............] [/code]

 

ou je veux ordonnée cette liste suivant les Y c'est a dire, enregistrer les cordonnées qui ont le même Y dans une liste .

j'ai utilisé un programme (ci-dessous) qui me permet d'effectuer cette tache, mais je rencontre un problème dans le cas ou deux cordonnées sont égales:

[code
(defun test ( l )
(vl-sort
(LM:GroupByFoo l
(lambda ( a b ) (equal (cadr a) (cadr b)))
)
'(lambda ( a b ) (< (cadar a) (cadar b)))
)
)
(defun LM:GroupByFoo ( lst foo )
(if lst
(cons
(cons (car lst)
(vl-remove-if-not '(lambda ( x ) (foo (car lst) x)) (cdr lst))
)
(LM:GroupByFoo (vl-remove-if '(lambda ( x ) (foo (car lst) x)) (cdr lst)) foo)
)
)
)
(setq lall(length listcv))
(setq f -1)
(setq sorty (list))
(while ( < (setq f (1+ f)) lall)
(setq allc (test1 (nth f listcv)))
(setq sorty (append sorty (list allc))) ; sort by y all the coordinate of all lists in allc
)
(setq ls (length sorty))

(setq lallc(length allc))
(setq n -1)
(setq sortally(list))
(while ( <(setq n (1+ n)) ls)
(setq m -1)
(setq sortx (list))
(while ( < (setq m (1+ m)) lallc)

(setq xx0 (vl-sort (nth m (nth n sorty))
(function (lambda (e1 e2)
( < (car e1) (car e2)) ) ) ))
(setq sortx (append sortx (list xx0))) ; sort by x etch list
)
(setq sortally(append sortally (list sortx)))

)] [/code]

 

merci d'avance

cordialement

[Patrick_35]

Salut

 

J'ai pas tout compris

 

Un truc dans ce style ?

 

(setq lst '((20.0 1649.5) (418.0 1649.5) (343.0 1612.0) (418.0 1574.5) (343.0 1537.0) (418.0 1499.5) (343.0 1462.0) (418.0 1424.5) (343.0 1387.0)(418.0 1349.5) (343.0 1312.0) (418.0 1274.5) (343.0 1237.0) (418.0 1199.5) (343.0 1162.0) (418.0 1124.5) (343.0 1087.0) (418.0 1049.5)(343.0 1012.0) (418.0 974.5) (343.0 937.0) (418.0 899.5) (343.0 862.0) (418.0 824.5) (343.0 787.0) (418.0 749.5) (343.0 712.0) (418.0 674.5)(343.0 637.0) (418.0 599.5) (343.0 562.0) (343.0 462.75) (463.0 342.75) (567.75 342.75) (605.25 417.75) (642.75 342.75) (680.25 417.75)(717.75 342.75) (755.25 417.75) (792.75 342.75) (830.25 417.75) (867.75 342.75) (905.25 417.75) (942.75 342.75) (980.25 417.75)(1017.75 342.75) (1055.25 417.75) (1092.75 342.75) (1130.25 417.75) (1167.75 342.75) (1205.25 417.75) (1242.75 342.75) (1280.25 417.75))); définir une liste

;trier suivant les coordonnées Y puis X si les Y sont identiques
(setq lst (vl-sort lst '(lambda(a b)(if (eq (cadr a) (cadr b))
			      (< (car a) (car b))
			      (< (cadr a) (cadr b))
			    )
	       )
  )
)

Ou une boucle pour avoir des listes avec des Y identiques
(while lst
 (setq idemy (vl-remove-if-not '(lambda(x) (eq (cadr x) (cadar lst))) lst)
lst   (vl-remove-if '(lambda(x) (eq (cadr x) (cadar lst))) lst)
 )
 (terpri)
 (princ idemy)
)

 

@+

[Invité spartacuss]

RE

 

le problème que je rencontre lorsque j'ai les X et les Y sont identiques : c'est à dire un point qui se répète.

[Patrick_35]

Tu as cette routine de (gile)

 

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

 

@+