;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-advanced-reader.ss" "lang")((modname chap9) (read-case-sensitive #t) (teachpacks ((lib "valrose.rkt" "installed-teachpacks"))) (htdp-settings #(#t write mixed-fraction #t #t none #f ((lib "valrose.rkt" "installed-teachpacks")))))
;;; chap9.rkt
;;; Langage : Etudiant avance. Teachpack : valrose.rkt

; le type abstrait 'arbre binaire d'expression' se trouve dans le teachpack "valrose.rkt"...
; (arbre r Ag Ad), (racine A), (fg A), (fd A), (feuille? A), (operateur? obj)

(define AT '(+ (* x 3) (- y (/ x 2))))      ; ligne 15

(show AT)

(define (hauteur A)
  (if (feuille? A)
      0
      (+ 1 (max (hauteur (fg A)) (hauteur (fd A))))))

(show (hauteur AT))

(define (feuille-dans? x A)    ; ligne 23
  (if (feuille? A)
      (equal? x A)
      (or (feuille-dans? x (fg A))
          (feuille-dans? x (fd A)))))

(show (feuille-dans? 'y AT))
(show (feuille-dans? 'z AT))

(define (nb-feuilles A)        ; ligne 32
  (if (feuille? A)
      1
      (+ (nb-feuilles (fg A)) (nb-feuilles (fd A)))))

(show (nb-feuilles AT))

(define (arbre->postfixe A)    ; ligne 38
  (if (feuille? A)
      (list A)
      (append (arbre->postfixe (fg A))
              (arbre->postfixe (fd A))
              (list (racine A)))))

(show (arbre->postfixe AT))

(define (valeur A AL)         ; ligne 46
  (if (feuille? A)
      (if (number? A)
          A 
          (local [(define essai (assoc A AL))]
            (if (equal? essai false)
                (error 'valeur "Variable indefinie : " A)
                (second essai))))
      (local [(define r (racine A))
              (define vg (valeur (fg A) AL)) 
              (define vd (valeur (fd A) AL))]
        (case r
          ((+) (+ vg vd))
          ((-) (- vg vd))
          ((*) (* vg vd))
          ((/) (/ vg vd))
          (else (error 'valeur "Operateur inconnu : " (racine A)))))))

(check-expect (valeur AT '((x 4) (y 5))) 15)
(check-error (valeur AT '((x 4) (z 1))) "valeur: Variable indefinie : y")
(check-error (valeur '(+ (expt x 2) 1) '((x 4))) "valeur: Operateur inconnu : expt")

(define (simplif-const A)       ; ligne 65
  (if (feuille? A)
      A
      (local [(define sg (simplif-const (fg A)))
              (define sd (simplif-const (fd A)))]
        (if (and (number? sg) (number? sd))
            (case (racine A)
              ((+) (+ sg sd))
              ((-) (- sg sd))
              ((*) (* sg sd))
              ((/) (/ sg sd))
              (else (error "simplif-const : Operateur inconnu" (racine A))))
            (arbre (racine A) sg sd)))))

(show (simplif-const '(+ (* x (- 8 (* 2 3))) (* 2 4))))

(define (arbre->prefixe A)         ; ligne 81
  (if (feuille? A)
      (list A)
      (cons (racine A)
            (append (arbre->prefixe (fg A))
                    (arbre->prefixe (fd A))))))

(show (arbre->prefixe AT))

(define (arboriser L)       ; ligne 92, retourne une liste (arbre reste)
  (cond ((empty? L) (error 'arboriser "Parcours prefixe incomplet !"))
        ((operateur? (first L))
         (local [(define HR1 (arboriser (rest L)))]     ; HR1 = (A1 R1)
           (if (empty? (second HR1))
               (error 'arboriser "Parcours incomplet !")
               (local [(define HR2 (arboriser (second HR1)))]
                 (list (arbre (first L) (first HR1) (first HR2))
                       (second HR2))))))
        (else (list (first L) (rest L)))))

(show (arboriser '(+ * - x y z + u v a b c d)))

(define (prefixe->arbre L)       ; ligne 104
  (local [(define essai (arboriser L))
          (define A (first essai))
          (define R (second essai))]
    (if (empty? R)
        A
        (error 'prefixe->arbre "Expression trop longue : " R))))

(show (prefixe->arbre '(+ * - x y z + u v)))
(check-error (prefixe->arbre '(+ * - x y z + u v a b c d)) 
             "prefixe->arbre: Expression trop longue : (a b c d)")

;;; Dessiner un arbre § 9.6

(define (objet->image x)
  (text (if (number? x) (number->string x) (symbol->string x))
        18 "black"))

(define (vert h) (rectangle 1 h 'solid "white"))
(define (horiz w) (rectangle w 1 'solid "white"))

(define (arbre->image A)    ; Arbre --> Image au niveau n
  (if (feuille? A)
      (objet->image A)
      (local [(define ig (arbre->image (fg A)))
              (define wg/2 (/ (image-width ig) 2))
              (define id (arbre->image (fd A)))
              (define wd/2 (/ (image-width id) 2))
              (define igd (beside/align 'top ig (horiz 20) id))
              (define wgd/2 (/ (image-width igd) 2))]
        (above (objet->image (racine A))
               (beside (horiz wg/2) 
                       (line (- wg/2 wgd/2) 20 "black") 
                       (line (- wgd/2 wd/2) 20 "black")
                       (horiz wd/2))
               (vert 5)
               igd))))

(arbre->image '(+ (* (+ (* x (- x y)) 2) (* (- a b) longueur)) (/ (* x 2) y)))

;;; Parcours d'arbres iteratifs § 9.7

; le type abstrait 'pile fonctionnelle' est dans le teachpack "valrose.rkt"
; (pile-vide), (pile-vide? p), (sommet p), (empiler x p), (depiler p)

(define (nb-feuilles-iter A)          ; ligne 138
  (local [(define (iter A pile acc)
            (begin (printf "A=~a pile=~a acc=~a\n" A pile acc)    ; begin pour séquencer des expressions !
                   (if (feuille? A)
                       (if (pile-vide? pile)
                           (+ acc 1)
                           (iter (sommet pile) (depiler pile) (+ acc 1)))
                       (iter (fg A) (empiler (fd A) pile) acc))))]
    (iter A (pile-vide) 0)))

(show (nb-feuilles-iter AT))

(define (feuillage A)        ; ligne 158
  (if (feuille? A)
      (list A)
      (append (feuillage (fg A)) (feuillage (fd A)))))

(show (feuillage AT))

(define (k-feuillage A f)    ; ligne 162, CPS
  (if (feuille? A)
      (f (list A))
      (k-feuillage (fg A)
                   (lambda (Lg)
                     (k-feuillage (fd A)
                                  (lambda (Ld)
                                    (f (append Lg Ld))))))))

(show (k-feuillage AT length))
(show (k-feuillage AT identity))

;;; Parcours en largeur § 9.8

; Et non, le type abstrait 'file d'attente fonctionnelle en 0(1) amorti' n'est pas
; dans le teachpack valrose.rkt, mais dans un fichier "adt-file.rkt" dans le meme repertoire.
; Si vous en avez besoin, il faut le requerir :

(require "adt-file.rkt")     ; chemin relatif au repertoire courant

(define (arbre->largeur A)
  (local [(define (iter foret acc)   ; la foret est geree en file d'attente
            (if (file-vide? foret)
                (reverse acc)
                (local [(define A (premier foret)) 
                        (define r (if (feuille? A) A (racine A)))]
                  (iter (if (feuille? A)
                            (defiler foret)
                            (enfiler (fd A) (enfiler (fg A) (defiler foret))))
                        (cons r acc)))))]
    (iter (enfiler A (file-vide)) empty)))

(show (arbre->largeur AT))

;;; Arbres binaires de recherche § 9.9
;;; Voir le fichier "adt-abr.rkt" dans le meme repertoire :
;;; 

(require "adt-abr.rkt")

(printf "Voici un arbre equilibre par AVL :\n")
(show (liste->abr '(1 2 3 4 5 6) <))        ; par insertions equilibrantes successives

;;; Les zippers § 9.11
;;; Vous trouverez le type abstrait 'zipper' (arbre n-aire multi-directionnel) dans
;;; le fichier "adt-zipper.rkt" dans le meme repertoire.

(require "adt-zipper.rkt")

(define A '(+ (- x 2) (* y 3 4) (/ (sqrt z) 5)))   ; arbre n-aire
(define Z0 (make-zipper A empty 'top empty))       ; je suis a la racine
(show Z0)
(show (go-right (go-down Z0)))