10. Programmer avec des Arbres

6.0.1.11

10. Programmer avec des Arbres

1 Exercice 10.1.1

a) On procède à un parcours postfixe de l’arbre :

(define (arbre->hp A)

(if (feuille? A)

(list A 'enter)

(append (arbre->hp (fg A)) (arbre->hp (fd A)) (list (racine A)))))

(show (arbre->hp '(- (* 2 (+ 5 1)) (/ 4 2))))

b) L’interprète n’est qu’un arpenteur de code HP qui traduit ce code en actions sur la pile. Il suffit de s’inspirer du code de exec1 à la page 195... Les calculs se font dans la pile, l’itération n’a pas besoin d’accumulateur.

2 Exercice 10.1.2

Le décompilateur de code VRISC1 est un analyseur syntaxique qui doit reconstruire l’arbre dont on possède le code-machine issu de la compilation. Il va utiliser ici aussi une pile.

(define (vrisc1->arbre L)

(local [(define (iter L pile)

(if (empty? L)

(sommet pile)

(local [(define instr (first L))

(define opcode (first instr))

(define arg (second instr))]

(iter (rest L)

(case opcode

((push) ...)

((call) ...))))))]

(iter L (pile-vide))))

3 Exercice 10.1.3

a) Au numéros des étiquettes près. Attention, chaque if a ses propres étiquettes !

> (arbre->vrisc2 '(+ (if (> x 0) (if (= y 4) (+ x y) (- y 1)) (* z 3)) (- x z)))

((push x) (push 0) (call >) (brf etiq3836) (push y) (push 4) (call =) (brf etiq3838) (push x) (push y) (call +) (jmp etiq3839) etiq3838 (push y) (push 1) (call -) etiq3839 (jmp etiq3837) etiq3836 (push z) (push 3) (call *) etiq3837 (push x) (push z) (call -) (call +))

b) Il suffit de s’inspirer du découpage souligné des lignes 81-82 page 199. Faites bien la distinction entre un ou deux appels à list suivant que vous voulez ou non conserver les parenthèses, puisque append fait sauter une paire de parenthèses...

(define (arbre-if->vrisc2 A)

(local [(define e1 (gensym 'etiq))

(define e2 (gensym 'etiq))]

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

(list (list 'brf e1))

(arbre->vrisc2 (fd A))

(list (list 'jmp e2))

(list e1)

(arbre->vrisc2 (fdd A))

(list e2))))

c) L’interprète (exec2 L P AL) généralise exec1. Notez que les sauts se font en avant, en l’absence de boucle qui retournerait en arrière, il est donc inutile de conserver un pointeur sur la tête de liste, mais il faudrait le faire si le code était produit manuellement ou dans une version VRISC3 d’examen avec des boucles impératives while (dans un cours de Scheme avancé par exemple)... Afin de poursuivre l’exécution à une étiquette donnée, nous ne pouvons pas utiliser member en langage Etudiant avancé [mais on le pourrait en vrai Scheme], il nous faut donc programmer une petite fonction qui retourne la portion de liste débutant à un élément donné :

(define (chercher etiq L)

(cond ((empty? L) empty)

((equal? (first L) etiq) L)

(else (chercher etiq (rest L)))))

> (chercher 3 '(1 2 3 4 5))

(3 4 5)

Nous sommes alors prêt pour itérer sur les instructions du code L :

(define (exec2 L P AL)

(cond ((empty? L) P)

((symbol? (first L)) (exec2 (rest L) P AL)) ; on passe les étiquettes !

(else (local [(define instr (first L))

(define opcode (first instr))

(define arg (second instr))]

(case opcode

((push) (exec2 (rest L)

(empiler (if (or (number? arg) (boolean? arg))

arg

(valeur-var arg AL))

AL))

((call) (local [(define x1 (sommet P))

(define P1 (depiler P))

(define x2 (sommet P1))

(define P2 (depiler P1))]

(exec2 (rest L)

(empiler (case arg

((+) (+ x2 x1))

((-) (- x2 x1))

((*) (* x2 x1))

((/) (/ x2 x1))

((=) (= x2 x1))

((<) (< x2 x1))

((<=) (<= x2 x1))

((>) (> x1 x2))

((>=) (>= x2 x1))

(else (error "Opérateur inconnu !" arg)))

P2)

AL)))

((jmp) (exec2 (chercher arg L) P AL)) ; saut inconditionnel à étiquette

((brf) (exec2 (if (equal? (sommet P) false) ; saut conditionnel

(chercher arg (rest L))

(rest L))

(depiler P)

AL))

(else (error "Instruction inconnue !" opcode)))))))

TRACER UNE FONCTION. Il est souvent agréable de pister l’évolution des appels à une fonction, surtout lorsqu’elle est itérative, ce qui est le cas ici. Pour cela, utilisez la librairie trace :

> (require racket/trace) ; à placer directement dans le fichier

> (trace exec2) ; maintenant elle est espionnée !

> (exec2 '((push 3) (jmp e10) (push 6) e10 (push x) (call *)) (pile-vide) '((x 2)))

>(exec2 ((push 3) (jmp e10) (push 6) e10 (push x) (call *)) () ((x 2))) ; entrée

>(exec2 ((jmp e10) (push 6) e10 (push x) (call *)) (3) ((x 2))) ; entrée

>(exec2 (e10 (push x) (call *)) (3) ((x 2))) ; entrée

>(exec2 ((push x) (call *)) (3) ((x 2))) ; entrée

>(exec2 ((call *)) (2 3) ((x 2))) ; entrée

>(exec2 () (6) ((x 2))) ; entrée

<(6) ; sortie

(6) ; le résultat

4 Exercice 10.1.4

a) Première solution, on programme un compilateur spécial :

(define (arbre-and->vrisc2 A)

(local [(define e1 (gensym 'etiq))

(define e2 (gensym 'etiq))]

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

(list (list 'brf e1))

(arbre->vrisc2 (fd A))

(list (list 'jmp e2))

(list e1)

(list (list 'push #f))

(list e2))))

> (arbre->vrisc2 '(if (and (= x O) (< y 1)) (+ z 1) (- z 1)))

((push x) (push O) (call =) (brf etiq17407) (push y) (push 1) (call <) (jmp etiq17408) etiq17407 (push #f) etiq17408 (brf etiq17405) (push z) (push 1) (call +) (jmp etiq17406) etiq17405 (push z) (push 1) (call -) etiq17406)

Notez que si (= x 0) donne #f, on se branche en etiq17407 pour empiler #f, et l’on se demande tout de suite après s’il y a bien #f sur la pile !

Autre solution, on macro-expanse le and en un if :

(define (arbre-and->vrisc2 A) ; A == (and fg fd)

(arbre-if->vrisc2 (arbre 'if (fg A) (fd A) #f)))

ERRATUM. Contrairement à ce qui est écrit dans le livre, les deux solutions produisent bien le même code redondant. Ce qui ne produirait pas le même code, c’est de reconnaître en compilant le if si son fils gauche est un noeud and, en jouant sur l’équivalence :

(if (and p q) x y) –> (if p (if q x y) y)

Mais du coup le code de y serait dupliqué. Je vous laisse réfléchir...

5 Exercice 10.1.5

Il s’agit d’un exercice de grande forme, que l’on est trop content de résoudre soi-même...

6 Exercice 10.2.1

Le simplificateur ci-dessous peut encore être étendu !

(define (simplif A)

(if (feuille? A)

(case (racine A)

((+) (simplif+ A))

((-) (simplif- A))

((*) (simplif* A))

((/) (simplif/ A))

(else (error 'simplif "Operateur inconnu: " (racine A))))))

(define (simplif+ A)

(local [(define A1 (simplif (fg A)))

(define A2 (simplif (fd A)))]

(cond ((equal? 0 A1) A2)

((equal? 0 A2) A1)

((and (number? A1) (number? A2)) (+ A1 A2))

((equal? A1 A2) (arbre '* 2 A1))

(else (arbre '+ A1 A2)))))

(define (simplif- A)

(local [(define A1 (simplif (fg A)))

(define A2 (simplif (fd A)))]

(cond ((equal? 0 A2) A1) ; (- 0 A) n'est pas simplifiable

((and (number? A1) (number? A2)) (- A1 A2))

(else (arbre '- A1 A2)))))

(define (simplif* A)

(local [(define A1 (simplif (fg A)))

(define A2 (simplif (fd A)))]

(cond ((or (equal? 0 A1) (equal? 0 A2)) 0)

((equal? 1 A1) A2)

((equal? 1 A2) A1)

((and (number? A1) (number? A2)) (* A1 A2))

(else (arbre '* A1 A2)))))

(define (simplif/ A)

(local [(define A1 (simplif (fg A)))

(define A2 (simplif (fd A)))]

(cond ((and (number? A1) (number? A2)) (/ A1 A2))

((equal? A1 0) 0)

((equal? A2 1) A1)

((equal? A2 -1) (arbre '- 0 A1))

((equal? A1 A2) 1)

((equal? A2 (arbre '* A1 A1)) (arbre '/ 1 A1)) ; (/ A (* A A)) --> (/ 1 A)

(else (arbre '/ A1 A2)))))

> (simplif '(+ (* x (- 5 (+ 3 2))) (/ (- y 0) (/ z z))))

Maintenant le dérivateur :

(define (diff A var)

(if (feuille? A)

(if (equal? A var) 1 0)

(simplif (case (racine A)

((+ -) (diff+- A var))

((*) (diff* A var))

((/) (diff/ A var))

(else (error 'diff "Operateur inconnu: " (racine A)))))))

(define (diff+- A var) ; A = (+- Ag Ad)

(arbre (racine A) (diff (fg A) var) (diff (fd A) var)))

(define (diff* A var) ; A = (* Ag Ad)

(arbre '+

(arbre '* (diff (fg A) var) (fd A))

(arbre '* (fg A) (diff (fd A) var))))

(define (diff/ A var) ; A = (/ Ag Ad)

(arbre '/

(arbre '- (arbre '* (diff (fg A) var) (fd A)) (arbre '* (fg A) (diff (fd A) var)))

(arbre '* (fd A) (fd A))))

> (diff '(+ (* x 3) (- (/ x y) 1)) 'x))

(+ 3 (/ 1 y))

> (diff '(+ (* x 3) (- (/ x y) 1)) 'y))

(/ (- 0 x) (* y y))

7 Exercice 10.2.2

On boucle en dérivant une seule fois l’arbre courant. Il est hors de question de calculer chaque fois la dérivée k-ème... Pour simplifier, j’utilise une fonction fac que l’on pourrait aussi éliminer...

(define (taylor A x x0 n) ; la liste des coefficients de la série de Taylor en x=x0 à l'ordre n

(local [(define (fac n)

(if (= n 0) 1 (* n (fac (- n 1)))))

(define (iter i A acc) ; A est la dernière dérivée calculée

(if (= i n)

(reverse acc)

(iter (+ i 1) (diff A x) (cons (/ (valeur A (list (list x x0))) (fac i)) acc))))]

(iter 0 A empty)))

Voici les 5 premiers termes du développement limité de (x+3)/(2x+5) en x=0 :

> (taylor '(/ (+ x 3) (+ (* 2 x) 5)) 'x 0 5)

(3/5 -1/25 2/125 -4/625 8/3125)

8 Exercice 10.2.3

Il s’agit de faire passer itérativement à droite tous les morceaux de l’arbre de gauche jusqu’à tomber sur la variable à isoler... Il faudra pouvoir demander chaque fois si x est à gauche ou à droite, par exemple avec feuille-dans? :

(define (x-dans? A) ; la variable x est-elle une feuille de A ?

(if (feuille? A)

(equal? A 'x)

(or (x-dans? x (fg A)) (x-dans? x (fd A)))))

Par exemple, A=(+ (* x 2) y) et B=3 donnerait à l’étape suivante A=(* x 2) et B=(- 3 y), etc. Faites attention quand même :-)

> (solve '(+ 3 (* k x)) 4)

(/ (- 4 3) k) ; avec en plus un p'tit coup de simplif pour les yeux ?...

9 Exercice 10.2.4

Il est important dans la fonction qui suit de ne pas simplifier dans la lambda, mais bien avant qu’elle ne soit créée !

(define (arbre->fonction A var)

(local [(define As (simplif A))] ; on ne sait jamais...

(lambda (val)

(valeur As (list (list var val))))))

> (define f (arbre->fonction '(+ (* 2 x) 1) 'x)) ; la simplification est faite ici

> (f 3) ; mais pas ici !

10 Exercice 10.2.5

Attention, il faudra demander de temps en temps si le fils droit existe !!

Exemples :

(define (simplif-cos A) ; A = (cos Ag)

(local [(define Ags (simplif (fg A)))]

(cond ((number? Ags) (cos Ags))

((equal? Ags 'pi) -1) ; pi symbolique, il en faudrait d'autres...

(else (arbre 'cos Ags)))))

(define (diff-cos A var) ; A = (cos Ag)

(arbre '- 0 (arbre '* (diff (fg A) var) (arbre 'sin (fg A)))))

etc.

11 Exercice 10.3.2

Les fonction du type abstrait ’formule logique d’ordre 0’ se trouvent dans le teachpack "valrose.rkt" :

(atome? F), (make-neg F), (make-fbf2 r Fg Fd), (connecteur mol), (arg1 mol), (arg2 mol)

(define (fbf? x)

(or (symbol? x)

(boolean? x)

(and (list? x)

(local [(define n (length x))]

(or (and (= n 2) (equal? (first x) 'non) (fbf? (second x)))

(and (= n 3) (member (second x) '(et ou =>)) (fbf? (first x)) (fbf? (third x))))))))

12 Exercice 10.3.3

(define (intersection? L1 L2) ; a)

(cond ((empty? L1) false)

((member (first L1) L2) true)

(else (intersection? (rest L1) L2))))

(define (delete fbf LF) ; b)

(cond ((empty? LF) LF)

((equal? fbf (first LF)) (rest LF))

(else (cons (first LF) (delete fbf (rest LF))))))

(define (first-molecule LF) ; c)

(cond ((empty? LF) false)

((atome? (first LF)) (first-molecule (rest LF)))

(else (first LF))))

(define (add fbf LF)

(if (member fbf LF) LF (cons fbf LF)))

13 Exercice 10.3.4

(define (wang? LHS RHS) ; LHS et RHS sont des listes de fbf sans implications

(if (intersection? LHS RHS)

true

(local [(define fbf (first-molecule LHS))] ; on cherche une molécule à gauche

(if (not (equal? fbf false))

(local [(define r (connecteur fbf))]

(cond ((equal? r 'non) ; une negation a gauche

(wang? (delete fbf LHS) (add (arg1 fbf) RHS)))

((equal? r 'ou) ; une disjonction a gauche

(and (wang? (add (arg1 fbf) (delete fbf LHS)) RHS)

(wang? (add (arg2 fbf) (delete fbf LHS)) RHS)))

((equal? r 'et) ; une conjonction a gauche

(wang? (add (arg1 fbf) (add (arg2 fbf) (delete fbf LHS))) RHS))

(else (error 'wang? "Bad syntax in fbf: " fbf))))

(local [(define fbf (first-molecule RHS))] ; on cherche une molécule à droite

(if (not (equal? fbf false))

(local [(define r (connecteur fbf))]

(cond ((equal? r 'non) ; une negation a droite

...)

((equal? r 'ou) ; une disjonction a droite

...)

((equal? r 'et) ; une conjonction a droite

...)

(else (error 'wang? "Bad syntax in fbf: " fbf))))

false))))))

14 Exercice 10.3.5

(define (theoreme? fbf)

(if (not (fbf? fbf))

(error 'theoreme? "Syntaxe incorrecte: " fbf)

(local [(define new-fbf (reformat fbf))]

(begin (printf "*** J'essaye de prouver ~a\n" fbf)

(printf "J'élimine d'abord les implications : ~a\n" new-fbf)

(wang? empty (list new-fbf))))))