;; Die ersten drei Zeilen dieser Datei wurden von DrScheme eingefügt. Sie enthalten Metadaten
;; über die Sprachebene dieser Datei in einer Form, die DrScheme verarbeiten kann.
#reader(lib "DMdA-vanilla-reader.ss" "deinprogramm")((modname kapitel-11) (read-case-sensitive #f) (teachpacks ()) (deinprogramm-settings #(#f write repeating-decimal #f #t none explicit #f ())))
; Kapitel 11

; Binärbäume

; Ein leerer Baum 
;(: make-empty-tree empty-tree)
(: empty-tree? (%a -> boolean))

(define-record-procedures empty-tree
  make-empty-tree empty-tree?
  ())

(define the-empty-tree (make-empty-tree))

; Ein Knoten besteht aus
; - einem Label
; - einem linken Baum
; - einem rechten Baum
(: make-node (%a tree tree -> node))
(: node? (%b -> boolean))
(: node-label (node -> %a))
(: node-left-branch (node -> tree))
(: node-right-branch (node -> tree))

(define-record-procedures node
  make-node node?
  (node-label
   node-left-branch node-right-branch))

; Ein Binärbaum ist entweder ein leerer Baum oder ein Knoten
(define tree (contract (mixed empty-tree node)))

(define t1 (make-node 3 (make-node 4 the-empty-tree (make-node 7 the-empty-tree the-empty-tree)) the-empty-tree))
(define t2 (make-node 17 (make-node 3 the-empty-tree t1) the-empty-tree))

; Tiefe eines Baums berechnen
(: depth (tree -> natural))
(check-expect (depth t1) 3)
(check-expect (depth t2) 5)

(define depth
  (lambda (t)
    (cond
      ((empty-tree? t)
       0)
      ((node? t)
       (+ 1
          (max (depth (node-left-branch t))
               (depth (node-right-branch t))))))))

; Knoten in Baum zählen
(: node-count (tree -> natural))
(check-expect (node-count t1) 3)
(check-expect (node-count t2) 5)

(define node-count
  (lambda (t)
    (cond
      ((empty-tree? t)
       0)
      ((node? t)
       (+ 1
          (node-count (node-left-branch t))
          (node-count (node-right-branch t)))))))

; Suchbäume

; Ein Suchbaum besteh aus
; - einer Prozedur, die zwei Markierungen auf Gleichheit testet,
; - einer Prozedur, die vergleicht, ob die erste Markierung kleiner
; - einem Binärbaum
(: make-search-tree ((%a %a -> boolean) (%a %a -> boolean) tree -> search-tree))
(: search-tree? (%a -> boolean))
(: search-tree-label-equal-proc (search-tree -> (%a %a -> boolean)))
(: search-tree-label-less-than-proc (search-tree -> (%a %a -> boolean)))
(: search-tree-tree (search-tree -> tree))

(define-record-procedures search-tree
  make-search-tree search-tree?
  (search-tree-label-equal-proc
   search-tree-label-less-than-proc
   search-tree-tree))

; leeren Suchbaum konstruieren
(: make-empty-search-tree ((%a %a -> boolean) (%a %a -> boolean) -> search-tree))

(define make-empty-search-tree
  (lambda (label-equal-proc label-less-than-proc)
    (make-search-tree label-equal-proc label-less-than-proc
                      the-empty-tree)))

; Exkurs:
(define factorial
  (lambda (n)
    (letrec
        ((factorial-helper
          (lambda (n result)
            (if (= n 0)
                result
                (factorial-helper (- n 1) (* n result))))))
      (factorial-helper n 1))))


;Beispiele für einen Suchbäume
(define s1
  (make-search-tree
   = <
   (make-node 5
              (make-node 17 the-empty-tree the-empty-tree)
              (make-node 3 the-empty-tree the-empty-tree))))

(define s2
  (make-search-tree
   = <
   (make-node 5
              (make-node 3 the-empty-tree the-empty-tree)
              (make-node 17
                         (make-node 10 the-empty-tree (make-node 12 the-empty-tree the-empty-tree))
                         the-empty-tree))))



; festellen, ob Element in Suchbaum vorhanden ist
(: search-tree-member? (%a search-tree -> boolean))
(check-expect (search-tree-member? 5 s1) #t)
(check-expect (search-tree-member? 17 s1) #f)
(check-expect (search-tree-member? 3 s1) #f)
(check-expect (search-tree-member? 5 s2) #t)
(check-expect (search-tree-member? 17 s2) #t)
(check-expect (search-tree-member? 3 s2) #t)
(check-expect (search-tree-member? 10 s2) #t)

(define search-tree-member?
  (lambda (l s)
    (let ((label-equal? (search-tree-label-equal-proc s))
          (label-less-than? (search-tree-label-less-than-proc s)))
      (letrec
          ;; member? : tree -> bool
          ((member?
            (lambda (t)
              (cond
               ((empty-tree? t) #f)
               ((node? t)
                (cond                 
                  ((label-equal? (node-label t) l)
                   #t)
                  ((label-less-than? l (node-label t))
                   (member? (node-left-branch t)))
                  (else
                   (member? (node-right-branch t)))))))))
        (member? (search-tree-tree s))))))


; neues Element in Suchbaum einfügen
(: search-tree-insert (%a search-tree -> search-tree))
(check-expect (search-tree-member? 5  s3) #t)
(check-expect (search-tree-member? 17  s3) #t)
(check-expect (search-tree-member? 3  s3) #t)
(check-expect (search-tree-member? 13  s3) #f)
(check-expect (search-tree-member? -1  s3) #f)


(define search-tree-insert
  (lambda (l s)
    (let ((label-equal? (search-tree-label-equal-proc s))
          (label-less-than? (search-tree-label-less-than-proc s)))
      (letrec
          ;; insert : tree -> tree
          ((insert
            (lambda (t)
              (cond
               ((empty-tree? t)
                (make-node l the-empty-tree the-empty-tree))
               ((node? t)
                (cond
                  ((label-equal? l (node-label t))
                   t)
                  ((label-less-than? l (node-label t))
                   (make-node (node-label t)
                              (insert (node-left-branch t))
                              (node-right-branch t)))
                  (else
                   (make-node (node-label t)
                              (node-left-branch t)
                              (insert (node-right-branch t))))))))))
        (make-search-tree
         label-equal? label-less-than?
         (insert (search-tree-tree s)))))))

; aus allen Zahlen einer Liste einen Suchbaum machen
(: list->search-tree ((%a %a -> boolean)
                      (%a %a -> boolean) (list %a) -> search-tree))

(check-property
 (for-all ((els (list real)))
   (let ((st (list->search-tree = < els)))
     (every? (lambda (el)
               (search-tree-member? el st))
             els))))

(check-property
 (for-all ((els (list real))
           (el real))
   (==> (not (member? = el els))
        (not (search-tree-member? el (list->search-tree = < els)))))) 

(define list->search-tree
  (lambda (= < els)
    (fold (make-empty-search-tree = <)
          search-tree-insert
          els)))

(define every?
  (lambda (p? lis)
    (fold #t
          (lambda (first result)
            (and result
                 (p? first)))
          lis)))

; ist Wert Element einer Liste?
(: member? ((%a %a -> boolean) %a (list %a) -> boolean))

(check-expect (member? = 5 empty) #f)
(check-expect (member? = 5 (list 1 2 3)) #f)
(check-expect (member? = 1 (list 1 2 3)) #t)
(check-expect (member? = 2 (list 1 2 3)) #t)
(check-expect (member? = 3 (list 1 2 3)) #t)

(define member?
  (lambda (= el lis)
    (cond
      ((empty? lis) #f)
      ((pair? lis)
       (if (= el (first lis))
           #t
           (member? = el (rest lis)))))))

;Baum mit search-tree-insert
(define s3
  (search-tree-insert
   5
   (search-tree-insert
    17
    (search-tree-insert
     3
     (make-empty-search-tree = <)))))

; Huffman-Bäume

; Ein Huffman-Blatt besteht aus
; - einer Zeichenkette
; - einer natürlichen Zahl
(: make-huffman-leaf (string natural -> huffman-leaf))
(: huffman-leaf? (%a -> boolean))
(: huffman-leaf-name (huffman-leaf -> string))
(: huffman-leaf-weight (huffman-leaf -> natural))

(define-record-procedures huffman-leaf
  make-huffman-leaf huffman-leaf?
  (huffman-leaf-name
   huffman-leaf-weight))

; Ein Huffman-Knoten besteht aus
; - einer Liste von Zeichnketten
; - einer natürlichen Zahl
; - einem Huffman-Baum für den linken Teilbaum
; - einem Huffman-Baum für den rechten Teilbaum
(: really-make-huffman-node ((list string) natural huffman-tree huffman-tree -> huffman-node))
(: huffman-node? (%a -> boolean))
(: huffman-node-names (huffman-node -> (list string)))
(: huffman-node-weight (huffman-node -> natural))
(: huffman-node-left (huffman-node -> huffman-tree))
(: huffman-node-right (huffman-node -> huffman-tree))

(define-record-procedures huffman-node
  really-make-huffman-node huffman-node?
  (huffman-node-names 
   huffman-node-weight 
   huffman-node-left huffman-node-right))

; Ein Huffman-Baum ist entweder ein Huffman-Blatt oder ein Huffman-Knoten
(define huffman-tree (contract (mixed huffman-leaf huffman-node)))


; Huffman-Knoten aus zwei Teilbäumen konstruieren
(: make-huffman-node (huffman-tree huffman-tree -> huffman-node))

(define make-huffman-node
  (lambda (l r)
    (really-make-huffman-node
     (append (huffman-tree-names l)
             (huffman-tree-names r))
     (+ (huffman-tree-weight l)
        (huffman-tree-weight r))
     l r)))

; Liste der Namen eines Huffman-Baums berechnen
(: huffman-tree-names (huffman-tree -> (list string)))

(define huffman-tree-names
  (lambda (t)
    (cond
      ((huffman-leaf? t)
       (list (huffman-leaf-name t)))
      ((huffman-node? t)
       (huffman-node-names t)))))

; Gewicht eines Huffman-Baums berechnen
(: huffman-tree-weight (huffman-tree -> natural))

(define huffman-tree-weight
  (lambda (t)
    (cond
      ((huffman-leaf? t)
       (huffman-leaf-weight t))
      ((huffman-node? t)
       (huffman-node-weight t)))))

;Beispiel für einen Huffman-Baum
(define roses-tree
  (make-huffman-node
   (make-huffman-node
    (make-huffman-leaf "Buckethead" 12)
    (make-huffman-node
     (make-huffman-node
      (make-huffman-leaf "Paul" 2)
      (make-huffman-leaf "Brain" 3))
     (make-huffman-node
      (make-huffman-node
       (make-huffman-leaf "Tommy" 1)
       (make-huffman-leaf "Dizzy" 2))
      (make-huffman-leaf "Robin" 4))))
   (make-huffman-leaf "Axl" 100)))

; Ein Bit ist entweder 1 oder 0.
(define bit (contract (one-of 0 1)))

; Huffman-codierte Bitfolge decodieren
(: huffman-decode ((list bit) huffman-tree -> (list string)))
(check-expect (huffman-decode (list 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1) roses-tree) (list "Axl" "Dizzy" "Tommy" "Paul" "Axl"))
(check-expect (huffman-decode (list 0 0 1 0 1 0 0) roses-tree) (list "Buckethead" "Axl" "Paul"))

(define huffman-decode
  (lambda (bits t)
    (let ((top t))
      (letrec
          ;; Bitfolge decodieren
          ;(: decode ((list bit) huffman-tree -> (list string)))
          ((decode
            (lambda (bits t)
              (cond
                ((empty? bits) empty)
                ((pair? bits)
                 (let ((next 
                        (cond
                          ((= (first bits) 0) (huffman-node-left t))
                          ((= (first bits) 1) (huffman-node-right t)))))
                   (cond
                     ((huffman-leaf? next)
                      (make-pair (huffman-leaf-name next)
                                 (decode (rest bits) top)))
                     ((huffman-node? next)
                      (decode (rest bits) next)))))))))
        (decode bits top)))))

;Rückgabewert für nicht-gefundene Elemente
(: make-not-found ( -> not-found)) ;Fehler wenn nur (: make-not-found not-found)
(: not-found? (%a -> boolean))

(define-record-procedures not-found
  make-not-found not-found?
  ())

; Namen Huffman-codieren
(: huffman-encode-name (string huffman-tree -> (mixed (list bit) not-found)))

(define huffman-encode-name
  (lambda (n t)
    (cond
      ((huffman-leaf? t)
       (if (string=? (huffman-leaf-name t) n)
           empty
           (make-not-found)))
      ((huffman-node? t)
       (let ((maybe-encoding
              (huffman-encode-name n (huffman-node-left t))))
         (if (not-found? maybe-encoding)
             (let ((maybe-encoding
                    (huffman-encode-name n (huffman-node-right t))))
               (if (not-found? maybe-encoding)
                   (make-not-found)
                   (make-pair 1 maybe-encoding)))
             (make-pair 0 maybe-encoding)))))))



; Listen von Namen Huffman-codieren
(: huffman-encode ((list string) huffman-tree -> (list bit)))
(check-expect (huffman-encode (list "Axl" "Dizzy" "Tommy" "Paul" "Axl") roses-tree) 
              (list 1 0 1 1 0 1 0 1 1 0 0 0 1 0 0 1))
(check-expect (huffman-encode (list "Buckethead" "Axl" "Paul") roses-tree)
              (list 0 0 1 0 1 0 0)) 
 
(define huffman-encode
  (lambda (message t)
    (cond
      ((empty? message) empty)
      ((pair? message)
       (append (huffman-encode-name (first message) t)
               (huffman-encode (rest message) t))))))