;;; Module adt-abr.rkt - Livre "Premiers Cours de Programmation avec Scheme" (Ellipses ed, 2010)
;;; Doit etre sauvegarde comme 'langage determine par le source' !
;;; Racket > v5.0

;;; "Arbres Binaires de Recherche Equilibres" (portant des nombres reels)
;;; Tous les elements sont distincts, comparables avec une relation d'ordre strict notee <
;;; Implementation concrete avec des listes. On ne maintient pas la hauteur des noeuds.

#lang racket

(provide abr-vide abr-vide? abr-racine abr-fg abr-fd abr-insertion 
         liste->abr abr-member? abr-max abr-suppression)

(define-syntax show                ; un petit utilitaire pour tester
  (syntax-rules ()
    ((show expr) (printf "> ~a\n==> ~a\n" 'expr expr))))

(define (abr-vide) empty)          ; ligne 224 chap. 9 du livre PCPS, ligne 224

(define (abr-vide? A)
  (empty? A))

(define (make-abr r Ag Ad)     ; construction d'un noeud. On suppose que
  (list r Ag Ad))               ; les verifications d'abr ont ete faites en amont

(define (abr-racine A)
  (if (abr-vide? A)  
      (error 'abr-racine "arbre vide") 
      (first A)))

(define (abr-fg A)
  (if (abr-vide? A) 
      (error 'abr-fg "arbre vide") 
      (second A)))

(define (abr-fd A)
  (if (abr-vide? A) 
      (error 'abr-fd "arbre vide") 
      (third A)))

(define ABR-TEST
  (make-abr 12
            (make-abr 8
                      (make-abr 5 empty empty)
                      (make-abr 10 (make-abr 9 empty empty) empty))
            (make-abr 20
                      (make-abr 15 empty (make-abr 18 empty empty))
                      empty)))

;(show ABR-TEST)

;;; BONUS : affichage d'un ABR avec indentation

(define (abr-print A)
  (local [(define (print-with-spaces n x)    ; affiche x apres n espaces et va a la ligne
            (printf "~a~a\n" (build-string n (lambda (i) #\space)) x))
          (define (aux A m)      ; m = marge, nombre d'espaces en tete
            (if (abr-vide? A)
                (print-with-spaces m "<vide>")
                (begin (print-with-spaces m (abr-racine A))
                       (aux (abr-fg A) (+ m 2))
                       (aux (abr-fd A) (+ m 2)))))]
    (aux A 3)))

;(printf "Voici ABR-TEST :\n")
;(abr-print ABR-TEST)

; ------------------ appartenance d'un element a un ABR

(define (abr-member? x A <)      ; on passe la relation d'ordre strict, ligne 245
  (if (abr-vide? A) 
      false
      (local [(define r (abr-racine A)) 
              (define Ag (abr-fg A)) 
              (define Ad (abr-fd A))]
        (cond ((< x r) (abr-member? x Ag <))
              ((< r x) (abr-member? x Ad <))
              (else true)))))

;(show (abr-member? 20 ABR-TEST <)) 
;(show (abr-member? 13 ABR-TEST <))

; ------------------ insertion d'un nouvel element aux feuilles

(define (abr-insertion-f x A <)     ; insertion de x aux feuilles de l'abr A, ligne 254
  (if (abr-vide? A) 
      (make-abr x (abr-vide) (abr-vide))
      (local [(define r (abr-racine A)) 
              (define Ag (abr-fg A)) 
              (define Ad (abr-fd A))]
        (cond ((< x r) (make-abr r (abr-insertion-f x Ag <) Ad))
              ((< r x) (make-abr r Ag (abr-insertion-f x Ad <)))
              (else A)))))          ; on ne rajoute pas x, il est deja la !

;(show (abr-insertion-f 11 ABR-TEST <))
;(abr-print (abr-insertion-f 11 ABR-TEST <))

; l'equilibrage par AVL

(define (hauteur A)     ; ligne 265
  (if (abr-vide? A)
      0
      (+ 1 (max (hauteur (abr-fg A))
                (hauteur (abr-fd A))))))

;(show (hauteur ABR-TEST))

(define (pente A)       ; ligne 270
  (- (hauteur (abr-fg A)) (hauteur (abr-fd A))))

;(show (pente (abr-fg ABR-TEST)))
;(show (pente (abr-fd ABR-TEST)))
;(printf "On voit que ABR-TEST n'est pas equilibre ! D'ailleurs :\n")

(define (avl? A)        ; A est un ABR, ligne 272
  (or (abr-vide? A)
      (and (<= (abs (pente A)) 1)
           (avl? (abr-fg A))
           (avl? (abr-fd A)))))

;(show (avl? ABR-TEST))

(define (abr-insertion x AVL <)       ; insertion equilibrante dans un AVL, ligne 283
  (if (abr-vide? AVL)
      (make-abr x (abr-vide) (abr-vide))
      (local [(define r (abr-racine AVL)) 
              (define Ag (abr-fg AVL)) 
              (define Ad (abr-fd AVL))]
        (cond ((< x r) (equilibrer (make-abr r (abr-insertion x Ag <) Ad)))
              ((> x r) (equilibrer (make-abr r Ag (abr-insertion x Ad <))))
              (else AVL)))))

(define (equilibrer AVLD)       ; AVLD non vide, ligne 294
  (local [(define r (abr-racine AVLD)) 
          (define Ag (abr-fg AVLD)) 
          (define Ad (abr-fd AVLD))]
    (case (pente AVLD)
      ((-1 0 1) AVLD)                              ; il est deja equilibre !
      ((-2) (case (pente Ad)
              ((-1 0) (rotg AVLD))
              ((1)    (rotg (make-abr r Ag (rotd Ad))))))
      ((2)  (case (pente Ag)
              ((0 1)  (rotd AVLD))
              ((-1)   (rotd (make-abr r (rotg Ag) Ad))))))))

(define (rotd AVLD)                            ; rotation droite d'un AVLD, ligne 306
  (make-abr (abr-racine (abr-fg AVLD)) 
            (abr-fg (abr-fg AVLD))
            (make-abr (abr-racine AVLD) (abr-fd (abr-fg AVLD)) (abr-fd AVLD))))

(define (rotg AVLD)                            ; rotation gauche d'un AVLD, ligne 312
  (make-abr (abr-racine (abr-fd AVLD))
            (make-abr (abr-racine AVLD) (abr-fg AVLD) (abr-fg (abr-fd AVLD)))
            (abr-fd (abr-fd AVLD))))

(define (liste->abr L <)        ; L est une liste de reels tous distincts, ligne 318
  (if (empty? L)
      (abr-vide)
      (abr-insertion (first L) (liste->abr (rest L) <) <)))

;(printf "Je transforme la liste (1 2 3 4 5 6 7) en AVL :\n")
;(define AVL-TEST (liste->abr '(1 2 3 4 5 6 7) <))
;(show AVL-TEST)
;(show (avl? AVL-TEST))

(define (abr-max AVL <)         ; AVL non vide, retourne (<max> <AVL sans le max>), ligne 322
  (local [(define r (abr-racine AVL)) 
          (define Ag (abr-fg AVL)) 
          (define Ad (abr-fd AVL))]
    (if (abr-vide? Ad)
        (list r Ag)
        (local [(define HR (abr-max Ad <))]                ; HR = (m1 A1)
          (list (first HR) (equilibrer (make-abr r Ag (second HR))))))))

;(local [(define AM (abr-max AVL-TEST <))]
;  (printf "Le maximum de AVL-TEST est ~a et apres suppression on obtient ~a\n" (first AM) (second AM)))

(define (abr-suppression x AVL <)       ; retourne l'AVL sans l'element x, ligne 333
  (if (abr-vide? AVL) 
      AVL
      (local [(define r (abr-racine AVL)) 
              (define Ag (abr-fg AVL)) 
              (define Ad (abr-fd AVL))]
        (cond ((< x r) (equilibrer (make-abr r (abr-suppression x Ag <) Ad)))
              ((< r x) (equilibrer (make-abr r Ag (abr-suppression x Ad <))))
              ; l'element a supprimer est donc a la racine !
              ((abr-vide? Ag) Ad)
              (else (local [(define S (abr-max Ag <))]
                      (equilibrer (make-abr (first S) (second S) Ad))))))))

;(show AVL-TEST)
;(printf "Je supprime 4 dans AVL-TEST et le resultat est encore equilibre :\n")
;(show (abr-suppression 4 AVL-TEST <))

;;; ========== SOLUTIONS DE L'EXERCICE 9.12.13 ===========

; a)

(define (abr-insertion-r x A <)      ; insertion a la racine !
  (if (abr-vide? A) 
      (make-abr x (abr-vide) (abr-vide))
      (local [(define r (abr-racine A)) (define Ag (abr-fg A)) (define Ad (abr-fd A))]
        (cond ((< x r) (local [(define B (abr-insertion-r x Ag <))]
                         (make-abr x (abr-fg B) (make-abr r (abr-fd B) Ad))))
              ((< r x) (local [(define B (abr-insertion-r x Ad <))]
                         (make-abr x (make-abr r (abr-fg A) (abr-fg B)) (abr-fd B))))
              (else A)))))    ; deja present, pas de duplication !

;(show ABR-TEST)
;(printf "Insertion de 10 a la racine :\n")
;(show (abr-insertion-r 10 ABR-TEST <))

; b) Pour calculer le minimum d'un ABR, inspirez-vous du calcul du maximum...

; c)

(define (elements A bas haut <)   ; les elements de A qui sont dans [bas, haut]
  (local [(define (aux A L)       ; L = resultat jusqu'a present
            (if (abr-vide? A) 
                L
                (local [(define r (abr-racine A)) (define Ag (abr-fg A)) (define Ad (abr-fd A))]
                  (cond ((< r bas) (aux Ad L))
                        ((< haut r) (aux Ag L))
                        (else (aux Ag (cons r (aux Ad L))))))))]
    (aux A empty)))

(show ABR-TEST)
(printf "Elements entre 5 et 10 inclus :\n")
(show (elements ABR-TEST 5 10 <))

; d)

(define (tri-par-AVL L)   ; L est une lsite de nombres reels distincts
  (local [(define (infixe A)   ; parcours infixe
            (if (abr-vide? A)
                empty
                (append (infixe (abr-fg A))
                        (list (abr-racine A))
                        (infixe (abr-fd A)))))]
    (infixe (liste->abr L <))))

;(show (tri-par-AVL '(8 3 5 2 7 9 1 4 0 6)))

; e) classique. Si n = 2^h, alors h = log(n)...

; f) CPS sur un arbre avec une continuation à deux variables