8. Les Listes Chaînées
1 Exercice 8.13.1
2 Exercice 8.13.2
3 Exercice 8.13.3
4 Exercice 8.13.4
5 Exercice 8.13.5
6 Exercice 8.13.6
7 Exercice 8.13.7
8 Exercice 8.13.8
9 Exercice 8.13.9
10 Exercice 8.13.10
11 Exercice 8.13.11
12 Exercice 8.13.12
13 Exercice 8.13.13
14 Exercice 8.13.14
15 Exercice 8.13.15
16 Exercice 8.13.16
17 Exercice 8.13.17
18 Exercice 8.13.18
19 Exercice 8.13.19
20 Exercice 8.13.20
21 Exercice 8.13.21
22 Exercice 8.13.22
23 Exercice 8.13.23
24 Exercice 8.13.24
6.0.1.11

8. Les Listes Chaînées

1 Exercice 8.13.1

Expérimentez au toplevel...

2 Exercice 8.13.2

(define (makelist n x)

  (build-list n (lambda (i) x)))

3 Exercice 8.13.3

a) Une banale récurrence enveloppée :

(define (snoc x L)

  (if (empty? L)

      (list x)

      (cons (first L) (snoc x (rest L)))))

b) On reconnaît dans le texte de la fonction ci-dessus un avatar de l’algorithme de append :

(define (snoc x L)

  (append L (list x)))

c) Chacun des algorithmes précédents consiste à cloner la liste L, donc le coût [ou complexité] est en O(n), si n est la longueur de L.

Rappel : dans les algorithmes de constructions de listes, on comptabilise le nombre d’appels à la primitive cons.

4 Exercice 8.13.4

a) On introduit un accumulateur dans une fonction locale récursive terminale réalisant la boucle. Les éléments de L sont ajoutés à l’accumulateur en ordre inverse !

(define (reverse-it L)    ; itérative

  (local [(define (iter L acc)

            (if (empty? L)

                acc

                (iter (rest L) (cons (first L) acc))))]

    (iter L empty)))

b) A chaque tour de boucle, on fait un seul appel à cons. On fait autant de tours de boucle qu’il y a d’éléments dans L. D’où une complexité en O(n), si n est la longueur de L.

5 Exercice 8.13.5

L’immense avantage des fonctions définies par récurrence est que l’on peut raisonner sur elles avec la mathématique usuelle, pour les analyser voire les transformer. C’est de l’algèbre de programmes.

empty ++ L = L                  (1)

(x.L1) ++ L2 = x.(L1 ++ L2)     (2)

a) Prouvons par récurrence sur [la longueur de] L que L ++ empty = L.
- si L est vide, cela découle de l’équation (1).
- sinon L = x.L1, et L ++ empty = (x.L1) ++ empty = x.(L1 ++ empty) par (2).
Or par hyp. de récurrence, L1 ++ empty = L1, d’où L ++ empty = x.L1 = L. CQFD

Prouvons par récurrence sur L1 que append est associative.
- Si L1 est vide, cela résulte de (1).
- Sinon, L1 = x.L, et L1 ++ (L2 ++ L3) = (x.L) ++ (L2 ++ L3) = x.[L ++ (L2 ++ L3)] par (2).
Donc par hyp. de récurrence, L ++ (L2 ++ L3) = (L ++ L2) ++ L3. Donc :
L1 ++ (L2 ++ L3) = x.[(L ++ L2) ++ L3] = x.(L ++ L2) ++ L3 par (2).
= (x.L ++ L2) ++ L3 encore par (2).
= (L1 ++ L2) ++ L3. CQFD

b) Montrons par récurrence sur L que len o rev = len où par simplicité nous avons noté len la fonction length, et rev la fonction reverse, définies par les équations suivantes :

len(empty) = 0                  (3)

len(x.L) = 1 + len(L)           (4)

rev(empty) = empty              (5)

rev(x.L) = rev(L) ++ (x.empty)  (6)

- Si L est vide, len(rev(empty)) = len(empty) = 0 = len(empty).
- Sinon L = x.L1 et len(rev(L)) = len(rev(x.L1)) = len[rev(L1) ++ (x.empty)].
JE SUPPOSE que nous avons démontré que len(L1 ++ L2) = len(L1) + len(L2) !
Alors len(rev(L)) = len(rev(L1)) + len(x.empty) = len(rev(L1)) + 1 = len(L1) + 1 par hyp. de récurrence.
Donc len(rev(L)) = len(L). CQFD Quelques étapes ont été un peu court-circuitées, je vous laisse les peaufiner, de même qu’il faudra démontrer le lemme len(L1 ++ L2) = len(L1) + len(L2)... Mais la technique devrait être claire maintenant.

c) Utilisez le fait que la complexité du calcul de L1 ++ L2 est égale à la longueur de L1.

6 Exercice 8.13.6

a) Utilisons build-list pour construire la liste :

(define (Lrandom long n)

  (build-list long (lambda (i) (random n))))

b) Il est raisonnabe d’opter pour une itération avec un accumulateur. A chaque tirage d’un entier aléatoire, on vérifie avec member qu’il n’est pas déjà dans l’accumulateur...

7 Exercice 8.13.7

a) Le paramètre r représente une relation d’ordre généralisant <=. La fonction (fusion LT1 LT2 r) s’écrit tout naturellement sous la forme d’une récurrence enveloppée avec un cond à 4 clauses, puisqu’il suffit de comparer le premier élément de L1 avec celui de L2. La fonction (tri-fusion L r) ne possède qu’une seule difficulté, le cas de base : posez-vous la question de la scission d’une liste à un seul élément...

b) Supposons sans perte de généralité que n soit de la forme 2k. La suite (cn) vérifie :

c0 = c1 = 0
cn = coût(scission) + coût(deux tris) + coût(fusion) = Theta(n) + 2cn/2 + Theta(n) = 2cn/2 + Theta(n) = 2cn/2 + n en simplifiant.
cn = 2 [2cn/4 + n/2] + n = cn = 4cn/4 + 2n = cn = 4 [2cn/8 + n/4] + 2n = cn = 8cn/8 + 3n
= ... = 2kcn/2k + kn

Si n = 2k, c’est que k = log2(n), d’où cn/2k = 0 et cn = kn = n log(n).

Mathématiques un peu violentes, mais l’essentiel est là...

8 Exercice 8.13.8

a) La fonction take de Mathematica. Le cas où k est trop grand n’est pas spécifié dans l’énoncé...

(define (take L k)              ; on suppose k >= 0

  (cond ((zero? k) empty)

        ((empty? L) (error 'take "Pas assez d'elements !"))

        (else (cons (first L) (take (rest L) (- k 1))))))

b) Et drop. La définition du livre n’est pas cohérente avec celle de Mathematica, pour lequel Drop[L,k] signifie : la liste L privée de ses k premiers éléments [ce qui est bien plus facile à programmer !]. Pour respecter ce que demande le livre, je vous propose une stratégie à deux pointeurs Ld et Lf, initialisés à L. On fait avancer Lf de n éléments, puis on fait avancer en parallèle Ld et Lf jusqu’à ce que Lf soit vide. Le résultat est alors Ld. A vous... Mais il y a plus simple, et peut-être moins efficace, comme reverse o take o reverse !

9 Exercice 8.13.9

On utilise member pour savoir si un élément est répété :

(define (cardinal L)    ; L peut contenir des répétitions

  (cond ((empty? L) 0)

        ((member (first L) (rest L)) (cardinal (rest L)))

        (else (+ 1 (cardinal (rest L))))))    ; appel récursif enveloppé

(define (reunion E F)   ; récurrence sur E

  (cond ((empty? E) ...)

        ((member (first E) F) ...)

        (else ...)))

10 Exercice 8.13.10

(define (remplace x y L)    ; parcours (en surface) de L à la recherche de y

  (cond ((empty? L) L)

        ((equal? (first L) y) ...)    ; appels récursifs enveloppés

        (else ...)))

(define (remplace x y L)    ; version itérative

  (local [(define (iter L acc)    ; inutile de passer x et y en paramètres

            ...)]                 ; appel récursif terminal !

    (iter L empty)))

(define (remplace-sup x y L)    ; version à l'ordre supérieur (one-liner)

  (map (lambda (x) ...) L))

(define (remplace-prof x y L)   ; recherche de y en profondeur

  (cond ((empty? L) L)

        ((list? L) (cons ... ...))

        ((equal? L y) ...)

        (else ...)))

La question (list? L) demande si L est une liste non vide. En langage Etudiant avancé, son coût est O(1) ce qui n’est pas le cas en vrai Scheme (chapitre 11) où il faudrait uiliser pair?. Dans le langage Etudiant avancé, la fonction cons attend obligatoirement une liste en second argument, et n’importe quoi en vrai Scheme...

11 Exercice 8.13.11

Un grand classique...

(define poly0 empty)     ; le polynome identiquement nul

(define poly0? empty?)   ; et son reconnaisseur

Un monome est une liste à deux éléments (coeff degre)

(define (mdegre m)       ; degré d'un monome m

  (second m))

(define (mcoeff m)       ; coefficient d'un monome m

  (first m))

Un polynome est une liste de monomes en puissances décroissantes

(define (pdegre p)       ; degré d'un polynome p

  (if (poly0? p)

      -inf.0             ; bof

      (second (first p))))

(define (pcoeff p)       ; coefficient dominant d'un polynome p

  (if (poly0? p)

      0

      (first (first p))))

Loi externe : Real x Polynome –> Polynome

(define (poly*ext k p)

  (if (= k 0)

      poly0

      (map (lambda (m) (list (* k (mcoeff m)) (mdegre m))) p)))

> (poly*ext 2 '((2 5) (3 2) (5 0)))

((4 5) (6 2) (10 0))

Addition : Polynome x Polynome –> Polynome

(define (poly+ p q)    ; addition de deux polynomes, récurrence sur p

  (cond ((poly0? p) q)

        ((poly0? q) p)

        ((> (pdegre p) (pdegre q)) (cons (first p) (poly+ (rest p) q)))

        ((< (pdegre p) (pdegre q)) ...)

        (else   ; attention de ne pas faire rentrer des coefficients nuls !

          (local [(define cp (pcoeff p))

                  (define cq (pcoeff q))

                  (define c (+ cp cq))

                  (define d (pdegre p))]   ; = (degre q)

            (if (= c 0)

                ...

                ...)))))

> (poly+ '((4 5) (-2 3) (7 1) (-1 0)) '((8 12) (6 5) (2 3) (4 0)))

((8 12) (10 5) (7 1) (3 0))

etc. Tâchez de trouver comment procéder à la multiplication de deux polynomes par récurrence, en utilisant bien entendu l’addition précédente...

12 Exercice 8.13.12

Une bille sera une structure à 5 champs : position, vitesse, couleur. Notez que le define-struct peut se faire à l’intérieur de l’animation, ce qui est plus propre si ce type de structure n’est pas utilisé par ailleurs. Toujours localiser au maximum !... La fonction suivant transforme le Monde (une liste de billes) en demandant pour chaque bille si elle a touché le sol, auquel cas elle renaît au point de départ de manière aléatoire.

(define (artifice)

  (local [(define SIZE 300)

          (define SIZE/2 (/ SIZE 2))

          (define FOND (place-image (rectangle 10 80 'solid "white")

                                    50 SIZE

                                    (rectangle SIZE SIZE 'solid "black")))

          (define (random-color)

            (make-color (random 256) (random 256) (random 256)))

          (define-struct bille (x y dx dy col))

          (define (random-bille)

            (make-bille 50 250 (+ 2 (random 5)) (- -5 (random 15))

                        (random-color)))

          ; Le Monde est une liste de 20 billes

          (define LINIT

            (build-list 20 (lambda (i) (random-bille))))

          (define (suivant L)     ; Monde --> Monde

            (if (empty? L)

                L

                (local [(define b (first L))]

                          (if (> (bille-y b) SIZE)   ; dans le plancher ?

                              (cons (random-bille) (suivant (rest L)))

                              (cons (make-bille (+ (bille-x b) (bille-dx b))

                                                (+ (bille-y b) (bille-dy b))

                                                (bille-dx b)

                                                (+ (bille-dy b) 1)  ; gravitation

                                                (bille-col b))

                                    (suivant (rest L)))))))    ; à recoder avec un foldl !

          (define (dessiner L)    ; Monde --> Image

            (if (empty? L)

                FOND

                (local [(define b (first L))]

                  (place-image (circle 5 'solid (bille-col b))

                               (bille-x b) (bille-y b)

                               (dessiner (rest L))))))]         ; à recoder avec un foldl !

    (big-bang LINIT

              (on-tick suivant)

              (on-draw dessiner))))

Le recodage de la fonction dessiner avec un foldl (itératif) donnerait par exemple :

(define (dessiner L)

  (foldl (lambda (b img)

           (place-image (circle 5 'solid (bille-col b))

                        (bille-x b) (bille-y b)

                        img))

         FOND L))

13 Exercice 8.13.13

Il s’agit d’une fonction à deux résultats LD et k, regroupés dans une liste (LD k). Donc bien saisir la forme de l’hypothèse de récurrence !

(define (degraisser n L)     ; version récursive enveloppée

  (if (empty? L)

      (list empty 0)

      (local [(define HR (degraisser n (rest L)))]   ; hyp. de réc. HR = (LD k)

        (if (zero? (modulo (first L) n))

            (list (first HR) (+ (second HR) 1))

            (list (cons (first L) (first HR)) (second HR))))))

(check-expect (degraisser 3 '(8 9 4 3 6 1 0 7 12)) '((8 4 1 7) 5))

(check-expect (degraisser-it 3 (build-list 100 (lambda (i) (* 3 i)))) '(() 100))

14 Exercice 8.13.14

J’utilise deux pointeurs L et L1, qui va deux fois plus vite que L. Seules les cellules de la première moitié de L sont clonées dans un accumulateur acc :

(define (couper-en-deux L)

  (local [(define (iter L L1 acc)   ; L1 va deux fois plus vite que L

            (if (or (empty? L1) (empty? (rest L1)))

                (list (reverse acc) L)

                (iter (rest L) (rest (rest L1)) (cons (first L) acc))))]

    (iter L L empty)))

> (couper-en-deux '(a b c d e))

((a b) (c d e))

> (couper-en-deux '(a b c d))

((a b) (c d))

15 Exercice 8.13.15

(define (compacter L)   ; fonctionnelle recursive enveloppee

  (cond ((empty? L) L)

        ((empty? (rest L)) (list (list (first L) 1)))

        (else (let ((HR (compacter (rest L))))               ; hyp. de réc.

                (if (equal? (first (first HR)) (first L))    ; et je raisonne...

                    (cons (list (first L) (+ (second (first HR)) 1)) (rest HR))

                    (cons (list (first L) 1) HR))))))

> (compacter '( a a a b b a c c c c a a c))

((a 3) (b 2) (a 1) (c 4) (a 2) (c 1))

Et je vous laisse l’itération...

16 Exercice 8.13.16

La période du rationnel 961099/49950 est 122, comme vous pouvez le vérifier au toplevel avec un clic-droit sur le résultat de 961099/49950 (demander "expansion décimale")...

> (periode 961099/49950)

(1 2 2)

> 961099/49950

19.24122122122122...

L’algorithme consiste à effectuer la division comme on le fait à la main, en stockant les couples (quotient , reste) dans une A-liste AL, et à stopper dès qu’un reste a déjà été vu :

(define (deja-vu? x AL)

  (not (equal? (assoc x AL) #f)))

(define (cut AL key)   ; le reste de AL après la clé key

  (cond ((empty? AL) #f)

        ((equal? key (first (first AL))) (rest AL))

        (else (cut (rest AL) key))))

(define (periode r)   ; r rationnel > 0

  (local [(define (iter num den AL)

            (local [(define q (quotient num den))

                    (define r (modulo num den))

                    (define BL (cons (list r q) AL))]

              (if (deja-vu? r AL)

                  (map second (cut (reverse BL) r))

                  (iter (* r 10) den BL))))]

    (iter (numerator r) (denominator r) empty)))

Voici une version avec trace qui utilise printf, pour suivre l’évolution des variables de boucle :

(define (periode-avec-trace r)   ; r rationnel > 0

  (local [(define (iter num den AL)

            (begin (printf "num=~a den=~a AL=~a : " num den AL)

                   (local [(define q (quotient num den))

                           (define r (modulo num den))

                           (define BL (cons (list r q) AL))]

                     (begin (printf "q=~a r=~a\n" q r)

                            (if (deja-vu? r AL)

                                (begin (printf "STOP ! ~a déjà vu !\n" r)

                                       (map second (cut (reverse BL) r)))

                                (iter (* r 10) den BL))))))]

    (iter (numerator r) (denominator r) empty)))

> 241/990

0.243434343...

> (periode-avec-trace 241/990)

num=241 den=990 AL=() : q=0 r=241

num=2410 den=990 AL=((241 0)) : q=2 r=430

num=4300 den=990 AL=((430 2) (241 0)) : q=4 r=340

num=3400 den=990 AL=((340 4) (430 2) (241 0)) : q=3 r=430

STOP ! 430 déjà vu !

(4 3)         ; <-------- la période est 43

17 Exercice 8.13.17

L’essentiel consiste à utiliser apply pour se ramener à min :

(define (minListe L)    ; L non vide

  (apply min L))        ; (minListe '(6 8 2 4)) <==> (min 6 8 2 4)

Pour la fonction min&max, on pourrait rédiger un one-liner en utilisant la technique précédente, mais cela provoquerait un double passage sur la liste, ce que veut éviter l’énoncé...

(define (min&max L)     ; L non vide

  (local [(define x (first L))

          (define R (rest L))]

    (if (empty? R)

        (list x x)

        (local [(define HR (min&max R))]    ; HR = (mini maxi)

          (list (min x (first HR)) (max x (second HR)))))))

> (min&max '(6 9 7 2 3))

(2 9)

18 Exercice 8.13.18

ERRATUM. Aïe, le langage Etudiant avancé n’autorise pas les fonctions d’arité variable ! Cette page 147 est donc très mal placée et devrait se trouver après la page 229, désolé. La solution sera donc donnée au début des solutions du chapitre 11, et jusque là nos fonctions devront avoir un nombre fixe de paramètres.

19 Exercice 8.13.19

ERRATUM. Idem...

20 Exercice 8.13.20

Rappelons (page 144) que foldl réalise l’abstraction d’un parcours itératif de liste de la gauche vers la droite, avec un accumulateur évoluant suivant le traitement de chaque élément, e fournissant la valeur initiale de l’accumulateur :

(foldl f e (list a b c)) == (f c (f b (f a e)))

(define ($length L)

  (foldl (lambda (x acc) (+ 1 acc)) 0 L))

> ($length '(a (b c) d))

3

(define ($filter pred L)   ; les éléments x de L vérifiant (pred x)

  (foldl (lambda (x acc) ...) empty L))

> ($filter number? '(les 2 ou 3 bateaux))

(2 3)

> ($filter (lambda (x) (> x 10)) '(8 12 5 15 13 0 3))

(12 15 13)

member ne parcourt pas toute la liste alors que foldl procède à un parcours exhaustif.

Je vous laisse la programmation de (map f L) en style récursif usuel. Sous forme de one-liner, tenez compte de la différence entre foldr (parcours récursif enveloppé de droite à gauche) et foldl (parcours itératif de gauche à droite) :

(define (rmap f L)    ; (rmap sqr '(1 2 3 4)) --> (16 9 4 1)

  (foldl (lambda (x acc) (cons (f x) acc)) empty L))

 

(define ($map f L)    ; ($map sqr '(1 2 3 4)) --> (1 4 9 16)

  (foldr (lambda (x hr) (cons (f x) hr)) empty L))

21 Exercice 8.13.21

Pas de difficulté spéciale si vous avez assimilé l’exercice précédent. Pour la dernière question, demandez-vous si and est une fonction...

22 Exercice 8.13.22

Abstraction d’un schéma de Hörner :

(define (imploser L)

  (foldl (lambda (c acc) (+ (* 10 acc) c)) 0 L))

> (imploser '(1 2 3))

123

Pour nfoldr et nfoldl, inspirez-vous des définitions de foldr et foldl, et tâchez de vous débrouiller pour que par exemple :

> (nfoldr + 0 123)          ; somme des chiffres

6

> (nfoldl cons empty 123)   ; liste des chiffres

(1 2 3)

Notez bien l’analogie entre first/rest sur les listes, et modulo/quotient sur les entiers !...

23 Exercice 8.13.23

Vous optons pour un type de structure transparent de manière à visualiser le contenu des champs d’une struct lors d’un affichage de celle-ci.

(define-struct biliste (ar av) #:transparent)

Je construis la liste bidirectionnelle sur (1 2 3 4 5 6) :

> (define BL (make-biliste '() '(1 2 3 4 5 6)))

> BL

#(struct:biliste () (1 2 3 4 5 6))

La fonction b-first qui donne l’élément courant :

(define (b-first BL)     ; bilist* --> element

  (local [(define av (biliste-av BL))]

    (if (empty? av)

        (error "b-first : Impossible !")

        (first av))))

> (b-first BL)

1

La fonction b-rest qui donne un pointeur en avant sur la biliste suivant l’élément courant :

(define (b-rest BL)     ; bilist* --> bilist

  (local [(define av (biliste-av BL))]

    (if (empty? av)

        (error "b-rest : Impossible !")

        (make-biliste (cons (first av) (biliste-ar BL)) (rest av)))))

> (define focus (b-rest (b-rest (b-rest BL))))

> focus

#(struct:biliste (3 2 1) (4 5 6))

> (b-first focus)                 ; je pointe sur 4

4

> (b-first (b-rest focus))        ; dont le suivant est 5

5

La fonction b-pred qui donne un pointeur en arrière sur la biliste précédant l’élément courant :

(define (b-pred BL)     ; bilist* --> bilist

  (local [(define ar (biliste-ar BL))]

    (if (empty? ar)

        (error "b-pred : Impossible !")

        (make-biliste (rest ar) (cons (first ar) (biliste-av BL))))))

> (b-first (b-pred focus))        ; et 4 est précédé de 3

3

> (b-pred BL)                     ; mais rien avant 1

ERROR : b-pred : Impossible !

Il est donc possible de procéder à un traitement purement fonctionnel d’une liste bidirectionnelle !...

24 Exercice 8.13.24

(define (etoile r)

  (lambda (L)

    ((alt (concat r (etoile r)) succes) L)))

(define (etoile+ r)

  (concat r (etoile r)))

Comme il s’agit d’un thème un peu plus avancé à ce stade du livre, nous vous laissons les parseurs...