Challenge 15

[Patrick_35]

Vous voulez quelque chose de prenant ;)

Faire l'algorithme d'une recherche dichotomique

 

Par exemple avec cette liste (setq lst '("a" "d" "g" "t" "r")), je recherche la position de "t" dans la liste

Cette recherche procède de cette manière

Le milieu de la liste est "g" soit (setq mil (fix (/ (length lst) 2)))

"t" = "q" non, donc avant ou après

"t" < "g" non, donc après

"t" > "g" oui --> je prends le milieu de ma liste entre "g" et "r" qui me donne "t" soit (+ mil (fix (/ (- (length lst) mil) 2)))

 

Le but est de faire une recherche rapide et intelligente plutôt que d'utiliser les boucles.

Je n'ai pas l'algorithme, mais je pense qu'il va être plaisant à faire

 

@+

[Bred]

Salut,

Le but est de faire une recherche rapide et intelligente plutôt que d'utiliser les boucles.

T'es bien obligé de bouclé vu que tu fais des tests par élimination.... ou je n'ai pas encore compris.... :casstet:

[bseb67]

Salut Patrick_35!

 

Ton challenge fait référence à un arbre binaire de données. Ton idée est intéressante.

On peut la pousser en faisant la fonction de création de la liste, je sais qu'il existe vl-sort et AutoCAD-strl-sort, mais en se basant sur ce principe on peut faire la fonction qui ajoute un élément

dans une liste en le plaçant au bon endroit.

[(gile)]

Salut,

Le but est de faire une recherche rapide et intelligente plutôt que d'utiliser les boucles.

T'es bien obligé de bouclé vu que tu fais des tests par élimination.... ou je n'ai pas encore compris.... :casstet:

 

Je pense que Patrick voulait dire "sans boucler sur toute la liste".

[ElpanovEvgeniy]

Hier, a écrit pour les étudiants, le programme très semblable...

http://fr.wikipedia.org/wiki/Méthode_de_dichotomie

(defun test (a b f d)
(if (= a b)
 nil
 ((lambda (r)
   (if (equal (f r) 0. d)
    r
    (if (minusp (* (f a) (f r)))
     (test a r f d)
     (test r b f d)
    ) ;_  if
   ) ;_  if
  ) ;_  lambda
  (/ (+ a b) 2.)
 )
) ;_  if
) ;_  defun
;|
Le contrôle
(test 2 1.6 (lambda(x)(- (* x x) 12.)) 0.00001)
(test 3. 4. (lambda(x)(- (* x x) 12.)) 0.00001)
(test -3. -4. (lambda(x)(- (* x x) 12.)) 0.00001)
|; 

[(gile)]

Une proposition, pour trouver la position d'un élément dans une liste.

Ça ne peut fonctionner que si les éléments de la liste sont comparables avec =, et si la liste est triée.

 

(defun dich-recurs (ele lst / subr)

 (defun subr (b n / l)
   (setq l (/ n 2))
   (cond
     ((= ele (nth (+ b l) lst)) (+ b l))
     ((= 1 n) nil)
     ((      (T (subr (+ b l) (- n l)))
   )
 )

 (subr 0 (length lst))
) 

 

(setq lst '("a" "d" "g" "t" "r"))

(dich-pos "t" lst) -> 3

(dich-pos "a" lst) -> 0

(dich-pos "r" lst) -> 4

(dich-pos "b" lst) -> nil

 

 

[Edité le 5/12/2007 par (gile)]

[(gile)]

La même en forme itérative

 

(defun dich-iter (ele lst / n l b ret)
 (setq	n (length lst)
b 0
 )
 (while (not ret)
   (setq l (/ n 2))
   (cond
     ((= ele (nth (+ b l) lst)) (setq ret (+ b l)))
     ((= 1 n) (setq ret -1))
     ((      (T
      (setq b (+ b l)
     n (- n l)
      )
     )
   )
 )
 (if (minusp ret)
   nil
   ret
 )
) 

 

[Edité le 5/12/2007 par (gile)]

[Patrick_35]

Bravo (gile)

Même pas eu le temps de chercher :)

 

ElpanovEvgeniy, i don't understand your lisp.

 

A ma grande honte, j'avais pensé à quelque chose de ce style :red:

(- (length lst) (length (member "t" lst)))

qui retourne le même résultat, mais sans utiliser ce type de recherche et ce n'était pas le but de la question

 

Au test du Benchmark, (gile) est le grand gagnant

 

(benchmark (list '(dich-recurs "t" lst) '(dich-iter "t" lst) '(- (length lst) (length (member "t" lst)))))

 

Elapsed milliseconds / relative speed for 16384 iteration(s):

 

(DICH-ITER "t" LST)..........................1015 / 1.09

(DICH-RECURS "t" LST)........................1078 / 1.03

(- (LENGTH LST) (LENGTH (MEMBER "t" ...).....1109 / 1.00

 

Elapsed milliseconds / relative speed for 16384 iteration(s):

 

(DICH-ITER "t" LST)..........................1047 / 1.12

(DICH-RECURS "t" LST)........................1078 / 1.09

(- (LENGTH LST) (LENGTH (MEMBER "t" ...).....1171 / 1.00

 

Elapsed milliseconds / relative speed for 16384 iteration(s):

 

(DICH-ITER "t" LST)..........................1046 / 1.08

(DICH-RECURS "t" LST)........................1094 / 1.03

(- (LENGTH LST) (LENGTH (MEMBER "t" ...).....1125 / 1.00

 

@+

[ElpanovEvgeniy]

ElpanovEvgeniy, i don't understand your lisp.

(defun test (a b f d)

;|arguments:
a = start parametr function
b = end parametr function
f = Any graphic function
As an example - function of  parabola
(lambda(x)(- (* x x) 12.))
d = precision

(test 3. 4. (lambda(x)(- (* x x) 12.)) 0.00001)

search inters parabola '(lambda(x)(- (* x x) 12.)) Axis X
y = (- (* x x) 12.)
if y=0 x=??

|;

(if (= a b)
 nil
 ((lambda (r)
   (if (equal (f r) 0. d)
    r
    (if (minusp (* (f a) (f r)))
     (test a r f d)
     (test r b f d)
    ) ;_ if
   ) ;_ if
  ) ;_ lambda
  (/ (+ a b) 2.)
 )
) ;_ if
) ;_ defun
(test 2. 4. (lambda(x)(- (* x x) 5.)) 1e-5) ;=> 2.23607
(test 2. 4. (lambda(x)(-(* 5. x x x)100.)) 1e-5) ;=> 2.71442
(test 2. 4. (lambda(x)(+(* 2. x x x)(* 3. x x)(* 4. x) -100.)) 1e-5) ;=> 3.08986 

[(gile)]

Un autre exemple de recherche dichotomique : la plus grande distance de décalage intérieur d'une entité fermée.

Le résultat est une valeur approchée à cause de la nécessité d'une condition d'arrêt : la recherche s'arrête quand la différence les valeurs inférieure et supérieure sont égales à la tolérance près.

On peut voir le fonctionnement de la recherche en "traçant" la fonction dans l'éditeur Visual LISP (trace dich-sub) et/ou en mettant en commentaire (point virgule) l'expression (mapcar 'vla-delete of)

;; MAX-OFFSET-DIST
;; Retourne la distance de décalage intérieur maximum pour une entité fermée
;; en fonction d'une tolérance
;;
;; Arguments
;; obj : l'entité (vla-object)
;; fuzz : la tolérance (réel)

(defun MaxOffsetDist (obj fuzz / dich-sub len tmp)
  (vl-load-com)

  (defun dich-sub (inf sup / of new)
    (if	(equal inf sup fuzz)
      inf
      (progn
	(setq new (/ (+ inf sup) 2.0)
	      of  (vl-catch-all-apply
		    'vlax-invoke
		    (list obj 'Offset new)
		  )
	)
	(if (vl-catch-all-error-p of)
	  (dich-sub inf new)
	  (progn
	    (mapcar 'vla-delete of)
	    (dich-sub new sup)
	  )
	)
      )
    )
  )

  (if (and
	(not
	  (vl-catch-all-error-p
	    (setq tmp (vl-catch-all-apply 'vlax-invoke (list obj 'Offset fuzz)))
	  )
	)
	(vlax-curve-isClosed obj)
	(setq len (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj))
	      tmp (car tmp)
	)
	(if (< len (vlax-curve-getDistAtParam tmp (vlax-curve-getEndParam tmp)))
	  (setq len (/ len (* -2 pi)))
	  (setq len (/ len (* 2 pi)))
	)
	(not (vla-delete tmp))
      )
    (dich-sub 0.0 len)
  )
)

;; Fonction de test (crée le plus grand décalage en fonction de la tolérance spécifiée)

(defun c:test (/ obj dist tmp pt)
  (vl-load-com)
  (and
    (setq obj (car (entsel)))
    (or	(setq fuzz (getdist "\nTolérance <0.0001>: "))
	(setq fuzz 0.0001)
    )
    (setq obj (vlax-ename->vla-object obj))
    (setq dist (MaxOffsetDist obj fuzz))
    (vlax-invoke obj 'Offset dist)
    (princ "\nDistance de décalage = ")
    (princ dist)
  )
  (princ)
)

 

[Edité le 8/3/2008 par (gile)]