Challenge 3

[Patrick_35]

Donc, pour continuer dans la serie ;)

J'ai une liste qui se compose de cette manière

 

(setq lst '("a" "b" "c" "f" "a" "c" "f" "g" "t" "b" "c" "a"))

J'aimerai connaitre le nombre de ""a, de "b", etc... sous la forme d'une liste et tant qu'à faire dans l'ordre alphabétique.

 

@+

[(gile)]

BUMP !!!

 

Je posterai plus tard, je cherche d'autres solutions ;)

[Bred]

Je propose ça (merci (gile) de ta patience ...)

 

(defun test (lst / LST-F X)
(setq lst (acad_strlsort lst)
     lst-F nil)
(repeat (setq x (length lst))
 (if (assoc (nth (setq x (1- x)) lst) lst-F)
   (setq lst-F (subst (cons (nth x lst)
		     (+ (cdr (assoc (nth x lst) lst-F)) 1))
		     (assoc (nth x lst) lst-F) lst-F))
   (setq lst-F (cons (cons (nth x lst) 1) lst-F))
   )
 )
 lst-F
 )

 

(test '("a" "b" "c" "f" "a" "c" "f" "g" "t" "b" "c" "a"))

->

(("a" . 3) ("b" . 2) ("c" . 3) ("f" . 2) ("g" . 1) ("t" . 1))

[Patrick_35]

Bien, trés bien Bred :D

Mais si tu pouvais éviter de les compter un par un ;)

 

@+

[(gile)]

Une première, un peu dans le style de celle de Bred :

 

(defun test1 (lst / pair rslt)
 (setq lst (vl-sort lst '>))
 (while lst
   (if	(setq pair (assoc (car lst) rslt))
     (setq rslt (subst (cons (car pair) (1+ (cdr pair))) pair rslt))
     (setq rslt (cons (cons (car lst) 1) rslt))
   )
   (setq lst (cdr lst))
 )
 rslt
) 

 

 

Une seconde, récursive, pour le fun :

 

(defun test2 (lst / sub)
 (defun sub (lst)
   (if	lst
     (if (listp (car lst))
(if (equal (caar lst) (cadr lst))
  (sub (cons (cons (caar lst) (1+ (cdar lst))) (cddr lst)))
  (cons (car lst) (sub (cdr lst)))
)
(sub (cons (cons (car lst) 1) (cdr lst)))
     )
   )
 )
 (sub (vl-sort lst ') 

[Bred]

Mais si tu pouvais éviter de les compter un par un

 

Comme ça peut-être ?

(defun test (lst / LST-F N)
(setq lst (vl-sort lst '>)
     lst-F nil)
(while lst
 (setq n (length (vl-remove (car lst) lst))
lst-F (cons (cons (car lst) (- (length lst) n)) lst-F)
lst (vl-remove (car lst) lst))
 )
lst-F
)

 

[Edité le 18/5/2007 par Bred]

[(gile)]

Une autre, un peu plus concise et rapide

 

(defun test3 (lst / sub)
 (defun sub (lst n)
   (if	(cadr lst)
     (if (equal (car lst) (cadr lst))
(sub (cdr lst) (1+ n))
(cons (cons (car lst) n) (sub (cdr lst) 1))
     )
     (list (cons (car lst) n))
   )
 )
 (sub (vl-sort lst ') 

 

Super ta dernière Bred ! :D

[Bred]

J'ai édité ma précédente routine (j'avais une variable inutile qui trainait ...)

 

Super ta dernière Bred !

Je te retourne l'exclamation.

Je trouve la récursivité trés "stylé" !... mais j'ai toujours du mal (malgré toutes tes explications diverse) à le "sentir"... mais je ne désespère pas !!!!

[lovecraft]

Je voulais juste lancer un remerciement pour cette inititative très riche , mais pour qu'elle soit encore plus riche et lucrative. Ilfaudrait que les personnes qui repondent , expliquent en details leur réponse. Je sais ca demande beaucoup de boulot.....Mais bon comme ca tout le monde pourrait un peu mieux comprendre.

Merci encore à vous

[(gile)]

Ta routine me plait vraiment.

 

Si je peux me permettre, tu peux supprimer la mise à nil de la variable lst-F puisqu'elle est déclarée, et personnellement, j'éviterais un (vl-remove ...) en conservant la valeur de (car lst).

 

;; Bred
(defun test (lst / LST-F ele N)
 (setq	lst   (vl-sort lst '>))
 (while lst
   (setq n	(length lst)
  lst	(vl-remove (setq ele (car lst)) lst)
  lst-F	(cons (cons ele (- n (length lst))) lst-F)
   )
 )
) 

[(gile)]

Lovecraft,

 

je crains que ce que tu demandes ne soit difficile (en tout cas pour moi), il s'agit d'un jeu dans lequel la rapidité des réponses entre aussi en ligne compte. Il y perdrait en intérêt s'il fallait commenter chaque ligne de code.

 

Mais si d'aucun pose des questions à propos des codes postés, je pense que les participants y répondraient ou commenteraient leur codes "à posteriori".

 

On pourrait aussi envisager des "challenges" plus simples auxquels les plus aguerris ne participeraient pas directement ou seulement au bout d'un délai défini.

[Bred]

tu peux supprimer la mise à nil de la variable lst-F puisqu'elle est déclarée

Je sais, mais j'ai tendance par "sécurité" (et pendant mes test) à mettre à nil les listes que je construit avec cons et append ...

 

j'éviterais un (vl-remove ...) en conservant la valeur de (car lst).

C'est ce que j'essayais de faire avant que je n'édite mon code... et maintenant que tu l'as fait je me demande sur quoi je blocais ....

 

lovecraft : j'y fairais attention dorénavent.

(defun test (lst / LST-F ele N) ;;; commande test avec argument lst (liste à trier)

(setq lst (vl-sort lst '>)) ;;; Tri la liste par ordre alphabétique contraire

(while lst ;;; Boucle : "tant que lst existe"

(setq n (length lst) ;;; nombre d'élément dans liste mis dans variable n

lst (vl-remove (setq ele (car lst)) lst) ;;; crées nouvel lst en enlevant 1er élement à toute la liste (et le récupère dans variable ele)
lst-F (cons (cons ele (- n (length lst))) lst-F) ;;; construit la liste finale en retranchant le nombre n à la liste restante.
)
)
)

 

... c'est pas facile à expliquer comme ça en fait ...

 

donc :

(test '("a" "b" "c" "f" "a" "c" "f" "g" "t" "b" "c" "a"))

retourne

(("a" . 3) ("b" . 2) ("c" . 3) ("f" . 2) ("g" . 1) ("t" . 1))

 

[Patrick_35]

eh bien bravo à vous deux et plus particulierement à Bred, car il a bien vu exactement ou je voulait en venir. ;) et à (gile) qui a apporté la touche finale.

Vous êtes trop bon, il va falloir "corsé" le truc. Demain j'en post un autre qui ne va pas être facile.

 

Voici mon lisp qui se differencie juste pour la méthode de trie

(defun test(lst / n js tbl)
 (while lst
   (setq n   (length lst)
  js  (car lst)
  lst (vl-remove js lst)
  tbl (cons (cons js (- n (length lst))) tbl)
   )
 )
 (vl-sort tbl '(lambda (a b) (< (car a) (car b))))
)

 

Pour lovecraft

Tu as une liste composé de cette manière

("a" "b" "c" "f" "a" "c" "f" "g" "t" "b" "c" "a")

 

En suivant la méthode de Bred

Tu fais un trie avec (vl-sort lst '>), ce qui donne

("t" "g" "g" "f" "f" "c" "c" "c" "b" "b" "a" "a" "a")

Et dans ce sens, car lors de la constitution de la liste finale, le cons inverse le sens de la liste

Ensuite, tu fais une boucle dite itérative sur le test tant que la variable lst n'est pas vide

Un length compte les éléments d'une liste

un vl-remove "f" lst efface tous les "f" qui se trouvent dans la liste

on recompte les élements qui restent dans la liste, ce qui permet de déduire combien il y avait de "f"

Pour terminer un cons de "f" sur le différentiel et le tour est joué

 

@+

[Patrick_35]

Et pour compléter la réponse de (gile), on recherche aussi la beauté du code. Etre le plus concis possible

C'est une manière aussi de monter l'utilité de certaines fonctions qui peuvent paraitre nébuleuses.

 

On pourrait aussi envisager des "challenges" plus simples auxquels les plus aguerris ne participeraient pas directement ou seulement au bout d'un délai défini.

Il faudait le préciser, je suis pour, au contraire :D

 

@+

 

[Edité le 18/5/2007 par Patrick_35]

[lovecraft]

Merci pour l'importance que vous avez apporté a ma demande. en ce qui me concerne j'ai qqes notions en lisp et en VBA donc en cherchant un peu voir beaucoup j'arrive à comprendre ce que vous faites , un p'tit bémol, je ne connais rien en Vlisp (je suis entrain d'aborder le sujet)

Et pour reprendre la reponse de gile, je comprends bien qu'il s'agisse d'un challenge concernant les plus aguéri.Mais l'idée d'un challenge pour ce qui début et une merveilleuse idée.

Encore merci à vous trois.

 

PS: J'attends que l'un d'entre vous lance un challenge pour les débutants.

[(gile)]

Salut,

 

Je vais essayer de commenter/expliquer la routine test3.

 

http://img205.imageshack.us/img205/5536/challengeup8.png

 

Cette routine est un exercice de style qui utilise une forme récursive.

 

En informatique et en logique, une fonction ou plus généralement un algorithme qui contient un appel à elle-même est dite récursive.

source : Wikipedia

 

À ceux qui ne savent rien de la récursivité, je recommande de lire d'abord ce sujet et cet exemple.

 

 

(defun test3 (lst / sub) ...

Comme toutes les routines de ce "challenge", test3 admet un argument : la liste dont il faut compter les éléments.

Elle admet aussi une variable locale, la sous routine sub ; l'utilisation de la récursivité impose de définir un fonction (defun ...) pour pouvoir la rappeler.

Déclarer la sous routine comme variable locale permet de remettre la variable sub à nil à la fin de l'exécution de test3 donc de libérer de la mémoire et d'éviter tout conflit avec une autre routine du même nom.

 

La sous routine sub admet 2 arguments : la liste à traiter (lst) et un entier (n) qui servira à compter chaque occurence d'un même terme.

 

Pour comprendre ce qui se passe ensuite dans la sous routine, je propose de prendre un exemple avec une liste plus courte mais significative et de faire un "pas à pas".

 

(setq lst '("a" "c" "b" "c" "a"))

 

Le premier appel à sub se situe dans test3 : (sub (vl-sort lst '

On peut le traduire :

(sub '("a" "a" "b" "c" "c") 1)

 

La première évaluation dans sub (if (cadr lst) ... est la condition d'arrêt si elle n'est pas remplie (si la liste ne comporte qu'un élément)

Lors de ce premier appel, la condition est remplie, on passe à la deuxième évaluation : (if (equal (car lst) (cadr lst)) ... qui détermine si les deux premiers éléments sont identiques.

Cette condition étant remplie, il se produit un nouvel appel à sub avec de nouveaux arguments (sub (cdr lst) (1+ n)) qu'on peut traduire :

(sub '("a" "b" "c" "c") 2)

 

Deuxième appel (sub '("a" "b" "c" "c") 2) : la première condition est remplie mais pas la seconde : le premier et le deuxième éléments de la liste sont différents.

Il se produit un nouvel appel à sub sous une forme différente (cons (cons (car lst) n) (sub (cdr lst) 1)) qu'on peut traduire :

(cons '("a" . 2) (sub '("b" "c" "c") 1))

 

Troisième appel (sub '("b" "c" "c") 1) : même chose que précédemment, (sub '("b" "c" "c")) retourne (cons '("b" . 1) (sub '("c" "c") 1)) on en est donc à :

(cons '("a" . 2) (cons '("b" . 1) (sub '("c" "c") 1)))

 

Le quatrième appel (sub '("c" "c") 1) retourne (sub '("c") 2)

(cons '("a" . 2) (cons '("b" . 1) (sub '("c") 2)))

 

Cinquième appel (sub '("c") 2) : la première condition n'est pas remplie, c'est la condition d'arrêt qui au lieu de faire un nouvel appel à sub, évalue (list (cons (car lst) n)), soit (list ("c" . 2)).

On a donc au final une expression qui ne contient plus d'appel à sub :

(cons '("a" . 2) (cons '("b" . 1) (list ("c" . 2))))

 

C'est la fin de la phase dite "d'empilement".

 

L'évaluation de cette expression ("dépilement") retourne :

(("a" . 2) ("b" . 1) ("c" . 2))

 

Voilà, j'espère ne pas avoir été trop confus.

 

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

[bonuscad]

Pour voir le "pas à pas" d'une fonction récursive, il y a la fonction (trace function)

 

Exemple ici, avant d'utiliser test3 on ferait (trace sub), ce qui fait que les appels de la fonction sub est tracé avec une indentation pour chaque profondeur d'appel avec les arguments soumis et en retour le résultat à chaque niveau.

 

NB: fonction (untrace) pour arrêter de tracer une fonction, ici (untrace sub)

 

et des (print variable) bien placé dans le code peuvent bien aider à la compréhension du déroulement d'une routine lorsqu'on ne saisi pas tout. Je place aussi des fois un (getkword) ou (grread) dans une boucle pour faire défiler le pas à pas à ma convenance.

 

Voilà pour les astuces pour décortiquer un lisp un peu complexe et aider à sa compréhension.

Ceci pour ceux qui n'utilise pas ou peu l'éditeur vlide comme moi (les dinosaures quoi) ;) alors qu'il présente des fonctions évolués pour faire la même chose. (points d'arrêt, espions...)

[(gile)]

Pour voir le "pas à pas" d'une fonction récursive, il y a la fonction (trace function)

 

Tout à fait, mais je pensais plus explicite de montrer le pas à pas avec les (cons ... ) à chaque étape.

 

La fenêtre de suivi après avoir "tracé" sub :

 

http://img503.imageshack.us/img503/6804/challenge3ie4.png

 

PS : je ne pense pas pouvoir donner des explications aussi fouillées à chaque fois...

 

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

[lecrabe]

 

Bonjour

 

Bravo à (gile), Bonuscad, Patrick_35_ Bred, Didier Duhem, etc

Sorry pour ceux que j'ai oublié ...

 

Le Decapode "humble"

 

[ElpanovEvgeniy]

 (defun test5 (lst)
(if lst
 (cons (cons (car lst) (length (vl-remove-if-not '(lambda (x) (equal x (car lst))) lst)))
       (test5 (vl-remove (car lst) lst))
 ) ;_  cons
) ;_  if
) ;_  defun

(setq lst '("a" "b" "c" "f" "a" "c" "f" "g" "t" "b" "c" "a" 1 2 1 nil 1 1 2 nil))
returne
'(("a" . 3) ("b" . 2) ("c" . 3) ("f" . 2) ("g" . 1) ("t" . 1) (1 . 4) (2 . 2) (nil . 2))

 

[Edité le 23/5/2007 par ElpanovEvgeniy]

[Patrick_35]

Great ElpanovEvgeniy, but you have a little error with test4 instead of test5 ;)

It's a nice function.

 

@+

[ElpanovEvgeniy]

Great ElpanovEvgeniy, but you have a little error with test4 instead of test5 ;)

It's a nice function.

 

@+

 

Merci!

A corrigй...

[Matt666]

Un peu à la bourre !!!

(defun test (lst / pts listt)
    (setq lst (mapcar '(lambda (x) (cons x 1)) (acad_strlsort lst)))
    (foreach pt lst
         (if  (eq 
                   (vl-position 
                        (setq pts (cons 
                                  (car pt) 
                                  (apply '+ (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) (car pt))) lst)))
                        ))
                        listt
                   )
                   nil
              )
              (setq listt (cons pts listt))
         )
    )
    (if listt (reverse listt))
) 

 

Tout ça pour dire : A quand un nouveau challenge pas trop dur ??? :D

 

A bientôt.

Matt.

[Patrick_35]

Tout ça pour dire : A quand un nouveau challenge pas trop dur ??? :D

 

Tu peux faire une recherche sur les challenges, tu en trouveras plusieurs.

 

Faire des challenges à des niveaux intermédiaires ne remporte pas beaucoup de succès :(

 

@+

[Matt666]

Faire des challenges à des niveaux intermédiaires ne remporte pas beaucoup de succès

 

Effectivement d'après ce que je vois dans les forums, c'est le cas... Dommage.

 

Merci quand même d'avoir proposé ces exercices intéressants !

A bientot.

matt