Challenge 20

[(gile)]

Salut,

 

Quitte à refaire un bide, je tente encore de lancer un nouveau challenge.

C'est Bseb67 qui m'en a donné l'idée ici.

 

Le but du challenge est de donner une fonction de tri de liste.

AutoLISP fournit acad_strlsort et vl-sort, mais la première ne fonctionne que pour les chaînes et la seconde supprime (mais parfois non) les doublons (ce qui peut être un avantage ou un incovénient suivant les cas).

 

Il s'agirait donc de faire une routine qui fonctionnerait comme vl-sort avec tout type de donnée triable, mais sans supprimer les doublons.

On pourra, dans un premier temps, se limiter à un tri croissant, mais il n'est pas difficile de mettre un argument fonction à la routine (comme dans vl-sort) pour élargir les possibilité de fonctions de comparaisons.

 

Le tri est classique en programmation et a donné lieu à de nombreux algorithmes : voir ici, ou là ou encore pleins d'autres facile à trouver en faisant une recherche sur le net.

 

Vu le nombre d'algorithmes, les solutions devraient être nombreuses (on peut réver...).

 

De ce que j'ai pu voir, les algorithmes de "tri par insertion" et "tri à bulles" sont assez faciles à traduire en LISP. Parmi les algorithmes plus évolués le "tri fusion" semble bien adaptable aux listes.

 

Donc, en résumé :

 

Faire une routine du type :

(defun tri (lst) ....)

qui donnerait :

(tri '(3 5 2 6 3 4 8 5)) --> (2 3 3 4 5 5 6 8)

 

ou mieux :

(defun tri (lst fun) ...)

qui donnerait

(tri '(3 5 2 6 3 4 8 5) ' (2 3 3 4 5 5 6 8)

(tri '(3 5 2 6 3 4 8 5) '>) --> (8 6 5 5 4 3 3 2)

(tri '((3 5) (2 6) (3 5) (8 5)) '(lambda (x1 x2) ( ((2 6) (3 5) (3 5) (8 5))

 

À vos claviers...

 

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

[Patrick_35]

Salut (gile)

 

Comme je n'ai pas vu de niveau, voici une première proposition

 

(defun tri (lst fun / lon tbl val)
 (cond
   ((and (= fun '<) (or (= (type (car lst)) 'INT) (= (type (car lst)) 'REAL)))
     (while lst
       (setq val (apply 'max lst)
      lon (length lst)
      lst (vl-remove val lst)
)
(repeat (- lon (length lst))
  (setq tbl (cons val tbl))
)
     )
   )
   ((and (eq fun '>) (or (= (type (car lst)) 'INT) (/= (type (car lst)) 'REAL)))
     (while lst
(setq val (apply 'min lst)
      lon (length lst)
      lst (vl-remove val lst)
)
(repeat (- lon (length lst))
  (setq tbl (cons val tbl))
)
     )
   )
   (T
     (vl-sort lst fun)
   )
 )
)

 

@+

[(gile)]

Super, une première réponse :D :D :D

 

D'après ce que j'ai pu lire, il s'agirait d'un "tri par sélection".

Ça marche avec les nombres et les fonctions .

Sinon, pour les autres données ou fonctions de comparaison, l'utilisation de vl-sort ne répond pas à la consigne : il s'agit d'écrire un équivalent à vl-sort, donc on ne l'utilise pas...

[Patrick_35]

Du moment que ce n'est pas de la 3D ;)

 

Je veux bien éviter d'utiliser vl-sort, mais comment évaluer la fonction lambda ?

 

@+

[ElpanovEvgeniy]

(defun tri (lst fun)
(mapcar
 (function
  (lambda (x)
   (nth x lst)
  ) ;_ lambda
 ) ;_ function
 (vl-sort-i lst fun)
) ;_ mapcar
) ;_ defun 

[(gile)]

mais comment évaluer la fonction lambda ?

 

Comme ce n'est pas directement l'objet du challenge, je donne deux méthodes pour faire une fonction de comparaison "générique".

 

L'idée est d'utilser dans le defun un argument (fun) qui contient la fonction de comparaison quotée comme : ' ou '(lambda ...) puis,

 

- soit d'utiliser apply pour faire paser une liste d'arguments à cette fonction.

Exemple :

 

(defun compare (e1 e2 fun)
 (apply fun (list e1 e2))
) 

 

(compare 1 2 '

(compare 1 2 '>) --> nil

(compare '(1 2) '(3 2) '(lambda (x1 x2) (= (cadr x1) (cadr x2)))) --> T

 

- soit d'utiliser la fonction eval

 

(defun compare (e1 e2 fun)
 ((eval fun) e1 e2)
) 

 

qui donne les mêmes résultats.

 

On peut donc utiliser ces méthodes pour écrire une fonction de tri "générique" (qui accepte différentes fonctions de comparaison)[Edité le 17/1/2008 par (gile)]

[(gile)]

Nice one Evgeniy, but the challenge is to create a sort function without using AutoLISP or VisualLISP built in sort functions as acad_strlsort, vl-sort and vl-sort-i too.

 

Joli coup Evgeniy, mais le challenge est de créer une fonctions de tri sans utiliser les fonctions de tri AutoLISP ou VisualLISP comme acad_strlsort, vl-sort ainsi que vl-sort-i.

[ElpanovEvgeniy]

Nice one Evgeniy, but the challenge is to create a sort function without using AutoLISP or VisualLISP built in sort functions ac acad_strlsort, vl-sort and vl-sort-i too.

 

Joli coup Evgeniy, mais le challenge est de créer une fonctions de tri sans utiliser les fonctions de tri AutoLISP ou VisualLISP comme acad_strlsort, vl-sort ainsique vl-sort-i.

 

:)

http://www.caduser.ru/cgi-bin/f1/board.cgi?t=25113OT

 

(2006-05-10 23:18:41)

 

(defun rec-quicksort-2 (lst lst1 lst2 test f)
 (cond
   ((not lst)
     (list lst1 (list test) lst2)
   )
   (((eval f) (car lst) test)
    (rec-quicksort-2 (cdr lst) (cons (car lst) lst1) lst2 test f)
   )
   (t (rec-quicksort-2 (cdr lst) lst1 (cons (car lst) lst2) test f))
 ) ;_  cond
) ;_  defun

(defun rec-quicksort-1 (lst f)
 (cond
   ((not lst) nil)
   ((not (car lst)) (rec-quicksort-1 (cdr lst) f))
   ((not (cdar lst))
    (cons (caar lst) (rec-quicksort-1 (cdr lst) f))
   )
   ((not (cddar lst))
    (if (apply f (car lst))
      (cons (caar lst) (cons (cadar lst) (rec-quicksort-1 (cdr lst) f)))
      (cons (cadar lst) (cons (caar lst) (rec-quicksort-1 (cdr lst) f)))
    ) ;_  if
   )
   (t
    ((lambda (x)
       (rec-quicksort-1 (cons (car x) (cons (cadr x) (cons (caddr x) (cdr lst)))) f)
     ) ;_  lambda
      (rec-quicksort-2 (cdar lst) nil nil (caar lst) f)
    )
   )
 ) ;_  cond
) ;_  defun

(defun tri (lst f)
 (rec-quicksort-1 (list lst) f)
) ;_  defun

[(gile)]

:o :D :P

 

Superbe routine, j'ai essayé aussi un "tri rapide" (quick-sort) mais il est sensiblement moins rapide, peut-être à cause de l'utilisation de append ou plus certainement une moins bonne implémentation.

 

;; tri rapide

(defun left (ele lst fun)
 (if lst
   (if	((eval fun) ele (car lst))
     (left ele (cdr lst) fun)
     (cons (car lst) (left ele (cdr lst) fun))
   )
 )
)

(defun right (ele lst fun)
 (if lst
   (if	((eval fun) ele (car lst))
     (cons (car lst) (right ele (cdr lst) fun))
     (right ele (cdr lst) fun)
   )
 )
)

(defun quicksort (lst fun)
 (if (cdr lst)
   (append (quicksort (left (car lst) (cdr lst) fun) fun)
    (cons (car lst)
	  (quicksort (right (car lst) (cdr lst) fun) fun)
    )
   )
   lst
 )
) 

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

[Patrick_35]

Great

vl-sort-i Simply.

 

ElpanovEvgeniy, you're a master

You're born with the lisp as a first language ;)

I will lose a few neurons to trying to understand your function

 

ElpanovEvgeniy, tu es un maître

Tu es né avec le lisp comme première langue ;)

Je vais perdre quelques neurones à essayer de comprendre ta fonction.

 

(gile)

Je ne l'avais pas vu de cette manière. J'essayais directement avec la fonction.

Sinon, ma contribution car je n'ai pas cogité pour rien.

(defun tri_pat(lst fun / compare der tbl val)
 (defun compare (e1 e2 fun)
   (apply fun (list e1 e2))
 )
 (while lst
   (setq n 0 der (car lst) tot (length lst))
   (while (setq val (nth n lst))
     (if (compare val der fun)
(setq der val)
     )
     (setq n (1+ n))
   )
   (setq lst (vl-remove der lst))
   (repeat (- tot (length lst))
     (setq tbl (cons der tbl))
   )
 )
 (reverse tbl)
)

 

La routine de ElpanovEvgeniy est la plus rapide

 

Test du Benchmark

(benchmark (list '(tri '(3 5 2 6 3 4 8 5) '<) '(quicksort '(3 5 2 6 3 4 8 5) '<) '(tri_pat '(3 5 2 6 3 4 8 5) '<)))

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

 

(TRI (QUOTE (3 5 2 6 3 4 8 5)) (QUOT...).....1531 / 1.84 <fastest>

(TRI_PAT (QUOTE (3 5 2 6 3 4 8 5)) (...).....2594 / 1.08

(QUICKSORT (QUOTE (3 5 2 6 3 4 8 5))...).....2812 / 1.00 <slowest>

Il va falloir relever les manches ;)

 

@+

[Patrick_35]

Ca s'améliore, mais il va falloir à réflechir à une autre méthode

 

(defun tri_pat(lst fun / der tbl val)
 (while lst
   (setq n 0 der (car lst) tot (length lst))
   (while (setq val (nth n lst))
     (if ((eval fun) der val)
(setq der val)
     )
     (setq n (1+ n))
   )
   (setq lst (vl-remove der lst))
   (repeat (- tot (length lst))
     (setq tbl (cons der tbl))
   )
 )
 tbl
)

 

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

 

(TRI (QUOTE (3 5 2 6 3 4 8 5)) (QUOT...).....1500 / 1.85 <fastest>

(TRI_PAT (QUOTE (3 5 2 6 3 4 8 5)) (...).....2515 / 1.11

(QUICKSORT (QUOTE (3 5 2 6 3 4 8 5))...).....2781 / 1.00 <slowest>

 

@+

[(gile)]

Ta routine utilise une forme de l'algorithme du "tri à bulle" réputé plutôt lent, j'ai aussi essayé de transcrire cet algorithme (toujours sous forme récursive)

 

;; tri à bulles

(defun bubble (ele lst fun)
 (if lst
   (if	((eval fun) ele (car lst))
     (cons ele (bubble (car lst) (cdr lst) fun))
     (cons (car lst) (bubble ele (cdr lst) fun))
   )
   (list ele)
 )
)

(defun bubblesort (lst fun)
 (if lst
   (bubble (car lst) (bubblesort (cdr lst) fun) fun)
 )
) 

 

Attention avec les benchmarks, les résultats dépendent beaucoup de la longueur de la liste et, suivant les algorithmes, de la manière dont elle est déjà plus ou moins triée.

 

Exemple avec une liste plus longue :

 

(setq lst '("A" "Z" "E" "R" "T" "Y" "U" "I" "O" "P" "Q" "S" "D" "F" "G" "H" "J" "K" "L" "M" "W" "X" "C" "V" "B" "N"))

 

EDIT avec la deuxième version de tri_pat

 

(benchmark '((tri lst '

Benchmarking ..............Elapsed milliseconds / relative speed for 2048 iteration(s):

 

(TRI LST (QUOTE

(QUICKSORT LST (QUOTE

(TRI_PAT LST (QUOTE

(BUBBLESORT LST (QUOTE

 

Il va falloir relever les manches ;)

J'en ai encore quelques en réserve ;) [Edité le 17/1/2008 par (gile)]

[ElpanovEvgeniy]

Bonjour !

Regardez mon contrôle pour de grandes listes.

Recursion ne peut pas être le plus rapide, si les données il y a beaucoup de. :(

 

Test list:

(setq lst
     (apply
      (function append)
      (mapcar
       (function vl-string->list)
       '("(defun bubble (ele lst fun)
;;gile
(if lst
 (if ((eval fun) ele (car lst))
  (cons ele (bubble (car lst) (cdr lst) fun))
  (cons (car lst) (bubble ele (cdr lst) fun))
 ) ;_  if
 (list ele)
) ;_  if
) ;_  defun
"         "
(defun bubblesort (lst fun)
(if lst
 (bubble (car lst) (bubblesort (cdr lst) fun) fun)
) ;_  if
) ;_  defun
"         "
(defun tri_pat (lst fun / der tbl val)
;;Patrick_35
(while lst
 (setq n   0
       der (car lst)
       tot (length lst)
 ) ;_  setq
 (while (setq val (nth n lst))
  (if ((eval fun) der val)
   (setq der val)
  ) ;_  if
  (setq n (1+ n))
 ) ;_  while
 (setq lst (vl-remove der lst))
 (repeat (- tot (length lst)) (setq tbl (cons der tbl)))
) ;_  while
tbl
) ;_  defun
"         "
(defun left (ele lst fun)
(if lst
 (if ((eval fun) ele (car lst))
  (left ele (cdr lst) fun)
  (cons (car lst) (left ele (cdr lst) fun))
 ) ;_  if
) ;_  if
) ;_  defun
"         "
(defun right (ele lst fun)
(if lst
 (if ((eval fun) ele (car lst))
  (cons (car lst) (right ele (cdr lst) fun))
  (right ele (cdr lst) fun)
 ) ;_  if
) ;_  if
) ;_  defun
"         "
(defun quicksort (lst fun)
;;gile
(if (cdr lst)
 (append (quicksort (left (car lst) (cdr lst) fun) fun)
         (cons (car lst) (quicksort (right (car lst) (cdr lst) fun) fun))
 ) ;_  append
 lst
) ;_  if
) ;_  defun
"         "
(defun rec-quicksort-2 (lst lst1 lst2 test f)
(cond ((not lst) (list lst1 (list test) lst2))
      (((eval f) (car lst) test)
       (rec-quicksort-2 (cdr lst) (cons (car lst) lst1) lst2 test f)
      )
      (t (rec-quicksort-2 (cdr lst) lst1 (cons (car lst) lst2) test f))
) ;_ cond
) ;_ defun
"         "
(defun rec-quicksort-1 (lst f)
(cond ((not lst) nil)
      ((not (car lst)) (rec-quicksort-1 (cdr lst) f))
      ((not (cdar lst)) (cons (caar lst) (rec-quicksort-1 (cdr lst) f)))
      ((not (cddar lst))
       (if (apply f (car lst))
        (cons (caar lst) (cons (cadar lst) (rec-quicksort-1 (cdr lst) f)))
        (cons (cadar lst) (cons (caar lst) (rec-quicksort-1 (cdr lst) f)))
       ) ;_ if
      )
      (t
       ((lambda (x)
         (rec-quicksort-1 (cons (car x) (cons (cadr x) (cons (caddr x) (cdr lst)))) f)
        ) ;_ lambda
        (rec-quicksort-2 (cdar lst) nil nil (caar lst) f)
       )
      )
) ;_ cond
) ;_ defun
"         "
(defun tri (lst f)
;;ElpanovEvgeniy
(rec-quicksort-1 (list lst) f)
) ;_ defun"
        )
      ) ;_  mapcar
     ) ;_  apply
) 

test:

(benchmark '((tri lst '<) (quicksort lst '<) (tri_pat lst '<) (bubblesort lst '<)))

Benchmarking ....Elapsed milliseconds / relative speed for 2 iteration(s):

   (TRI_PAT LST (QUOTE <)).........2063 / 31.14 <fastest>
   (TRI LST (QUOTE <)).............5625 / 11.42
   (QUICKSORT LST (QUOTE <))......10171 / 6.32
   (BUBBLESORT LST (QUOTE <)).....64250 / 1 <slowest>

[(gile)]

Recursion ne peut pas être le plus rapide, si les données il y a beaucoup de. :(

 

C'est vrai que les formes récursives sont en général moins rapides que les formes itératives, mais dans ce cas je pense que le choix de l'algorithme (suivant le type de liste) est primordial.

 

J'ai une routine qui utilise un algorithme de tri qui n'a pas encore été utilisé dans ce challenge, elle est récursive et plus rapide que celles déjà postée.

Exemple avec la liste longue d'Evgeniy :

 

(benchmark '((tri lst '<) (quicksort lst '<) (tri_pat lst '<) (bubblesort lst '<)(gilesort lst '<)))
Benchmarking ......Elapsed milliseconds / relative speed for 8 iteration(s):

   (GILESORT LST (QUOTE <)).......1156 / 60.93 [b]<[/b]fastest>
   (TRI_PAT LST (QUOTE <)).........3781 / 18.63
   (TRI LST (QUOTE <)).............5344 / 13.18
   (QUICKSORT LST (QUOTE <)).......8922 / 7.89
   (BUBBLESORT LST (QUOTE <)).....70437 / 1.00 [b]<[/b]slowest> 

 

J'attends un peu avant de la donner pour laisser du champ à d'autres réponses.

En tout cas, les routines données jusqu'à présent ne semblent pas "au top" question performances...

[ElpanovEvgeniy]

Je relève le défi remis!

Maintenant j'ai beaucoup de travail et je ne pourrai pas écrire la réponse digne vite.

La semaine suivante, pour ce sujet, j'écrirai la fonction du tri sans recursion.

[(gile)]

OK Evgeniy,

 

This will let some time for others, which aren't "LISP masters", to post some replies (I hope). I'll wait too to post my "best routines".

 

Ça laisse le temps à d'autres, qui ne sont pas des "maîtres du LISP", de poster quelques réponses (j'epère). J'attendrai aussi pour poster mes "meilleures routines".

[Patrick_35]

Re,

Je crois que je l'ai :)

 

Avec une liste courte

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

 

(TRI_PAT2 (QUOTE (3 5 2 6 3 4 8 5)) ...).....1344 / 1.65

(TRI (QUOTE (3 5 2 6 3 4 8 5)) (QUOT...).....1578 / 1.41

(QUICKSORT (QUOTE (3 5 2 6 3 4 8 5))...).....2219 / 1.00

 

Avec une liste longue

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

 

(TRI_PAT2 LST (QUOTE <))......1422 / 6.39

(TRI LST (QUOTE <))...........4781 / 1.90

(QUICKSORT LST (QUOTE <)).....9093 / 1.00

 

Donc, je vais faire comme vous et attendre avant de poster ma routine

 

ps : J’ai bien regardé les différents algorithmes, mais cela n'est pas évident à comprendre et à retranscrire. J'ai donc préféré le faire selon ma logique et les possibilités du lisp.

 

@+

[ElpanovEvgeniy]

Re,

Je crois que je l'ai :)

 

Avec une liste courte

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

 

(TRI_PAT2 (QUOTE (3 5 2 6 3 4 8 5)) ...).....1344 / 1.65

(TRI (QUOTE (3 5 2 6 3 4 8 5)) (QUOT...).....1578 / 1.41

(QUICKSORT (QUOTE (3 5 2 6 3 4 8 5))...).....2219 / 1.00

 

Avec une liste longue

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

 

(TRI_PAT2 LST (QUOTE <))......1422 / 6.39

(TRI LST (QUOTE <))...........4781 / 1.90

(QUICKSORT LST (QUOTE <)).....9093 / 1.00

 

Donc, je vais faire comme vous et attendre avant de poster ma routine

 

ps : J’ai bien regardé les différents algorithmes, mais cela n'est pas évident à comprendre et à retranscrire. J'ai donc préféré le faire selon ma logique et les possibilités du lisp.

 

@+

 

Si remplacer vl-remove par la fonction analogue autolisp - tout changera!

[Patrick_35]

hé hé :cool:

C'est pas à un vieux singe qu'on apprend à faire des grimaces ;)

 

Sans le vl-remove

 

Avec la liste longue

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

 

(TRI_PAT2 LST (QUOTE <))........1578 / 46.16

(TRI LST (QUOTE <)).............5078 / 14.34

(QUICKSORT LST (QUOTE <)).......9781 / 7.45

(BUBBLESORT LST (QUOTE <)).....72843 / 1.00

 

Avec la liste courte

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

 

(TRI_PAT2 (QUOTE (3 5 2 6 3 4 8 5)) ...).....1453 / 1.59

(TRI (QUOTE (3 5 2 6 3 4 8 5)) (QUOT...).....1625 / 1.42

(BUBBLESORT (QUOTE (3 5 2 6 3 4 8 5)...).....2297 / 1.01

(QUICKSORT (QUOTE (3 5 2 6 3 4 8 5))...).....2313 / 1.00

 

@+

[ElpanovEvgeniy]

>Patrick_35

>(gile)

 

Vous m'avez intrigué!

J'ai écrit le programme avant le temps planifié...

 

Je n'utilise pas vl*

 

(benchmark '((sort-evgeniy lst '<) (bubblesort lst '<)))
(length lst) ; => 2053 (int) reponse n°12 postee le 18/1/2008 a 07:38
Benchmarking .....Elapsed milliseconds / relative speed for 4 iteration(s):

   (SORT LST (QUOTE <))............1125 / 78.21 <fastest>
   (BUBBLESORT LST (QUOTE <)).....87985 / 1.00 <slowest> 

[(gile)]

Une petite pour patienter, c'est une transcription du "tri par insertion", un algorithme simple.

 

;; tri par insertion

(defun insert (ele lst fun)
 (if lst
   (if	((eval fun) (car lst) ele)
     (cons (car lst) (insert ele (cdr lst) fun))
     (cons ele lst)
   )
   (list ele)
 )
)

(defun insertsort (lst fun)
 (if lst
   (insert (car lst) (insertsort (cdr lst) fun) fun)
 )
) 

 

Cet algorithme est très sensible à la manière dont la liste est organisée.

Avec une liste déjà tiée (meilleur des cas) cet algorithme est plutôt rapide moins dans d'autre cas.

Une liste déjà triée sera, par contre, le "pire des cas" pour les routines données ici qui utilisent le "tri rapide" car ces routines choisissent comme pivot le premier élément des listes.

 

(setq lst '("A" "Z" "E" "R" "T" "Y" "U" "I" "O" "P" "Q" "S" "D" "F" "G" "H" "J" "K" "L" "M" "W" "X" "C" "V" "B" "N"))

(benchmark '((tri lst '<) (tri_pat lst '<) (insertsort lst '<) (bubblesort lst '<) (quicksort lst '<)))
Benchmarking ..............Elapsed milliseconds / relative speed for 2048 iteration(s):

   (TRI LST (QUOTE <))............1531 / 2.05 [b]<[/b]fastest>
   (INSERTSORT LST (QUOTE <)).....1750 / 1.79
   (QUICKSORT LST (QUOTE <))......2531 / 1.24
   (BUBBLESORT LST (QUOTE <)).....2843 / 1.10
   (TRI_PAT LST (QUOTE <))........3141 / 1.00 [b]<[/b]slowest>

(setq lst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))

(benchmark '((tri lst '<) (tri_pat lst '<) (insertsort lst '<) (bubblesort lst '<) (quicksort lst '<)))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

   (INSERTSORT LST (QUOTE <))......1485 / 17.24 [b]<[/b]fastest>
   (TRI_PAT LST (QUOTE <))........12750 / 2.01
   (TRI LST (QUOTE <))............14672 / 1.74
   (BUBBLESORT LST (QUOTE <)).....14906 / 1.72
   (QUICKSORT LST (QUOTE <))......25594 / 1.00 [b]<[/b]slowest>

[(gile)]

On passe à la vitesse supérieure, avec une transcription classique de l'algorithme de "tri fusion" (récursive)

 

;; Tri fusion

(defun merge (l1 l2 fun)
 (if (and l1 l2)
   (if	((eval fun) (car l1) (car l2))
     (cons (car l1) (merge (cdr l1) l2 fun))
     (cons (car l2) (merge l1 (cdr l2) fun))
   )
   (if	l1
     l1
     l2
   )
 )
)

(defun brklst (lst / l n)
 (setq n (/ (length lst) 2))
 (while (< 0 n)
   (setq l   (cons (car lst) l)
  lst (cdr lst)
  n   (1- n)
   )
 )
 (list (reverse l) lst)
)

(defun mergesort (lst fun)
 (if (cdr lst)
   (progn
     (setq lst (brklst lst))
     (merge (mergesort (car lst) fun)
     (mergesort (cadr lst) fun)
     fun
     )
   )
   lst
 )
) 

 

Avec une liste courte (3 5 2 6 3 4 8 5) :

 

(benchmark '((tri lst '<) (tri_pat lst '<) (mergesort lst '<)))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

   (TRI LST (QUOTE <))...........1234 / 1.19 [b]<[/b]fastest>
   (MERGESORT LST (QUOTE <)).....1250 / 1.18
   (TRI_PAT LST (QUOTE <)).......1469 / 1.00 [b]<[/b]slowest> 

 

Avec une liste longue :

 

(benchmark '((tri lst '<) (tri_pat lst '<) (mergesort lst '<)))
Benchmarking .......Elapsed milliseconds / relative speed for 16 iteration(s):

   (MERGESORT LST (QUOTE <))......1797 / 6.02 [b]<[/b]fastest>
   (TRI_PAT LST (QUOTE <))........7641 / 1.42
   (TRI LST (QUOTE <))...........10813 / 1.00 [b]<[/b]slowest> 

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

[(gile)]

J'ai réussi à trouver une meilleure implémentation du "tri rapide" qui, cette fois porte mieux son nom.

 

avec la liste courte :

 

(benchmark '((tri lst '<) (tri_pat lst '<) (quick-sort lst '<)))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):

   (QUICK-SORT LST (QUOTE <)).....1141 / 1.26 [b]<[/b]fastest>
   (TRI LST (QUOTE <))............1219 / 1.18
   (TRI_PAT LST (QUOTE <))........1437 / 1.00 [b]<[/b]slowest> 

 

avec la liste longue :

 

(benchmark '((tri lst '<) (tri_pat lst '<) (quick-sort lst '<)))
Benchmarking .........Elapsed milliseconds / relative speed for 64 iteration(s):

   (QUICK-SORT LST (QUOTE <))......1984 / 21.57 [b]<[/b]fastest>
   (TRI_PAT LST (QUOTE <))........30109 / 1.42
   (TRI LST (QUOTE <))............42797 / 1.00 [b]<[/b]slowest> 

[(gile)]

J'abas mes dernières cartes.

 

Une variante (itérative) de "tri fusion".

J'avais donné cette routine (sort) comme alternative à vl-sort dans ce sujet.

 

;; tri fusion (variante)

(defun merge (l1 l2 fun)
 (if (and l1 l2)
   (if	((eval fun) (car l1) (car l2))
     (cons (car l1) (merge (cdr l1) l2 fun))
     (cons (car l2) (merge l1 (cdr l2) fun))
   )
   (if	l1
     l1
     l2
   )
 )
)

(defun merge-sort (lst fun / tmp)
 (setq lst (mapcar 'list lst))
 (while (cdr lst)
   (setq tmp lst
  lst nil
   )
   (while (cdr tmp)
     (setq lst	(cons (merge (car tmp) (cadr tmp) fun) lst)
    tmp	(cddr tmp)
     )
   )
   (and tmp (setq lst (cons (car tmp) lst)))
 )
 (car lst)
) 

[Patrick_35]

Salut (gile)

 

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

 

Donc, je donne aussi ma solution

 

(defun tri_pat2(lst fun / cha fis lec tbl tmp val)
 (while lst
   (setq val (car lst)
       tmp nil
       cha nil
   )
   (foreach lec lst
     (if (eq lec val)
     (setq cha (cons val cha))
     (setq tmp (cons lec tmp))
     )
   )
   (setq lst (reverse tmp))
   (cond
     ((not tbl)
     (setq tbl cha)
     )
     (((eval fun) val (car tbl))
     (setq tbl (append cha tbl))
     )
     (((eval fun) (last tbl) val)
     (setq tbl (append tbl cha))
     )
     (T
     (setq tmp nil fis T)
       (foreach lec tbl
       (and ((eval fun) val lec) fis
         (setq tmp (append cha tmp))
         (setq fis nil)
       )
       (setq tmp (cons lec tmp))
     )
     (setq tbl (reverse tmp))
     )
   )
 )
)

 

@+