Challenge 20

[(gile)]

Salut Patrick,

 

Si j'ai bien compris ton nouveau code, il s'agirait d'une forme de "tri par insertion".

 

Je pense pas qu'il y ai plus de monde pour répondre

J'attends avec impatience la (ou les) réponse(s) d'Evgeniy.

 

Je donne ma petite dernière (tri rapide)

 

(defun quick-sort (lst fun / pivot left mid right)
 (if lst
   (progn
     (setq pivot (nth (/ (length lst) 2) lst))
     (foreach n lst
(if (equal n pivot)
  (setq mid (cons n mid))
  (if ((eval fun) n pivot)
    (setq left (cons n left))
    (setq right (cons n right))
  )
)
     )
     (append (quick-sort left fun) mid (quick-sort right fun))
   )
 )
) 

[Patrick_35]

Re,

Oui et Non.

J'evite au maximum les boucles.

Je prends le premier élement d'une liste que je recopie dans une nouvelle.

Je prends le suivant et je regarde s'il est inférieur au premier élement de la nouvelle liste.

Oui, je le place en premier.

Non, je regarde s'il est supérieur au dernier de la nouvelle liste.

Oui, je le place en dernier.

Non, je parcours la liste afin de trouver sa place et de l'insérer.

Je prends le suivant jusqu'à ce que ma liste d'origine soit vide.

J'ai pris soins aussi de regarder dans ma liste d'origine s'il n'a a pas des doublons afin de les reporter.

 

Je suis comme toi, j'attends le lisp d'Evgeniy :)

 

ps : tu ne peux pas t'empecher de faire une forme récursive ;)

 

@+

[(gile)]

ps : tu ne peux pas t'empecher de faire une forme récursive

merge-sort (Réponse 23) est itérative, mais c'est vrai que toutes les autres sont récursives.

 

Il m'a semblé que la récursivité s'imposait pour la plupart des routines, cela permet, grace à l'empilement/dépilement, de traiter (trier) d'abord soit un élément et une liste d'un seul élément (ou deux listes d'un seul élément pour le tri fusion), puis un nouvel élément avec la liste de deux éléments précédemment triée (ou deux listes triées pour la fusion) et ainsi de suite...

 

Pour les benchmarks, les résultats sont vraiment très variables suivant la longueurs et le type des listes, d'un côté et le type d'algorithme de l'autre. Par exemple, la liste longue donnée par Evgeniy est particulière, elle contitent beaucoup de doublons (2053 entiers tous compris entre 10 et 121) et des routines comme quick-sort (ci dessus)ou tri_pat2 qui gèrent les doublons seront plus rapides avec ce type de liste.

 

On peut faire des tests en utilisant des listes générés par la routine suivante : l'argument n correspond à la longueur de la liste, l'argument m à l'entier maximum + 1 (le minimum étant 0).

Par exemple :

(makelist 100 500) génèrera une liste de 100 entiers entre 0 et 499 avec relativement peu de doublons,

(makelist 100 20) génèrera une liste de 100 entiers entre 0 et 19 avec beaucoup plus de doublons,.

 

(defun rng (/ modulus multiplier increment random)
 (if (not seed)
   (setq seed (getvar "DATE"))
 )
 (setq	modulus	   4294967296.0
multiplier 1664525
increment  1
seed	   (rem (+ (* multiplier seed) increment) modulus)
random	   (/ seed modulus)
 )
)

(defun makelist	(n m / lst)
 (repeat n
   (setq lst (cons (fix (* m (rng))) lst))
 )
) 

 

Un benchmark avec une liste de 100 éléments dont 80 doublons :

(setq lst (makelist 100 20))

(- (length lst) (length (remove_doubles lst))) --> 80

 

(benchmark '((tri_pat2 lst '<) (merge-sort lst '<) (quick-sort lst '<)))
Benchmarking .............Elapsed milliseconds / relative speed for 1024 iteration(s):

   (QUICK-SORT LST (QUOTE <)).....1969 / 2.32 [b]<[/b]fastest>
   (MERGE-SORT LST (QUOTE <)).....2625 / 1.74
   (TRI_PAT2 LST (QUOTE <)).......4562 / 1.00 [b]<[/b]slowest> 

 

Un autre avec une liste de 100 éléments dont seulement 5 doublons :

(setq lst (makelist 100 500))

(- (length lst) (length (remove_doubles lst))) --> 5

 

(benchmark '((tri_pat2 lst '<) (merge-sort lst '<) (quick-sort lst '<)))
Benchmarking ............Elapsed milliseconds / relative speed for 512 iteration(s):

   (MERGE-SORT LST (QUOTE <))......1313 / 9.08 [b]<[/b]fastest>
   (QUICK-SORT LST (QUOTE <))......1610 / 7.40
   (TRI_PAT2 LST (QUOTE <)).......11922 / 1.00 [b]<[/b]slowest>

[Edité le 20/1/2008 par (gile)]

[ElpanovEvgeniy]

Bonjour :)

Vous attendez mon code ?

Probablement, je comprends mal.

Je pensais, vous ne vouliez pas à la fois exposer un nouveau code...

 

Dans tous les cas, j'expose le code, qui a écrit vendredi soir.

 

(defun sort-1 (l)
 (setq ma nil
       mi nil
       a  (car l)
 ) ;_ setq
 (foreach b (cdr l)
  (if (f a B)
   (setq ma (cons b ma))
   (setq mi (cons b mi))
  ) ;_ if
 ) ;_ foreach
)
(defun sort (lst f / A L-ALL MA MI)
(setq lst (list lst)
      f   (eval f)
) ;_ setq
(while lst
 (if (cdar lst)
  (progn (sort-1 (car lst))
         (if (and mi (null (cdr mi)))
          (setq l-all (cons a (cons (car mi) l-all))
                lst   (if ma
                       (cons (reverse ma) (cdr lst))
                       (cdr lst)
                      ) ;_ if
          ) ;_ setq
          (setq lst (cons mi
                          (cons (list a)
                                (if ma
                                 (cons (reverse ma) (cdr lst))
                                 (cdr lst)
                                ) ;_ if
                          ) ;_ cons
                    ) ;_ cons
          ) ;_ setq
         ) ;_ if
         (if (null (car lst))
          (setq lst (cdr lst))
         ) ;_ if
  ) ;_ progn
  (setq l-all (cons (caar lst) l-all)
        lst   (cdr lst)
  ) ;_ setq
 ) ;_ if
) ;_ while
(reverse l-all)
)
;; test:
;;(setq lst '("f" "a" "b" "d" "e" "c") f '<  l-all nil)
;;(sort lst f) 

[zebulon_]

Bonjour,

 

Je me suis amusé un peu avec la méthode de tri par casier.

Le tri par casiers est une méthode de tri très spéciale car elle ne s'applique qu'au tri de valeurs entières incluses dans un ensemble pas trop grand. Cette contrainte réduit énormément la portée des utilisations de ce tri, mais quand ce tri est implémentable, il est d'une redoutable efficacité. Cela est du au fait que c'est la seule méthode de tri qui ne nécessite aucune comparaison entre les différents éléments.

 

(defun tricasier (TBL / LONGUEUR STBL MINI MAXI I LONGUEUR2 STBL2 POST2 VALT2 COMPTEUR)
 (setq LONGUEUR (- (length TBL) 1))
 ;; définition du tableau
 (setq STBL (vlax-make-safearray vlax-vbInteger (cons 0 LONGUEUR)))
 (setq STBL (vlax-safearray-fill STBL TBL))
 ;; recherche des valeurs MIN et MAX
 (setq MINI (vlax-safearray-get-element STBL 0))
 (setq MAXI MINI)
 (setq I 1)
 (while (<= I LONGUEUR)
    (setq ELEM (vlax-safearray-get-element STBL I))
    (if (< ELEM MINI) (setq MINI ELEM))
    (if (> ELEM MAXI) (setq MAXI ELEM))
    (setq I (+ I 1))
 )
 ;; construction du tableau intermédiaire
 (setq LONGUEUR2 (- MAXI MINI))
 (setq STBL2 (vlax-make-safearray vlax-vbInteger (cons 0 LONGUEUR2)))
 ;; initialisation du tableau intermédiaire
 (setq I 0)
 (while (<= I LONGUEUR2)
   (vlax-safearray-put-element STBL2 I 0)
   (setq I (+ I 1))
 )
 ;; comptabilisation du nombre d'occurences
 (setq I 0)
 (while (<= I LONGUEUR)
   (setq POST2 (- (vlax-safearray-get-element STBL I) MINI))
   (setq VALT2 (+ (vlax-safearray-get-element STBL2 POST2) 1))
   (vlax-safearray-put-element STBL2 POST2 VALT2)
   (setq I (+ I 1))
 )
 ;; restitution de la liste initiale
 (setq TBL nil)
 (setq COMPTEUR MINI)
 (setq I 0)
 (while (<= I LONGUEUR2)
   (setq VALT2 (vlax-safearray-get-element STBL2 I))
   (repeat VALT2
     (setq TBL (append TBL (list COMPTEUR)))
   )
   (setq I (+ I 1))
   (setq COMPTEUR (+ COMPTEUR 1))
 )
 TBL
)

(defun c:tri ()
 (setq TBL '(4 0 -1 2 0 0 2 5 -1 2 0 4 2))
 (tricasier TBL)  
) 

 

En même temps, j'ai révisé les safearray ;)

 

Amicalement

Zebulon_

[Patrick_35]

Je pensais, vous ne vouliez pas à la fois exposer un nouveau code...

Non, on attendais que d'autres persones comme zebulon_ se manifestent (que l'on remercie pour son code, mais qui ne fonctionne que pour des entiers)

 

Résultat des courses, même avec un tri que j'ai amélioré

Liste longue géneré d'après le lisp de (gile).

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

 

(SORT LST (QUOTE <))............1813 / 6.65

(QUICK-SORT LST (QUOTE <))......5375 / 2.24

(TRI_PAT3 LST (QUOTE <)).......12063 / 1.00

 

Liste longue généré d"après le lisp ed'Evgniy.

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

 

(QUICK-SORT LST (QUOTE <))......1859 / 5.46

(SORT LST (QUOTE <))............3594 / 2.83

(TRI_PAT3 LST (QUOTE <)).......10157 / 1.00

 

Liste courte

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

 

(SORT LST (QUOTE <))...........1937 / 2.84

(TRI_PAT3 LST (QUOTE <)).......5094 / 1.08

(QUICK-SORT LST (QUOTE <)).....5500 / 1.00

 

http://www.icone-gif.com/gif/smileys/grands_smileys/3d-bravo.gif

 

The best --> Evgniy

 

 

@+

[Edité le 21/1/2008 par Patrick_35]

[(gile)]

Bravo Evgeniy !!!

 

D'accord avec Patrick pour le verdict, la routine sort d'Evgeniy est la plus rapide la plupart du temps. Elle n'est prise en défaut que rarement et ceci est du je pense à certains types de liste particuliers, c'est le défaut du tri rapide, le "choix" du pivot étant parfois déterminant.

 

Chapeau bas aussi à Zebulon qui a eu le courrage de mener au bout une routine avec les safearray, j'avoue avoir envisagé la chose, mais vite renoncé tant ces safearay me rebutent, surtout que pour une routine polyvalente il faudrait le faire en fonction du type de données de la liste vlax-vbInteger, vlax-vbDouble, vlax-vbString ou pire encore vlax-vbVariant pour les listes !

[(gile)]

En reprenant l'excellente idéee d'Evgeniy qui consiste à faire (setq fun (eval fun)) une seule fois en début de routine au lieu de faire (eval fun) à chaque itération, j'ai pu améliorer merge-sort (renommée merge_sort).

 

(defun merge_ (l1 l2)
 (if (and l1 l2)
   (if	(fun (car l1) (car l2))
     (cons (car l1) (merge_ (cdr l1) l2))
     (cons (car l2) (merge_ l1 (cdr l2)))
   )
   (if	l1
     l1
     l2
   )
 )
)

(defun merge_sort (lst fun / tmp)
 (setq lst (mapcar 'list lst)
fun (eval fun))
 (while (cdr lst)
   (setq tmp lst
  lst nil
   )
   (while (cdr tmp)
     (setq lst	(cons (merge_ (car tmp) (cadr tmp)) lst)
    tmp	(cddr tmp)
     )
   )
   (and tmp (setq lst (cons (car tmp) lst)))
 )
 (car lst)
) 

[ElpanovEvgeniy]

En reprenant l'excellente idéee d'Evgeniy qui consiste à faire (setq fun (eval fun)) une seule fois en début de routine au lieu de faire (eval fun) à chaque itération

......

Salut :)

Je félicite! Vous êtes très de surveillance.

[(gile)]

Your codes deserve all my attention.

 

Tes codes méritent toute mon attention.

[zebulon_]

Bonjour,

 

mais vite renoncé tant ces safearay me rebutent,

On est bien d'accord sur ce point, surtout quand on a l'habitude de manipuler des objets aussi souples que les listes. Mais comme la routine de tri par casier ne fonctionne qu'avec des entiers, je ne pouvais de toute façon pas faire autre chose qu'un tableau d'entier. Et je voulais profiter du fait qu'un tableau est indexé.

 

Une question aux spécialistes du Benchmark : au sujet du tri par casier, lorsqu'il est utilisable, est-il efficace ?

 

Autre question au sujet des safearray :

lorsqu'on fait ceci

 (setq STBL2 (vlax-make-safearray vlax-vbInteger (cons 0 LONGUEUR2)))

cela crée le tableau, mais je crois aussi que cela initialise le tableau avec une valeur 0 dans chaque cellule, donc

;; initialisation du tableau intermédiaire
(setq I 0)
(while (<= I LONGUEUR2)
(vlax-safearray-put-element STBL2 I 0)
(setq I (+ I 1))
) 

deviendrait superflu ?

 

Merci

Zebulon_

[(gile)]

Une question aux spécialistes du Benchmark : au sujet du tri par casier, lorsqu'il est utilisable, est-il efficace ?

 

Comme je disais plus haut le type de liste (longue, courte, plus ou moins pré-triée, avec beaucoup de doublons ou non...) influe beaucoup sur les résultats en fonction des algorithmes et de la manière dont ils sont transcrits.

 

J'ai fait quelques tests avec tricasier qui semble passer les tests plus qu'honorablement.

 

exemple avec une liste de 10 entiers "aléatoires" entre 0 19 :

 

(benchmark '((tricasier lst) (tri_pat2 lst '<) (sort lst '<) (bubblesort lst '<) (insertsort lst '<) (merge_sort lst '<) (quick-sort lst '<)))
Benchmarking .................Elapsed milliseconds / relative speed for 16384 iteration(s):

   (MERGE_SORT LST (QUOTE <)).....1781 / 2.68 [b]<[/b]fastest>
   (SORT LST (QUOTE <))...........1828 / 2.61
   (QUICK-SORT LST (QUOTE <)).....2797 / 1.70
   (INSERTSORT LST (QUOTE <)).....2844 / 1.68
   (TRICASIER LST)................3453 / 1.38
   (BUBBLESORT LST (QUOTE <)).....3860 / 1.23
   (TRI_PAT2 LST (QUOTE <)).......4766 / 1.00 [b]<[/b]slowest> 

 

exemple avec 100 entiers entre 0 et 199

 

(benchmark '((tricasier lst) (tri_pat2 lst '<) (sort lst '<) (bubblesort lst '<) (insertsort lst '<) (merge_sort lst '<) (quick-sort lst '<)))
Benchmarking .............Elapsed milliseconds / relative speed for 1024 iteration(s):

   (SORT LST (QUOTE <))............1203 / 20.29 [b]<[/b]fastest>
   (MERGE_SORT LST (QUOTE <))......1281 / 19.05
   (TRICASIER LST).................2016 / 12.11
   (QUICK-SORT LST (QUOTE <))......3172 / 7.69
   (INSERTSORT LST (QUOTE <)).....12922 / 1.89
   (TRI_PAT2 LST (QUOTE <)).......19843 / 1.23
   (BUBBLESORT LST (QUOTE <)).....24406 / 1.00 [b]<[/b]slowest> 

 

Tu trouveras le lien vers le LISP Benchmark ici avec des commentaires sur son utilistion et ses limites.

 

je crois aussi que cela initialise le tableau avec une valeur 0 dans chaque cellule

Effectivement :

 

(vlax-safearray->list (vlax-make-safearray vlax-vbInteger (cons 0 2))) retourne (0 0 0)

 

J'ai fait les test ci dessus après avoir retiré" l'initialisation du tableau intermédiaire" de ta routine. [Edité le 22/1/2008 par (gile)]

[(gile)]

Je déterre ce sujet parce que j'en ai retrouvé une qui implémente un algorithme qui n'a pas encore été évoqué : le tri par arbre binaire de recherche.

 

(defun treeSort	(lst fun / insert fill traversal)

 (defun insert	(ele tree)
   (if	tree
     (if (fun ele (car tree))
(list (car tree) (insert ele (cadr tree)) (caddr tree))
(list (car tree) (cadr tree) (insert ele (caddr tree)))
     )
     (list ele)
   )
 )

 (defun fill (lst tree)
   (if	lst
     (fill (cdr lst) (insert (car lst) tree))
     tree
   )
 )

 (defun traversal (tree)
   (append
     (if (cadr tree)
(traversal (cadr tree))
     )
     (list (car tree))
     (if (caddr tree)
(traversal (caddr tree))
     )
   )
 )

 (setq fun (eval fun))
 (traversal (fill lst nil))
)