4-LOOP: tout un programme!

Le texte qui suit peut être collé à la suite des fonctions Clisp.

Ma source d'inspiration a été :

Practical Common Lisp de Peter Seibel

dont vous pouvez visiter le site :

http://www.gigamonkeys.com/book/

Mais, là, tout est en anglais.

                                                     _____________________________

>>>>

Liste des symboles rencontrés dans ce chapitre:

loop return for collect collecting from downfrom upfrom to upto below downto above repeat in on by across compile disassemble sum summing count counting find then with append nconc maximize minimize it gethash initially finally named while until always never thereis digit-char-p loop-finish time 

LOOP: tout un programme!

Macro LOOP:

(defparameter n 0)

N

RETURN:

(loop   ;version loop simple

           (when (> n 10)         ;quand n est supérieur à 10 (n = 11)

             (return))            ;il y a sortie d'itération (n vaut alors 11)

           (format t "~a " n)     ;la valeur de n est affichée

           (incf n))              ;n est incrémentée

0 1 2 3 4 5 6 7 8 9 10 

NIL

(attention: (1+ n) n'incrémente pas n, mais rend n + 1.

n resterait, alors, à zéro. Préalable: (setf n 0).

Remarque: pour remettre n à zéro, on peut ajouter (setf n 0) juste avant (return).

version loop étendue:

du vocabulaire à retenir: do, return, across, in, on, of, as, and, collecting, counting,

finally, for, from, downfrom, upfrom, to, upto, below, downto, above,

by, summing, then, it

FOR:

COLLECTE:

COLLECTING:

FROM:

DOWNFROM:

TO:

UPTO:

BELOW:

DOWNTO:

ABOVE:

(loop for i from 1 to 10 collecting i)

(1 2 3 4 5 6 7 8 9 10)                           la valeur incrémentale est 1 par défaut

(loop for i from 10 to 1 collecting i)

NIL                                                      la valeur incrémentale étant 1 par défault et 10 étant déjà plus grand que 1

  il faut écrire:

(loop for i from 10 downto 1 collecting i)

(10 9 8 7 6 5 4 3 2 1)

ou bien:

(loop for i downfrom 10 to 1 collecting i)

(10 9 8 7 6 5 4 3 2 1)

(loop for i upto 10 collect i)

(0 1 2 3 4 5 6 7 8 9 10)                       la valeur de départ est 0 par défaut.

(loop for i downto -10 collect i)   est une erreur, il faut écrire:

(loop for i from 0 downto -10 collect i)

(0 -1 -2 -3 -4 -5 -6 -7 -8 -9 -10)          ici, il faut préciser la valeur de départ

(loop for i from 5 below 10 collect i)

(5 6 7 8 9)                                           les itérations s'arrêtent à 9 (sous 10)

(loop for i from 5 above 2 collect i)

(5 4 3)                                                les itérations s'arrêtent à 3 (au dessus de 2)

(loop for i from 5 above 10 collect i)

NIL                                                   il n'y a rien entre 5 et 10 (très proche de 10 et

au dessus)

REPEAT:

A la place de:

(loop for i from 1 to 3 do (format t "coucou~%"))

coucou

coucou

coucou

NIL

on peut écrire:

(loop repeat 3 do (format t "coucou~%"))

coucou

coucou

coucou

NIL

La clause repeat ne crée pas de variable de boucle explicitement.

(loop

      for item in '(a b c d e f g h)

      for i from 1 to 10

      do (format t "~a: ~a; " i item))

1: A; 2: B; 3: C; 4: D; 5: E; 6: F; 7: G; 8: H;

NIL                                                   on peut avoir plusieurs clauses for dans un LOOP

ici, c'est la liste qui conditionne la fin du loop (8 éléments)

LOOP et les collections:

les listes:

IN:

(loop for i in '(10 20 30 40) collect i)

(10 20 30 40)                                  à chaque itération, i prend la valeur de chaque élément de la liste (c'est à dire le CAR de la liste, puis le CAR du CDR, etc

ON:

(loop for i on '(10 20 30 40) collect i)

((10 20 30 40) (20 30 40) (30 40) (40))

                                 à chaque itération, i prend pour valeur la liste, puis le CDR

de la liste, etc

BY: est suivi d'une fonction qui prend une liste et rend une sous-liste.

Le loop s'applique à la première liste, puis à la sous-liste, etc

(loop for i in '(10 20 30 40 50 60) by #'cddr collect i)

(10 30 50)                                  à chaque itération i prend pour valeur le  1er élément de la liste puis le 1er élément du CDDR, etc

(loop for i on '(10 20 30 40) by #'cddr collect i)

((10 20 30 40) (30 40))                          à chaque itération i prend pour valeur la liste puis le CDDR de la liste, etc

Les vecteurs (incluant les strings et les bit-vectors):

ACROSS:

(loop for x across "arbre" collect x)

(#\a #\r #\b #\r #\e)                                rend la liste des caractères du mot

(loop for x across #*10110 collect x)

(1 0 1 1 0)                                  rend la liste des bits composants le vecteur-bit

(loop for x across #(a 1 2 b c) collect x)

(A 1 2 B C)                               rend la liste des coordonnées du vecteur

LOOP et table de hachage: voir "tables de hachage:". (dans un prochain article)

LOOP et packages: voir "LOOP et les packages:". (dans un prochain article)

AND: (clause loop à ne pas confondre avec la fonction Clisp)

(defun nbs-fibo (min max)
   "rend les nombres de Fibonacci entre min et max." ;min et max représentent les rangs
   (if (and (<= 0 min) (> max min)) ;min doit être positif et max plus grand que min
       (let ((min (ceiling min)) (max (floor max))) ;min et max sont transformés en entiers
(loop for i from 1 to max ;on fait varier i de 1 à max
    for x = 0 then y ;la valeur initiale de x est 0 et x prend la valeur de y à la prochaine itération
    and y = 1 then (+ x y) ;la valeur initiale de y est 1 et y prend la valeur x+y à la prochaine itération
    when (>= i min) collect y)) ;rend la liste des y à partir de i=min
       (error "le 1er argument doit être plus grand ou égale à zéro et le 2ème plus grand que le 1er.")))

(voir THEN: plus loin)

(defun suite-fibo (p)

           "rend les p premiers nombres de la suite de Fibonacci dans une liste."

   (loop for i from 0 to p

      collecting

      (do ((n 0 (1+ n))

      (cur 0 next)

      (next 1 (+ cur next)))

     ((= i n) cur))))

SUITE-FIBO     

(suite-fibo 15)

(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610)

                        rend la suite de Fibonacci jusqu'au 15ème rang (16 nombres)

COMPILE:

(compile 'suite-fibo)

SUITE-FIBO

NIL

NIL compile la fonction suite-fibo

Pour voir le code résultant de cette compilation:

DISASSEMBLE:

   

(disassemble 'suite-fibo)

; disassembly for SUITE-FIBO

; 0DE0204E:       8B4DE8           MOV ECX, [EBP-24]          ; no-arg-parsing entry point

;      051:       F6C103           TEST CL, 3

;      054:       7416             JEQ L0

;      056:       8D41F9           LEA EAX, [ECX-7]

;      059:       A807             TEST AL, 7

;      05B:       0F85D3000000     JNE L8

;      061:       8A41F9           MOV AL, [ECX-7]

;      064:       3C16             CMP AL, 22

;      066:       0F87C8000000     JNBE L8

;      06C: L0:   C745F000000000   MOV DWORD PTR [EBP-16], 0

;      073:       E8A8EA1FF3       CALL #x1000B20             ; ALLOCATE-CONS-TO-EAX

;      078:       C740FD0B001001   MOV DWORD PTR [EAX-3], 17825803

;      07F:       C740010B001001   MOV DWORD PTR [EAX+1], 17825803

;      086:       8945E4           MOV [EBP-28], EAX

;      089:       8945FC           MOV [EBP-4], EAX

;      08C:       E987000000       JMP L7

;      091: L1:   8B45FC           MOV EAX, [EBP-4]

;      094:       8945EC           MOV [EBP-20], EAX

;      097:       31C0             XOR EAX, EAX

;      099:       C745F800000000   MOV DWORD PTR [EBP-8], 0

;      0A0:       C745F404000000   MOV DWORD PTR [EBP-12], 4

;      0A7:       EB2E             JMP L5

;      0A9: L2:   BF04000000       MOV EDI, 4

;      0AE:       8BD0             MOV EDX, EAX

;      0B0:       E8A3E01FF3       CALL #x1000158             ; GENERIC-+

;      0B5:       7302             JNB L3

;      0B7:       8BE3             MOV ESP, EBX

;      0B9: L3:   8955FC           MOV [EBP-4], EDX

;      0BC:       8B55F8           MOV EDX, [EBP-8]

;      0BF:       8B7DF4           MOV EDI, [EBP-12]

;      0C2:       E891E01FF3       CALL #x1000158             ; GENERIC-+

;      0C7:       7302             JNB L4

;      0C9:       8BE3             MOV ESP, EBX

;      0CB: L4:   8B45FC           MOV EAX, [EBP-4]

;      0CE:       8B4DF4           MOV ECX, [EBP-12]

;      0D1:       894DF8           MOV [EBP-8], ECX

;      0D4:       8955F4           MOV [EBP-12], EDX

;      0D7: L5:   8945FC           MOV [EBP-4], EAX

;      0DA:       8B55F0           MOV EDX, [EBP-16]

;      0DD:       8BF8             MOV EDI, EAX

;      0DF:       E8F6E21FF3       CALL #x10003DA             ; GENERIC-EQL

;      0E4:       8B45FC           MOV EAX, [EBP-4]

;      0E7:       75C0             JNE L2

;      0E9:       E832EA1FF3       CALL #x1000B20             ; ALLOCATE-CONS-TO-EAX

;      0EE:       8B4DF8           MOV ECX, [EBP-8]

;      0F1:       8948FD           MOV [EAX-3], ECX

;      0F4:       C740010B001001   MOV DWORD PTR [EAX+1], 17825803

;      0FB:       8945FC           MOV [EBP-4], EAX

;      0FE:       8B4DEC           MOV ECX, [EBP-20]

;      101:       894101           MOV [ECX+1], EAX

;      104:       8B55F0           MOV EDX, [EBP-16]

;      107:       BF04000000       MOV EDI, 4

;      10C:       E847E01FF3       CALL #x1000158             ; GENERIC-+

;      111:       7302             JNB L6

;      113:       8BE3             MOV ESP, EBX

;      115: L6:   8955F0           MOV [EBP-16], EDX

;      118: L7:   8B55F0           MOV EDX, [EBP-16]

;      11B:       8B7DE8           MOV EDI, [EBP-24]

;      11E:       E88BE21FF3       CALL #x10003AE             ; GENERIC->

;      123:       0F8E68FFFFFF     JLE L1

;      129:       8B45E4           MOV EAX, [EBP-28]

;      12C:       8B5001           MOV EDX, [EAX+1]

;      12F:       8BE5             MOV ESP, EBP

;      131:       F8               CLC

;      132:       5D               POP EBP

;      133:       C3               RET

;      134: L8:   8B45E8           MOV EAX, [EBP-24]

;      137:       8B0D1820E00D     MOV ECX, [#xDE02018]       ; 'REAL

;      13D:       CC0A             BREAK 10                   ; error trap

;      13F:       03               BYTE #X03

;      140:       1F               BYTE #X1F                  ; OBJECT-NOT-TYPE-ERROR

;      141:       10               BYTE #X10                  ; EAX

;      142:       50               BYTE #X50                  ; ECX

;      143:       CC0A             BREAK 10                   ; error trap

;      145:       02               BYTE #X02

;      146:       18               BYTE #X18                  ; INVALID-ARG-COUNT-ERROR

;      147:       4F               BYTE #X4F                  ; ECX

NIL

SUMMING:

(loop for x from 1 to 10 summing (expt x 2))   >>      385

rend la somme des carrés des entiers de 1 à 10

Rappel :

(exp 1)     >>      2.7182817 (e)

(expt 3 2)     >>    9

SUITE DE SYRACUSE: (la suite de Syracuse "finit" (toujours?) par ...2,1,4,2,1,4,2,1,...)
Toujours? Cela reste à démontrer!

(defun suite_syracuse (nb max) ;nb est le premier terme et max est le nombre de termes
   "rend la suite de Syracuse jusqu'au rang max à partir du nombre nb."
   (if (and (integerp nb) (< 1 max))   ;nb doit être un entier et max est supérieur à 1
       (loop for i from 1 to max
    for y = nb then (if (= 0 (mod y 2)) (/ y 2) ;y prend la valeur de nb, puis la valeur de y/2 si y est pair
(+ (* 3 y) 1)) ;ou bien la valeur de 3y+1 si y est impair
    collect y)
       (error "Le 1er argument doit être un entier et le 2ème plus grand que 1.")))

(suite_syracuse 19 30)
(19 58 29 88 44 22 11 34 17 52 26 13 40 20 10 5 16 8 4 2 1 4 2 1 4 2 1 4 2 1)

Pour améliorer la fonction précédente, il peut être utile de vérifier si la suite est bien de syracuse.
Voici un pseudo-prédicat qui le vérifie.
Attention, cependant, car NIL ne veut pas dire que ce n'est pas une suite de syracuse.

(defun syracusep (n max)
   "Le nombre n commence-t-il une suite de siracuse? T si un nombre de la suite est 1.
NIL signifie qu'un nombre de la suite dépasse max: il faut alors augmenter max. Il s'agit donc d'un pseudo-prédicat."
   (if (and (integerp n) (< 0 n))     ;n doit être un entier positif
       (labels ((suitep (i max)       ;définition d'une fonction locale
   (if (> i max) nil       ;rend NIL si i>max
       (if (= i 1) t       ;rend T si i=1 (c'est bien une suite de syracuse)
   (suitep ((lambda (p) (if (= (mod p 2) 0) (/ p 2)     ;calcule du nombre suivant
       (+ (* p 3) 1))) i) max)))))
(suitep n max))       ;appel de la fonction locale
       (format t "Le 1er argument doit être un entier positif."))) ;affichage si n n'est pas un entier positif

Je vous laisse faire les modifications nécessaires.

(defun nb_syracuse (min top max1) ;attention min doit être un entier positif!
   "Teste chaque nombre entier positif entre min et top pour savoir s'il commence une suite de syracuse.
max1 limite les calculs quand des nombres trop grands apparaissent dans la suite."
   (do ((j min (1+ j)))     ;itération sur j à partir de min et incrémentation de 1
       ((>= j top) 'terminé)   ;affichage si i>=top
(if (syracusep j max1) (format t "~a " j) ;affichage de j s'il commence bien une suite de syracuse,sinon:
    (format t "Soit ~a ne commence pas une suite de syracuse (peu probable), soit l'argument ~a est trop faible." j max1))))

Essayez:
(nb_syracuse 900 1000 100000)

puis:
(nb_syracuse 900 1000 1000000) ;donc un zéro de plus dans le 3ème argument

Les nombres d'une suite de syracuse peuvent être grands.
La fonction suivante permet de trouver le plus grand nombre d'une suite de syracuse.
Le 1er argument est le 1er nombre de la suite.
Le 2ème argument est le nombre au delà duquel les calculs s'arrêtent (mais il peut être augmenté).

(defun nbmaxsyracuse (n max)
   "rend le plus grand nombre de la suite de syracuse obtenu à partir du nombre n (1er argument).
le 2ème argument est une puissance de 10 qui limite les calculs."
   (if (and (integerp n) (< 0 n))        ;n doit être un entier positif
       (if (syracusep n max)      ;n doit débuter une suite de syracuse, sinon augmenter max
   (let ((k n))     ;initialisation de k à n
       (labels ((suitep (i max)     ;définition d'une fonction locale
  (cond ((> i max) nil) ;cette condition rend NIL si syracusep (au dessus) n'est pas utilisé
((= i 1) (print k)) ;imprime k (le plus grand nombre) quand i=1
((< k i) (setf k i) (suitep ((lambda (p) (if (= (mod p 2) 0) (/ p 2) ;change la valeur de k si i est plus grand
       (+ (* p 3) 1))) i) max))         ;puis calcule le nombre suivant
(t (suitep ((lambda (p) (if (= (mod p 2) 0) (/ p 2)
       (+ (* p 3) 1))) i) max))))) ;calcule le nombre suivant dans tous les autres cas
(suitep n max)))        ;appel à la fonction locale
   (format t "Il peut être nécessaire d'augmenter le 2ème argument max.")) ;affichage si syracusep est NIL
       (format t "Le 1er argument doit être un entier positif.")))     ;affichage si n n'est pas un entier positif

Essayez:

(nbmaxsyracuse 937 100000)
Il peut être nécessaire d'augmenter le 2ème argument max.
NIL

(nbmaxsyracuse 937 1000000) ;on ajoute un zéro au deuxième argument

250504
250504

La suite de syracuse commençant à 937 monte jusqu'à 250504 et redescend à 1!!!

COUNTING:

FIND:

(loop for x across "combien cette phrase contient-elle de voyelles?"

      counting (find x "aeiou"))       >>      16

Pour compter chaque lettre dans un texte (attention! Les majuscules ne sont pas prises en compte et des symboles particuliers dans le texte à analyser peuvent provoquer une erreur. En cherchant bien, vous pourrez résoudre ces problèmes-là.) :

(loop for x across "abcdefghijklmnopqrstuvwxyz"
     do (format t "~a: ~a; " x (loop for y across "combien de fois cette phrase contient-elle les lettres de l'alphabet?"
     counting (find y (list x)))))

a: 3; b: 2; c: 3; d: 2; e: 13; f: 1; g: 0; h: 2; i: 3; j: 0; k: 0; l: 6; m: 1; n: 3; o: 3; p: 2; q: 0; r: 2; s: 4; t: 7; u: 0; v: 0; w: 0; x: 0; y: 0; z: 0; 
NIL

(loop for i below 10

      and a = 0 then b

      and b = 1 then (+ b a)

      finally (return a))        >>      55 nombre de fibonacci de rang 10 (11ième nombre)

curiosité? L'itération sur i devrait s'arrêter sur 9 (voir below plus haut).

Et pour i=9 a vaut 34 !!!

finally semble imposer une itération de plus.

Comparez avec ce qui suit:

(loop for i below 10

               and a = 0 then b

               and b = 1 then (+ b a)

               collecting (list i a b))

((0 0 1) (1 1 1) (2 1 2) (3 2 3) (4 3 5) (5 5 8) (6 8 13) (7 13 21) (8 21 34) (9 34 55))

A la dernière itération, a vaut bien 34.

Pour bien comprendre, voici un tableau qui montre chaque itération du loop :

i	0	1	2	3	4	5	6	7	8	9
a=0	1	1	2	3	5	8	13	21	34	55
b=1	1	2	3	5	8	13	21	34	55	89

Les valeurs de a et b sont les valeurs en fin d'itération (donc finally).

THEN:

Clause equals-then: (loop for var = initial-value-form [then step-form] ...)

(loop repeat 5

      for x = 2

      for y = 1 then (+ x y)

      collect y)

(1 3 5 7 9)                     ici, il n'y a pas de clause then après le 1er for (x est réinitialisé à 2 à chaque itération)

(loop repeat 5

      for x = 0 then y

      for y = 1 then (+ x y)

      collect y)

(1 2 4 8 16)                    le couple (x,y) prend à chaque itération les valeurs successives suivantes: (0,1) (1,2) (2,4) (4,8) (8,16)

y est donc calculée avec la nouvelle valeur de x

si on échange les lignes "for x" et "for y":

(loop repeat 5

      for y = 1 then (+ x y)

      for x = 0 then y

      collect y)

(1 1 2 4 8)                c'est x, cette fois, qui prend la nouvelle valeur de y

Si on ne veut pas prendre la nouvelle valeur, mais l'ancienne, après la 1ère clause for on utilise and à la place de for:

(loop repeat 10

      for x = 0 then y

      and y = 1 then (+ x y)

      collect y)

(1 1 2 3 5 8 13 21 34 55)                on obtient la suite de Fibonacci (sauf 0)

WITH:        permet de créer une variable locale dans LOOP

(loop repeat 5

      with a = 10

      for x = 1 then 2

      for y = 2 then (* x y)

      collect (* a y))

(20 40 80 160 320)                 rend la suite des puissances de 2 multipliées par 10

Variables destructurantes: une caractéristique de LOOP.

(loop for (c (a b)) in '((h (1 2)) (j (3 4)) (k (5 6)))

      do (format t "~a => a: ~a; b: ~a~%" c a b))

H => a: 1; b: 2

J => a: 3; b: 4

K => a: 5; b: 6

NIL                                        LOOP a la propriété de destructurer: toute variable qui suit for ou with peut être remplacée par un arbre et la liste qui suit in sera destructurée selon l'arbre (si possible).

On peut ignorer une valeur dans la liste destructurée:

(loop for (c (a nil)) in '((h (1 2)) (j (3 4)) (k (5 6)))

      do (format t "~a => a: ~a;~%" c a))

H => a: 1;

J => a: 3;

K => a: 5;

NIL

On peut utiliser les listes pointées:

Au lieu d'écrire:

(loop for cons on '(a b c d)        ;cons représente une liste (sous-liste de (a b c d))

      do (format t "~a" (car cons))    ;(car cons) est le premier élément de la sous-liste cons

      when (cdr cons) do (format t ", "))  ;tant que (cdr cons) vaut T, on affiche une virgule

A, B, C, D

NIL

... On peut faire:

(loop for (item . rest) on '(a b c d)   ;(item . rest) représente, successivement, (a . (b c d)),                                                             (b . (c d)), (c . (d)), (d . nil)

      do (format t "~a" item)   ;item est un élément de (a b c d)

      when rest do (format t ", "))   ;quand rest est NIL, la virgule n'est pas affichée

A, B, C, D

NIL

LOOP et les clauses d'accumulation de valeur:

APPEND:

NCONC:

MAXIMIZE:

MINIMIZE:

Chaque clause a la structure suivante: verbe form [into var], le verbe pouvant être: collect, append, nconc, count, sum, maximize, minimize (les participes présents sont synonymes: collecting, etc). Si into est présent la valeur est sauvée dans var.

(defparameter *random20* (loop repeat 30 collect (random 20)))

*RANDOM20*                 définit un paramètre qui contient une liste de 30 nombres aléatoires compris entre 0 et 20 (20 non compris)

(loop for i in *random20*

      count i into N   ;place dans N le nombre d'entiers de la liste *random*

      count (evenp i) into evens   ;place dans evens le nombres d'entiers pairs

      count (oddp i) into odds   ;place dans odds le nombre d'entiers impairs

      sum i into total   ;place dans total la somme des entiers de la liste *random*

      maximize i into max   ;place dans max le plus grand des entiers

      minimize i into min   ;place dans min le plus petit des entiers

      finally (return (list min max (/ total N) evens odds)))   ;finalement, rend une liste                                                                                                       d'éléments calculés

(0 19 301/30 15 15)                       accumule le nombre de valeurs de la liste du

paramètre *random20*, le nombre de valeurs paires, le nombre de valeurs impaires, le total, le maximum, le minimum. Puis rend sous forme d'une liste le minimum, le maximum, la moyenne (total/N), le nombre de valeurs paires, le nombre de valeurs impaires.

       Bien noter la clause finally qui retourne le résultat en fin d'itération

Sortie inconditionnelle:

(block sortie

   (loop for i from 0 to 10 return 100 do (print i))

   (print "c'est une sortie inconditionnelle du LOOP qui rend 100. Le code qui suit le LOOP est évalué et cela rend: ")

   200)

"c'est une sortie inconditionnelle du LOOP qui rend 100. Le code qui suit le LOOP est évalué et cela rend: "

200

Remarque: ici, RETURN est une clause LOOP et "return 100" dans le code est équivalent à: do (return 100).

(block sortie

   (loop for i from 0 to 10 do (return-from sortie 100) (print i))

   (print "Rien ne s'imprimera.")

   200)

100                         cette fois, c'est une sortie inconditionnelle du bloc "sortie"

qui rend 100

Exécution conditionnelle:

Une clause DO peut contenir toute expression Lisp, en particulier des IF et des WHEN.

(loop for i from 1 to 10 do (when (evenp i) (format t "~a; " i)))

2; 4; 6; 8; 10;

NIL                      seuls les nombres pairs sont imprimés

Mais si on veut la somme des nombres pairs, on ne peut pas utiliser sum dans une clause DO: sum n'a pas de sens au sein d'une forme Lisp. Heureusement, LOOP a ses propres expressions conditionnelles IF, WHEN et UNLESS:

(loop for i from 1 to 10 when (evenp i) sum i)

30

La construction d'une condition LOOP a la structure suivante:

mot-condition test clause-loop

où:

• mot-condition est IF ou WHEN ou UNLESS,
• test est une form Lisp,
• clause-loop est une clause d'accumulation de valeurs (count, collect, etc), ou une clause d'exécution inconditionnelle, ou une autre clause d'exécution conditionnelle. On peut relier plusieurs clauses LOOP dans une même condition avec AND.

(loop for i from 1 to 100

      if (evenp i)

        minimize i into pair-min and

        maximize i into pair-max and

        unless (zerop (mod i 4))

          sum i into total-non-multiple-de-quatre-pair

        end

        and sum i into total-pair

      else

        minimize i into impair-min and

        maximize i into impair-max and

        when (zerop (mod i 5))

          sum i into total-multiple-de-cinq-impair

        end

        and sum i into total-impair

      finally (format t "Minimum pair: ~a,~%Maximum pair: ~a,~%Minimum impair: ~a,~%Maximum impair: ~a,~%Total pair: ~a,~%Total impair: ~a,~%Total des multiples de cinq impairs: ~a,~%Total des non multiples de 4 pairs: ~a." pair-min pair-max impair-min impair-max total-pair total-impair total-multiple-de-cinq-impair total-non-multiple-de-quatre-pair))

Minimum pair: 2,

Maximum pair: 100,

Minimum impair: 1,

Maximum impair: 99,

Total pair: 2550,

Total impair: 2500,

Total des multiples de cinq impairs: 500,

Total des non multiples de 4 pairs: 1250.

NIL              la clause finally permet de retourner le résultat en fin d'itération, alors que DO, à la place, afficherait un résultat à chaque itération

IT : (clause de LOOP)

GETHASH:

(defparameter *h* (make-hash-table))

*H*             définit une table de hachage

    (voir tables de hachage: plus loin)

(setf (gethash 'foo *h*) 'toto)

TOTO

(setf (gethash 'bar *h*) 'tonton)

TONTON

(setf (gethash 'baz *h*) 'tata)

TATA

                définit des couples (clé valeur)

(loop for key in '(foo bar) when (gethash key *h*) collect it)

(TOTO TONTON)              collecte les valeurs des clés foo et bar et la variable

                                             IT prend la valeur rendue par le test (gethash key *h*)

INITIALLY:

FINALLY: deux mots-clés de LOOP, ce sont les clauses de prologue et d'épilogue

on peut initialiser des variables en prologue et rendre un calcul du loop en épilogue

(defparameter var1 0)

VAR1         définition d'une variable pour éviter l'erreur dans ce qui suit:

(loop for i from 1 to 10

      initially (setq var1 100)

      if (evenp i)

        sum i into total-paire

      finally (incf var1 total-paire)(format t "Variable + total = ~a." var1))

Variable + total = 130.

NIL                       en prologue, var1 est initialisée à 100, juste après l'initialisation

des variables locales du LOOP et avant le corps du LOOP.

En épilogue, juste après la dernière itération du LOOP, var1 est incrémentée de total-paire et le résultat est affiché.

Le prologue a lieu même s'il n'y a pas d'itération.

L'épilogue n'a pas lieu dans les cas suivants:

- une clause return s'exécute

- un appel à RETURN, RETURN-FROM ou une autre structure de contrôle de saut a lieu depuis une forme Lisp dans le corps du LOOP

- le LOOP se termine par les clauses always, never ou thereis

            Dans le code de l'épilogue, on peut utiliser RETURN et RETURN-FROM pour fournir une valeur de retour au LOOP. Cette valeur s'imposera sur toute autre valeur qui aurait pu être fournie par une clause d'accumulation ou de fin de test

NAMED: clause permettant de nommer un LOOP

pour utiliser RETURN-FROM lorsqu'il y a des LOOPs emboîtés

la clause NAMED doit être la première dans le LOOP

(loop named sortie for liste in '((1 5 3 7) (5 6 7) (8 9) (10 11 12 13)) do

      (loop for item in liste do

   (if (evenp item)

       (return-from sortie item))))

6                            rend le premier nombre paire d'une sous-liste en sortant du LOOP

nommé sortie, sinon, rend NIL

TESTS d'INTERRUPTION:

WHILE:

UNTIL:

ALWAYS:

NEVER:

THEREIS: sont des clauses d'interruption d'un LOOP.

(loop for i from 1 to 1000

      while (< (* i i) 100)

      collect (* i i))

(1 4 9 16 25 36 49 64 81)              les itérations se poursuivent tant que le carré de

i reste inférieur à 100

(loop for i from 1 to 1000

      until (>= (* i i) 100)

      collect (* i i))

(1 4 9 16 25 36 49 64 81)                les itérations se poursuivent jusqu'à ce que le

carré de i devient supérieur ou égal à 100

Dans ce qui suit, la liste quotée est supposée être une liste de nombres entiers (sinon evenp produirait une erreur):

(loop for n in '(0 2 4 6 8) always (evenp n))

T                               permet de faire un test sur tous les éléments d'un ensemble

T, si tous les éléments vérifient le test

NIL, s'il existe un élément (au moins) ne le vérifiant pas

Ajoutons un épilogue au LOOP:

(loop for n in '(0 2 4 6 8)

    always (evenp n)

    finally (print "Tous les nombres sont pairs."))

"Tous les nombres sont pairs."

T l'épilogue (finally) est bien évalué si tous les nombres sont pairs.

Mais:

(loop for n in '(0 2 4 5 6 8)

    always (evenp n)

    finally (print "Tous les nombres sont pairs."))

NIL                     l'épilogue n'est pas évalué, s'il existe un nombre impair

si on veut un résultat rendu au lieu de NIL:

(if (not (loop for n in '(0 2 4 5 6 8)

    always (evenp n)

    finally (print "Tous les nombres sont pairs.")))

     "Il existe un nombre impair.")

"Il existe un nombre impair."

Un équivalent à ce qui précède:

(loop for n in '(0 2 4 6 8) never (oddp n))

T                              ... Et les mêmes remarques.

Si aucun élément n'est impair: T

S'il existe un élément impair: NIL

THEREIS rend la valeur évaluée qui suit si non NIL:

(loop thereis "voici ma valeur."

      finally (print "Ceci ne sera pas rendu."))

"voici ma valeur."                   L'épilogue n'est pas rendu

(loop for n from 1 to 10

      thereis (> n 10)

      finally (format t "Entre 1 et 10, il n'y a pas de valeur strictement supérieure à 10 et n prend la valeur ~a en fin d'itération." n))

Entre 1 et 10, il n'y a pas de valeur strictement supérieure à 10 et n prend la valeur 11 en fin d'itération.

NIL                                   Cette fois, l'épilogue est rendu, après le déroulement complet de toutes les itérations sans interruption

(loop for i from 0

      thereis (when (> i 10000) i))

10001                          Ici, thereis permet de sortir de la boucle LOOP (qui pourrait

être sans fin)

DIGIT-CHAR-P: le 1er argument est un caractère, le 2ème est une base numérique optionnelle (10 par défaut)
rend le caractère si c'est un chiffre reconnu dans la base dite base.
rend NIL sinon. C'est donc un prédicat.

(undefine function dans portacle!)

(digit-car-p #\5)
5      5 est bien un chiffre de la base 10 (valeur de vérité: T)
(digit-char-p #\5 2)
NIL       5 n'est pas un chiffre binaire
(digit-char-p #\B 16)
11       B est bien un chiffre en base hexadécimale (valeur de vérité: T)
      remarquez que le chiffre est rendu en base 10.

(loop for char across "OOO0OO" thereis (digit-char-p char))

0                                  rend le premier chiffre rencontré, sinon NIL

il y a bien un zéro dans la suite des caractères

Pour récupérer tous les chiffres de la chaîne:
(loop for char across "OOBO10" when (digit-char-p char 16) collecting it)
(11 1 0)       soit (B 1 0) en hexadécimal

LOOP-FINISH: macro utilisée dans une forme Lisp d'une clause DO qui produit un saut immédiat vers l'épilogue du LOOP.

(loop for i in '(0 1 2 3 4 arrêt 5 6)

      when (symbolp i) do (loop-finish)

      count i)

5

TIME: permet de mesurer la durée d'exécution d'une fonction.

Exemple: soit la fonction suivante:

(defun produit-scalaire (l1 l2)
  "rend le produit scalaire de deux listes de nombres."
  (loop for x1 in l1
for x2 in l2
sum (* x1 x2)))

(defparameter *p* (make-list 1000000 :initial-element 1))
     pour définir une liste avec 1000000 d'éléments initialisés à 1.

(time (produit-scalaire *p* *p*))
Evaluation took:
  0.012 seconds of real time
  0.012000 seconds of total run time (0.012000 user, 0.000000 system)
  100.00% CPU
  35,018,585 processor cycles
  0 bytes
1000000 résultat de l'opération
le travail a été fait en 0.012 secondes
LOOP semble très rapide: je vous propose de chercher d'autres méthodes
de calcul d'un produit scalaire. Puis comparez avec TIME.

_______________________________________________________

Règles à suivre pour utiliser LOOP:

       - la première clause est named si elle est nécessaire,

       - après viennent les clauses initially, with, for et repeat,

       - puis viennent les clauses du corps du LOOP: d'exécution conditionnelle et inconditionnelle, d'accumulation, et test de fin,

       - enfin, les clauses finally.

LOOP permet:

       - d'initialiser et de déclarer les variables locales du LOOP avec les clauses with ou for, même si elles sont implicitement créée par les clauses d'accumulation. Les formes des valeurs initiales sont évaluées dans l'ordre d'apparition des clauses du LOOP.

       - d'exécuter les formes fournies par les clauses initialy, s'il y en a dans le prologue, dans l'ordre d'apparition.

       - d'effectuer les itérations et l'exécution du corps du LOOP, comme indiqué dans le paragraphe suivant.

       - d'exécuter les formes fournies par les clauses finally, s'il y en a dans l'épilogue, dans l'ordre d'apparition.

    Pendant les itérations, l'exécution du corps du LOOP met, d'abord, à jour les variables participant aux itérations, en tenant compte des incréments respectifs, ensuite, lance les exécutions conditionnelles et inconditionnelles, les

accumulations et test de fin dans l'ordre du code. Si une clause demande l'interruption du LOOP, le reste du corps est ignoré et il y a sortie du LOOP, parfois après l'exécution de l'épilogue.

________________________________________________________

Application de quelques notions précédentes au calcul statistique de la moyenne et de l'écart-type:

(defun liste-simple-p (lst)

           "Vérifie si la liste est formée d'atomes numériques entiers."

           (cond

             ((endp lst) t)

             ((integerp (car lst)) (liste-simple-p (cdr lst)))

             (t nil)))

(defun compte-occur (lst)

           "Transforme une simple série de nombres (liste-simple) en série statistique ((nb . eff) ...) où nb est un nombre de la série et eff son effectif."

           (if (liste-simple-p lst)

               (cond

                 ((endp lst) nil)

                 (t (cons (cons (car lst) (count (car lst) lst)) (compte-occur (remove (car lst) lst)))))

               (error "Les nombres de la série doivent être des atomes entiers.")))

(defun moy-stat (lst-stat)

           "calcule et affiche l'effectif total et la moyenne de la série statistique passée en argument. Puis en rend la liste (eff-tot moy)."

           (loop for (nb . eff) in lst-stat

                 sum eff into eff-tot

                 sum (* eff nb) into total

                 finally (let ((moy (/ total eff-tot))) (format t "Effectif total: ~a.~%Moyenne: ~a.~%" eff-tot moy) (return (list eff-tot moy)))))

(defun variance (lst-stat)

           "Calcule et affiche l'effectif total, la moyenne et la variance de la série statistique passée en argument. Rend également la variance."

           (multiple-value-bind (eff-tot moy) (values-list (moy-stat lst-stat))

             (loop for (nb . eff) in lst-stat

                 sum (* eff (- nb moy) (- nb moy)) into VARxN

                 finally (let ((var (float (/ VARxN eff-tot)))) (format t "Variance: ~a~%" var) (return var)))))

(defun écart-type (lst-stat)

           "Calcule et affiche l'effectif total, la moyenne, la variance et l'écart-type d'une série statistique. Rend également l'écart-type."

           (block sortie 

             (let ((sigma (sqrt (caddr (variance lst-stat))))) (format t "Ecart-type: ~a." sigma) (return-from sortie sigma))))

(defun dispersion (lst-stat)

           "Calcule et affiche l'effectif total, la moyenne, la variance et l'écart-type d'une série statistique."

           (let ((sigma (sqrt (caddr (variance lst-stat))))) (format t "Ecart-type: ~a." sigma)))

(dispersion '((5 . 2) (7 . 3) (9 . 1) (10 . 5) (11 . 7) (12 . 7) (13 . 4) (15 . 1) (17 . 2)))

Effectif total: 32.

Moyenne: 11.

Variance: 7.5

Ecart-type: 2.738613.

NIL

________________________________________________________

La prochaine fois, nous verrons Les MACROS.