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) |
A |
(arbre (racine A) (miroir (fd A)) (miroir (fg A))))) |
3 Exercice 9.12.3
(define (nb-op A) |
(if (feuille? A) |
0 |
(+ 1 (nb-op (fg A)) (nb-op (fd A))))) |
(define (subst-op op1 op2 A) |
(if (feuille? A) |
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)))) |
L) |
== (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) |
m |
(+ (racine m) (poids (fg m)) (poids (fd m))))) |
> (poids M) |
11 |
(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) |
#t |
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))) |
4 |
11 Exercice 9.12.11
(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) |
#f |
(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)) |
y |
> (zipper-arbre (point-suivant (go-down Z2))) |
3 |
(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) |