Aller au contenu

[Challenge] Grouper des points


(gile)
 Partager

Messages recommandés

Yayyyyy !!!

J'ai une solution...Uuuuhh ignoble malheureusement mais in fine chat fonctionne (ou du moins chat fonctionne avec l'exemple :3)
Mais très clairement en terme de lisibilité et de rapidité, bah je suis dernière  😭

Résultats du BenchMark (de Michael Puckett) :
 

Quote

Commande: (benchmark '((mergepts pts 10 '(0))))
Elapsed milliseconds / relative speed for 2048 iteration(s):
    (MERGEPTS PTS 10 (QUOTE (0))).....1358 / 1.00 <fastest>
Commande: (benchmark '((mergepts pts 10 '(0)) (mergepts0 pts 10)))
Elapsed milliseconds / relative speed for 2048 iteration(s):
    (MERGEPTS PTS 10 (QUOTE (0))).....1544 / 1.18 <fastest>
    (MERGEPTS0 PTS 10)................1825 / 1.00 <slowest>
Commande: (benchmark '((mergepts pts 10 '(1)) (mergepts0 pts 10)))
Elapsed milliseconds / relative speed for 2048 iteration(s):
    (MERGEPTS PTS 10 (QUOTE (1))).....1342 / 1.09 <fastest>
    (MERGEPTS0 PTS 10)................1466 / 1.00 <slowest>
Commande: (benchmark '((mergepts pts 10 '(0 1)) (mergepts0 pts 10)))
Elapsed milliseconds / relative speed for 2048 iteration(s):
    (MERGEPTS0 PTS 10)..................1482 / 3.25 <fastest>
    (MERGEPTS PTS 10 (QUOTE (0 1))).....4820 / 1.00 <slowest>

Bon du coup, cette fois-ci je le conserve encore caché "pour ne pas décourager les autres" 😜
(par contre cela fonctionne de manière générale pour répondre à la demande aussi bien avec un tri en X, Y, Z, X/Y, Y/Z et X/Y/Z ♥)

Bisous,
Luna

Modifié par Luna
Lien vers le commentaire
Partager sur d’autres sites

12 hours ago, (gile) said:

Il s'agirait donc bien de grouper les points par plages de 10 unités
- soit dans des intervalles de ... [-15, -5[, [-5, 5[, [5, 15[
- soit en partant du plus petit X mais en respectant le pas de 10 : [-14.3, -4.3[, [-4.3, 4.3[, 4.3, 14.3[ ...

Bonjour à tous,

Visiblement il y enfin "consensus sur l’énoncé" (ce qui visiblement a été le challenge du challenge 😄), je publie les codes écrit hier et très rapidement remanié sur la 2ème proposition [-14.3, -4.3[, [-4.3, 4.3[...

Le premier  un peu dans le même esprit que ce qu'avait proposé Luna, une base de code facilement généralisable en Y, Z...

(defun groupeX (pts fuzz / loop)
  (defun loop (i pts f)
    (if    pts
      (cons (vl-remove-if f pts) (loop (+ i fuzz) (vl-remove-if-not f pts) f))
    )
  )
  (loop (+ (apply 'min (mapcar 'car pts)) fuzz) pts '(lambda (x) (< i (car x))))
)

Pour tester:

_$ (groupeX pts 10)
(((-14.3 14.3) (-6.3 14.2) (-13.6 7.5) (-6.6 4.7)) ((4.8 0.7) (-1.9 -3.2) (2.4 -4.9)) ((14.4 4.7) (8.0 0.9) (9.3 4.7) (6.6 11.2)))

 

Le second sur un trie préalable des points et l'écriture d'une fonction auxiliaire (f) de groupement par plage de 10:

(defun groupeX (pts fuzz / f)

  (defun f (i pts acc)
    (cond ((null pts) (list acc))
      ((> i (caar pts)) (f i (cdr pts) (cons (car pts) acc)))
      (T (cons acc (f (+ i fuzz) (cdr pts) (list (car pts)))))
    )
  )

  (setq pts (vl-sort pts '(lambda (l1 l2) (< (car l1) (car l2)))))
  (f (+ (caar pts) fuzz) pts nil)
)

Pour tester:

_$ (groupeX pts 10)
(((-6.3 14.2) (-6.6 4.7) (-13.6 7.5) (-14.3 14.3)) ((4.8 0.7) (2.4 -4.9) (-1.9 -3.2)) ((14.4 4.7) (9.3 4.7) (8.0 0.9) (6.6 11.2)))

Je poste maintenant, car je ne pense pas pouvoir me dégager d'avantage de temps pour aller plus loin, mes je lirais vos codes avec un intérêt non dissimulé

(Ps: Le gros challenge pour moi a été de générer un mot de passe valide pour me connecter au forum...😉)

@+ Bruno

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Bon bah ma version ignoble :

(defun mergepts (pt-list fuzz fun / brn b i lst interlist get-brn l pt tmp0 tmp1 tmp2 lst0 lst1 lst2)

	(defun interlist (lst / tmp)

		(foreach x (car lst)
			(if (not (member nil (mapcar '(lambda (n) (member x n)) lst)))
				(setq tmp (cons x tmp))
			)
		)
		(reverse tmp)

	)

	(defun get-brn (pt lst / )

		(if (member pt (car lst))
			(car lst)
			(if (cdr lst)
				(get-brn pt (cdr lst))
				(princ)
			)
		)

	)

	(setq brn (vl-sort (apply 'append pt-list) '<)
	      b (if (< (abs (rem (car brn) fuzz)) (/ fuzz 2.0))
			(* fuzz (+ (if (minusp (car brn)) -0.5 0.5) (fix (/ (car brn) fuzz))))
			(* fuzz (+ (if (minusp (car brn)) -1.5 1.5) (fix (/ (car brn) fuzz))))
		)
	)
	(foreach c fun
		(set (read (strcat "lst" (itoa c))) '())
	)
	(while (<= b (last brn))
		(foreach c fun
			(set (read (strcat "tmp" (itoa c)))
				(vl-remove-if	'(lambda (pt)
							(or (> b (nth c pt))
							    (<= (+ b fuzz) (nth c pt))
							)
						)
						pt-list
				)
			)
			(if (vl-symbol-value (read (strcat "tmp" (itoa c))))
				(set (read (strcat "lst" (itoa c)))
					(append
						(list (vl-symbol-value (read (strcat "tmp" (itoa c)))))
						(vl-symbol-value (read (strcat "lst" (itoa c))))
					)
				)
			)
		)
		(setq b (+ b fuzz))
	)
	(cond
		((= (length fun) 1)
			(vl-symbol-value (read (strcat "lst" (itoa (car fun)))))
		)
		((> (length fun) 1)
			(while pt-list
				(setq pt (car pt-list)
				      l	(interlist
						(mapcar	'(lambda (n)
								(get-brn pt (vl-symbol-value (read (strcat "lst" (itoa n)))))
							)
							fun
						)
					)
				      lst (cons l lst)
				)
				(foreach pt l
					(setq pt-list (vl-remove pt pt-list))
				)
			)
			(reverse lst)
		)
		(t (princ))
	)

)

Je n'ai pas vraiment essayé de la simplifier au maximum malheureusement (pas trop le temps, et une migraine pointe le bout de son museau). Juste pour info, la variable fun permet de définir le mode de calcul de la fonction. Il se présente sous la forme de liste et correspond à la position nth d'un élément dans la liste de points.

Donc dans le cas d'une liste de points 3D, on peut avoir :

 -> 0 = X
 -> 1 = Y
 -> 2 = Z
Ce qui permet donc d'avoir un retour pour grouper selon :
 -> X soit fun = '(0)

 -> Y soit fun = '(1)
 -> Z soit fun = '(2)
 -> X et Y soit fun = '(0 1)
 -> X et Z soit fun = '(0 2)
 -> Y et Z soit fun = '(1 2)
 -> X, Y et Z soit fun = '(0 1 2)

Mais du coup, beaucoup de boucles, beaucoup de simplification d'écriture et j'aurais dû ré-itérer l'utilisation de la récursivité mais bon...je n'aurais pas le temps avant ce soir >w<

Voili voilou ♥

PS : petite question à la con, mais dans le cas d'une déclaration de variables au nom variable (set (read (strcat var (itoa (setq i (1+ i)))))), existe-il un moyen quelconque de déclarer les variables localement pour ne pas traîner des variables inutiles de manière globale ?
Bisous,

Luna

Modifié par Luna
Lien vers le commentaire
Partager sur d’autres sites

25 minutes ago, (gile) said:

@VDH-Bruno Bravo !

J'attends encore au moins jusqu'à ce soir pour poster ma copie.

Je poste un dernier petit code écrit rapidement pendant la pause déjeuné, car je m'aperçois en lisant le fil de discutions que ma deuxième proposition ressemble beaucoup à ce qui a été proposé par fraid 😉

Rapidement ma troisième proposition dans la plus pur des traditions, sans fonction lisp spécialisé:

(defun groupX (pts fuzz / f)
  (defun f (i l res acc)
    (if	l
      (if (> i (caar l))
	(f i (cdr l) (cons (car l) res) acc)
	(f i (cdr l) res (cons (car l) acc))
      )
      (if acc
	(cons res (f (+ i fuzz) acc nil nil))
	(list res)
      )
    )
  )
  (f (+ (apply 'min (mapcar 'car pts)) fuzz) pts nil nil)
)

@+ Bruno

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

@VDH-Bruno au top !

Quote

Commande: (benchmark '((mergepts0 pts 10) (mergepts1 pts 10) (mergepts pts 10 '(0)) (groupX pts 10) (groupeX pts 10) (groupt pts 10)))
Elapsed milliseconds / relative speed for 8192 iteration(s):
    (GROUPX PTS 10)...................1856 / 3.36 <fastest>
    (GROUPT PTS 10)...................2153 / 2.90
    (GROUPEX PTS 10)..................5507 / 1.13
    (MERGEPTS PTS 10 (QUOTE (0))).....5585 / 1.12
    (MERGEPTS0 PTS 10)................6006 / 1.04
    (MERGEPTS1 PTS 10)................6240 / 1.00 <slowest>

Les programmes de @VDH-Bruno et @Fraid loin devant sur l'utilisation de la récursivité, là où les boucles (while) et (foreach) semblent légèrement plus longue à l'exécution ! A voir avec la version tant attendu de maître (giles) :3

Bisous,
Luna

Lien vers le commentaire
Partager sur d’autres sites

15 minutes ago, Luna said:

Bon bah ma version ignoble 

Je t'avouerai que je n'ai pas spécialement généralisé les miens, n'ayant pas complètement saisie les critères si le pas doit varié ou pas pour les valeur en Y et Z, et comment ils doivent être spécifié à l'appel de la fonction soit en dur (func lst_de_point fuzzX fuzzY fuzzZ) ou (func lst_de_point list_de_fuzz) ou (func lst_de_point fuzz_Identique  X Y Z)

mais comme la fonction de filtrage est passé en argument sur la première proposition, ce sera pas trop difficile à adapter au besoin😉

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

7 minutes ago, Luna said:

@VDH-Bruno au top !

Les programmes de @VDH-Bruno et @Fraid loin devant sur l'utilisation de la récursivité, là où les boucles (while) et (foreach) semblent légèrement plus longue à l'exécution ! A voir avec la version tant attendu de maître (giles) :3

Bisous,
Luna

Les listes sont beaucoup trop courte pour mesurer l'impacte de la récursivité, et sur ce type d'exercice, je ne pense pas que la vitesse d'exécution soit le critère à prendre en compte, la concision, l’élégance du raisonnement, ou la flexibilité du code sont plus à privilégier. 

J'ai pas le temps pour le tenter faire mais je pense que (gile) va nous proposer une résolution par "clef de recherche", ou quelque chose d'approchant attendons...

@ Bruno

  • Like 1

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

1 hour ago, Luna said:

PS : petite question à la con, mais dans le cas d'une déclaration de variables au nom variable (set (read (strcat var (itoa (setq i (1+ i)))))), existe-il un moyen quelconque de déclarer les variables localement pour ne pas traîner des variables inutiles de manière globale ?
 

Oui en les mettant à nil à la fin du code

(repeat i  (set (read (strcat var (itoa (setq i (1- i))))) nil))

   

  • Like 1

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Les langages mieux lotis que le LISP pour traiter des données fournissent souvent une méthode de groupage des données (SQL, .NET avec Ling, F# avec les listes et séquences, ...). Ces méthodes permettent de grouper les données à l'aide d'une clé (souvent une propriété du type de donnée ou un champ dans une base de données).

Comme je suis un gros paresseux (et que je répondais à une demande sur le forum .NET), c'est cette route que j'ai emprunté. Il ne restait plus qu'à trouver comment générer une clé de groupage pour des nombres : en arrondissant à la valeur de la tolérance.

F# est, hormis AutoLISP, mon langage de prédilection pour prototyper. il existe une fonction native groupBy et une fonction round mais celle-ci arrondi à la valeur entière la plus proche. La méthode .NET System.Math.Round qui accepte en second argument un entier pour spécifier le nombre de décimale ne fait pas directement mon affaire. Qu'à cela ne tienne on écrit une petite fonction au multiple le plus proche.

let roundTo multiple value = 
    round (value / multiple) * multiple

On utilise ensuite cette fonction pour grouper les points :

let groupPointsByX tolerance (pts: Point2d list) =
    pts |> List.groupBy (fun p -> roundTo tolerance p.X)

Si on veut grouper par X et Y, il suffit de modifier la fonction de groupage :

let groupPointsByXY tolerance (pts: Point2d list) =
    pts |> List.groupBy (fun p -> roundTo tolerance p.X, roundTo tolerance p.Y)

Vous pouvez tester tout ça  sans rien installer avec Try F#.

On va maintenant transcrire tout ça dans un langage moins confidentiel. AutoLISP ne fournit pas de fonction pour arrondir les nombres mais ça a été fait maintes fois (il me semble que ça avait l'objet d'un challenge il a quelque temps maintenant). De même, pour arrondir au multiple le plus proche rien de bien sorcier (CF ci-dessus). Reste la fonction de groupage. Avec AutoLISP pour grouper des valeurs en s'inspirant de ce qui se fait ailleurs, on utiliserait une liste d'association (le premier élément de chaque sous liste est la "clé"). Pour ne pas refaire le boulot à chaque fois, il peut-être intéressant de définir une fonction groupBy "générique" qui pourrait resservir dans dans d'autres cas. Cette fonction devra être une fonction dite "d'ordre supérieur" à savoir une fonction qui en prend une autre en argument (comme apply, mapcar, vl-remove-if, ...).

En fait, tout ça existait déjà dans les bibliothèques MathGeom.lsp et List.lsp en bas de cette page.

Donc je ne me suis pas foulé :

;; gc:round
;; Arrondit à la valeur entière la plus proche
;;
;; Arguments
;; num : le nombre à arrondir
(defun gc:round	(num)
  (if (minusp num)
    (fix (- num 0.5))
    (fix (+ num 0.5))
  )
)

;; gc:roundTo
;; Arrondit au multiple de prec le plus proche
;;
;; Arguments
;; prec : le nombre spécifiant la précision de l'arrondi
;; num : le nombre à arrondir
(defun gc:roundTo (prec num)
  (if (zerop (setq prec (abs prec)))
    num
    (* prec (gc:round (/ num prec)))
  )
)

;; gc:groupBy
;; Regroupe les éléments d'une liste selon la clé générée par la fonction spécifiée.
;; Retourne un liste de sous listes dont le premier élément est la clé.
;;
;; Arguments
;; fun : la fonction génératrice de clé
;; lst : la liste
(defun gc:groupBy (fun lst / f key sub res)
  (setq f (eval fun))
  (foreach n lst
      (setq res
	     (if (setq sub (assoc (setq key (f n)) res))
	       (subst (cons key (cons n (cdr sub))) sub res)
	       (cons (list key n) res)
	     )
      )
    )
)

Et ensuite :

(defun grouperPointsParX (tol pts)
  (gc:groupBy '(lambda (p) (gc:roundTo tol (car p))) pts)
)

(defun grouperPointsParXY (tol pts)
  (gc:groupBy
    '(lambda (p)
       (list (gc:roundTo tol (car p)) (gc:roundTo tol (cadr p)))
     )
    pts
  )
)

Les listes renvoyées sont des listes d'association avec comme premier élément de chaque sous liste la valeur du multiple (ou de la paire de multiples), ce qui pourrait être utile pour des recherches ultérieures ou être facilement supprimé par un (mapcar 'cdr ...).

(
  (-10.0 (-6.6 4.7) (-13.6 7.5) (-6.3 14.2) (-14.3 14.3))
  (0.0 (2.4 -4.9) (-1.9 -3.2) (4.8 0.7))
  (10.0 (6.6 11.2) (9.3 4.7) (8.0 0.9) (14.4 4.7))
)

(
  ((-10.0 10.0) (-13.6 7.5) (-6.3 14.2) (-14.3 14.3))
  ((10.0 10.0) (6.6 11.2))
  ((-10.0 0.0) (-6.6 4.7))
  ((0.0 0.0) (2.4 -4.9) (-1.9 -3.2) (4.8 0.7))
  ((10.0 0.0) (9.3 4.7) (8.0 0.9) (14.4 4.7))
)

 

  • Like 2

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

5 hours ago, VDH-Bruno said:

J'ai pas le temps pour le tenter faire mais je pense que (gile) va nous proposer une résolution par "clef de recherche", ou quelque chose d'approchant attendons...

Gagné 😄😄😄 

@(gile), bon je ne mettais pas trompé, c'est exactement ce à quoi je faisais allusion, je me souviens encore dans de ce sujet  la première fois ou tu as exposé cette façon de faire, je l'ai décortiqué deux soir de suite pour me l'approprier, tellement je trouvais ça propre, je l'ai même resservie derrière sur Theswamp (j'étais tout fier 😉), une fois de plus merci.

 

  • Like 1

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Bon ben, je vais avoir du travail pour étudier tout chat et comprendre la logique parce que ya pas à dire, c'est propre !

C'est une leçon très intéressante quoi qu'il en soit et qui démontre parfaitement l'importance de la logique appliquée par le développeur pour arriver à ses fins. Les routes sont nombreuses pour arriver à ses fins mais une bonne connaissance du chemin permet d'emprunter des raccourcis facilitant une utilisation généralisée (mais pouvant créer des nœuds au cerveau parfois !).

J'avais justement essayé un développement similaire au début mais je me suis ratée sur la génération des clés de recherche, donc après quelques nœuds au cerveau, j'ai préférer me rabattre sur une logique plus...analytique mais avec cela, j'aurais de quoi apprendre à mieux les utiliser car cela peut servir en de nombreuses occasions !

Donc merci pour ce challenge et pour vos réponses à tous !

Bisous,
Luna

Lien vers le commentaire
Partager sur d’autres sites

Ces challenges ne poussent pas toujours à prendre du recul ni à faire les choses sereinement.
On a un peu tendance à se focaliser (parfois avec des œillères) sur le problème posé (surtout quand il est mal posé comme ici) et à vouloir y répondre vite (avant les autres) en privilégiant la concision, l'élégance, l'efficience. C'est le jeu, et je m'y suis laissé prendre avec plaisir plus souvent qu'à mon tour.

Là j'ai le beau rôle en lançant ce challenge avec une réponse quasiment toute faite à partir de fonctions écrites depuis longtemps. Mais, si je peux me permettre de tirer "la morale de cette histoire" ça serait :

1. Quand on est face à un problème "complexe" il faut essayer de le décomposer en plusieurs problèmes plus simples (et plus facile à résoudre et à tester séparément).
2. Quand on résout un problème, essayer de généraliser la solution afin qu'elle puisse resservir pour d'autres problèmes (une fonction de groupage générique peut avoir de nombreuses autres utilités).

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager

×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité