9. Les Arbres

6.0.1.11

9. Les Arbres

1 Exercice 9.12.1

(define (arbre-expr? x) ; x quelconque

(or (feuille? x)

(and (list? x)

(= (length x) 3)

(operateur? (first x))

(arbre-expr? (second x))

(arbre-expr? (third x)))))

2 Exercice 9.12.2

(define (miroir A)

(if (feuille? A)

(arbre (racine A) (miroir (fd A)) (miroir (fg A)))))

3 Exercice 9.12.3

(define (nb-op A)

(if (feuille? A)

(+ 1 (nb-op (fg A)) (nb-op (fd A)))))

(define (subst-op op1 op2 A)

(if (feuille? A)

(arbre (if (equal? (racine A) op1) op2 (racine A))

(subst-op op1 op2 (fg A))

(subst-op op1 op2 (fd A)))))

4 Exercice 9.12.4

(define (squelette A)

(if (feuille? A)

(arbre '? (squelette (fg A)) (squelette (fd A)))))

(define (nourrir SA)

(local [(define (random-feuille)

(if (zero? (random 2))

(random 20)

(list-ref '(a b c x y z u v w) (random 9))))

(define (random-op)

(list-ref '(+ - * /) (random 4)))]

(if (feuille? SA)

(random-feuille)

(arbre (random-op)

(nourrir (fg SA))

(nourrir (fd SA))))))

> (nourrir (squelette '(+ (* x 2) y)))

(/ (- 18 a) 5)

5 Exercice 9.12.5

(define (reunion L1 L2) ; deux ensembles, recurrence sur L1

(cond ((empty? L1) L2)

((member (first L1) L2) (reunion (rest L1) L2))

(else (cons (first L1) (reunion (rest L1) L2)))))

> (reunion '(a b c d) '(d a g b k))

(c d a g b k)

(define (ens-vars A)

(if (feuille? A)

(if (number? A) empty (list A))

(reunion (ens-vars (fg A)) (ens-vars (fd A)))))

6 Exercice 9.12.6

(define (hauteur<=? A n) ; <==> (<= (hauteur A) n) mais sans calculer (hauteur A) !

(cond ((feuille? A) true) ; car n >= 0

((= n 0) false) ; car A est un noeud

(else (and (hauteur<=? (fg A) (- n 1))

(hauteur<=? (fd A) (- n 1))))))

Notez que la solution ci-dessus est correcte mais peu efficace : si je veux prouver que l’arbre est de hauteur inférieure à 3, il est inutile de descendre jusqu’en bas s’il est de hauteur 100... Je vous laisse cette optimisation ! Mais attention : sans utiliser la fonction hauteur !

(define (h-feuillage A n) ; la liste des feuilles situees a une hauteur <= n

(if (feuille? A)

(if (>= n 0) (list A) empty)

(append (h-feuillage (fg A) (- n 1))

(h-feuillage (fd A) (- n 1)))))

> (map (lambda (k) (h-feuillage AT k)) '(0 1 2 3 4 1000))

(() () (2 x y) (x y 2 x y) (x y 2 x y) (x y 2 x y))

(define (random-arbre h)

(if (= h 0)

(random-feuille) ; cf exercice 9.12.4

(local [(define A1 (random-arbre (- h 1)))

(define A2 (random-arbre (random h)))

(define hasard (random 2))

(define op (list-ref '(+ - * /) (random 4)))]

(if (= hasard 0)

(arbre op A1 A2)

(arbre op A2 A1)))))

> (random-arbre 4) ; aleatoire de hauteur 4

(* 1 (/ (- (/ 2 1) (/ c 15)) (- (- w 13) (- z v))))

7 Exercice 9.12.7

(define (arbre->lang A)

(local [(define (op->english op)

(second (assoc op '((+ sum) (- difference) (* product) (/ quotient)))))]

(if (feuille? A)

(list A)

(local [(define tg (arbre->lang (fg A)))

(define td (arbre->lang (fd A)))]

(append (list 'the (op->english (racine A)) 'of) tg (list 'and) td)))))

Pour la réciproque lang->arbre, plus difficile, inspirez-vous de la technique élaborée au § 9.5.2 du livre...

> (lang->arbre

'(the sum of the product of x and 2 and the quotient of the difference of x and 3 and y))

(+ (* x 2) (/ (- x 3) y))

8 Exercice 9.12.8

Pour rappel, et en développant le second appel implicite à append :

(define (arbre->postfixe A)

(if (feuille? A)

(list A)

(append (arbre->postfixe (fg A))

(append (arbre->postfixe (fd A))

(list (racine A))))))

Il s’agit de faire de l’algèbre de programmes, et d’éliminer append en posant :

(aux A L) == (append (arbre->postfixe A) L)

Si l’arbre A est une feuille, (aux A L) == (append (list A) L) == (cons A L). Si A est un noeud :

(aux A L) == (append (arbre->postfixe A) L)

== (append (append (arbre->postfixe (fg A))

(append (arbre->postfixe (fd A))

(list (racine A))))

== (append (arbre->postfixe (fg A))

(append (arbre->postfixe (fd A))

(append (list (racine A)) L)))

Or (append (list (racine A)) L) s’écrit en mieux (cons (racine A) L), donc :

(aux A L) == (aux (fg A) (aux (fd A) (cons (racine A) L)))

D’où une version plus efficace de arbre->postfixe mais avec deux appels récursifs emboîtés :

(define (arbre->postfixe A)

(local [(define (define (aux A L)

(if (feuille? A)

(cons A L)

(aux (fg A) (aux (fd A) (cons (racine A) L)))))]

(aux A empty)))

9 Exercice 9.12.9

Grammaire des arbres mobiles de Calder, où les INT représentent des poids :

<mobile> ::= INT | (INT <mobile> <mobile>)

(define (poids m) ;somme des poids de tous ses objets et de ses barres

(if (feuille? m)

(+ (racine m) (poids (fg m)) (poids (fd m)))))

> (poids M)

(define (équilibré_1? m) ; version 1, question b)

(or (feuille? m)

(local [(define m1 (second m)) (define m2 (third m))]

(and (= (poids m1) (poids m2))

(équilibré_1? m1)

(équilibré_1? m2)))))

> (équilibré_1? M)

Inconvénient de cette solution, elle parcourt plusieurs fois le mobile ! Pour ne faire qu’une seule descente récursive, on programme une fonction qui retourne deux résultats : (equil? poids), sans utiliser la fonction poids.

(define (équilibré_2? m) ; version 2, question c)

(if (feuille? m)

(list #t m)

(local [(define m1 (fg m))

(define m2 (fd m))

(define res1 (équilibré_2? m1))

(define res2 (équilibré_2? m2))]

(if (and (first res1) (first res2))

(list (= (second res1) (second res2)) (+ (racine m) (second res1) (second res2)))

(list #f (+ (racine m) (second res1) (second res2)))))))

Inconvénient de cette solution, le mobile est entie^èrement parcouru (une seule fois) mme si le sous-mobile de gauche n’est pas équilibré ! On désymétrise cette version pour que le sous-mobile de droite ne soit parcouru que si celui de gauche est équilibré. Du coup, on renvoie (#t poids) ou bien (#f ?) :

(define (équilibré_3? m)

(if (feuille? m)

(list #t m)

(local [(define m1 (fg m)) (define res1 (équilibré_3? m1))]

(if (first res1)

(local [(define m2 (fd m)) (define res2 (équilibré_3? m2))]

(if (first res2)

(if (= (second res1) (second res2))

(list #t (+ (racine m) (second res1) (second res2)))

(list #f '?))

(list #f '?)))

(list #f '?)))))

Inconvénient de cette solution : en cas d’échec, on remonte des #f au lieu de couper brutalement la recherche. Solution : CPS !

(define (equilibré_4? m f) ; f est la continuation courante, retourne (f equil? poids)

(if (feuille? m)

(f #t m)

(local [(define m1 (fg m))]

(equilibré_4? m1

(lambda (e1 p1)

(if e1

(local [(define m2 (fd m))]

(equilibré_4? m2

(lambda (e2 p2)

(if e2

(if (= p1 p2)

(f #t (+ (racine m) p1 p2)) ; on continue !

(list #f '?)) ; abandon de la continuation !

(list #f '?))))) ; abandon de la continuation !

(list #f '?))))))) ; abandon de la continuation !

> (equilibré_4? m1 list)

(#t 11)

> (equilibré_4? m2 list)

(#f ?)

10 Exercice 9.12.10

(define (foldr-arbre f g A)

(if (feuille? A)

(g A)

(f (racine A) (fg A) (fd A) (foldr-arbre f g (fg A)) (foldr-arbre f g (fd A)))))

Dans la fonction foldr-arbre :
- f est une fonction de 5 variables (f r Ag Ad rg rd) dans laquelle r représente la racine, Ag et Ad les fils, et rg, rd les résultats des traitements des fils.
- g est la fonction unaire (g x) de traitement d’une feuille.

Par exemple :

(define (nb-op A) ; parcours exhaustif de l'arbre

(foldr-arbre (lambda (r Ag Ad rg rd) (+ 1 rg rd)) (lambda (x) 0) A))

> (nb-op '(+ (* x 2) (- (/ x 3) y)))

11 Exercice 9.12.11

Le type abstrait ’pile fonctionnelle’ est dans le teachpack "valrose.rkt". Il contient les fonctions :

(pile-vide), (pile-vide? p), (sommet p), (empiler x p), (depiler p), (operateur? x)

Par exemple :

(define (nb-op-iter A)

(local [(define (iter A pile acc)

(if (feuille? A)

(if (pile-vide? pile)

acc

(iter (sommet pile) (depiler pile) acc))

(iter (fg A) (empiler (fd A) pile) (+ acc 1))))]

(iter A (pile-vide) 0)))

12 Exercice 9.12.12

(define (postfixe->arbre L) ; L est un parcours postfixe d'un arbre A

(local [(define (iter L pile) ; une pile d'arbres !

(cond ((empty? L) (sommet pile))

((operateur? (first L))

(local [(define Ad (sommet pile))

(define P (depiler pile))

(define Ag (sommet P))

(define P1 (depiler P))]

(iter (rest L) (empiler (arbre (first L) Ag Ad) P1))))

(else (iter (rest L) (empiler (first L) pile)))))]

(iter L (pile-vide))))

13 Exercice 9.12.13

Voir le fichier du type abstrait adt-abr.rkt qui contient les solutions (même si elles ne sont pas exportées dans le provide)...

14 Exercice 9.12.14

(define (point-suivant z) ; le prochain point a visiter en profondeur prefixe

(local [(define (point-suivant-en-haut z)

; le prochain point a visiter en remontant

(if (plus-rien-en-haut? z)

(if (plus-rien-a-droite? z)

(point-suivant-en-haut (zipper-parent z))

(go-right z))))

(define (point-suivant-en-bas z)

; le prochain point a visiter en descendant

(if (plus-rien-en-bas? z)

(if (plus-rien-a-droite? z)

(point-suivant-en-haut (zipper-parent z))

(go-right z))

(go-down z)))]

(point-suivant-en-bas z)))

> (zipper-arbre (point-suivant Z2))

> (zipper-arbre (point-suivant (go-down Z2)))

(define (show-points A)

(local [(define (iter z acc)

(local [(define A1 (zipper-arbre z))

(define obj (if (feuille? A1) A1 (racine A1)))

(define z1 (point-suivant z))]

(if (equal? z1 #f)

(reverse (cons obj acc))

(iter z1 (cons obj acc)))))]

(iter (arbre->zipper A) empty)))

> (show-points A)

(+ - x 2 * y 3 4 / sqrt z 5)