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

; Ein Codeblatt besteht aus
; - einem Symbol (string)
; - einer Gewichtung (natural)
(define-record-procedures leaf
  make-leaf
  leaf?
  (leaf-symbol leaf-weight))

(: make-leaf (string natural -> leaf))
(: leaf? (any -> boolean))
(: leaf-symbol (leaf -> string))
(: leaf-weight (leaf -> natural))

; Ein Codeknoten besteht aus
; - einer Menge von Symbolen (list-of string)
; - einer Gewichtung (natural)
; - einem linken Teilbaum
; - einem rechten Teilbaum
(define-record-procedures node
  make-node
  node?
  (node-symbols node-weight node-left node-right))

; Ein Codebaum (Huffman-Baum) ist eins der Folgenden:
; - ein Codeblatt
; - ein Codeknoten
(define tree
  (signature
   (mixed leaf
          node)))

(: make-node ((list-of string) natural tree tree -> node))
(: node? (any -> boolean))
(: node-symbols (node -> (list-of string)))
(: node-weight (node -> natural))
(: node-left (node -> tree))
(: node-right (node -> tree))

; Konstruktion eines Code-Baums aus zwei Teilbäumen
; append = früheres concatenate
(: make-code-tree (tree tree -> node))
(define make-code-tree
  (lambda (left right)
    (make-node (append (symbols left) (symbols right))
               (+ (weight left) (weight right))
               left
               right)))

; Symbole eines Baumes
(: symbols (tree -> (list-of string)))
(define symbols
  (lambda (t)
    (cond ((leaf? t) (cons (leaf-symbol t) empty))
          ((node? t) (node-symbols t)))))

; Gewichtung eines Baumes
(: weight (tree -> natural))
(define weight
  (lambda (t)
    (cond ((leaf? t) (leaf-weight t))
          ((node? t) (node-weight t)))))


; Decodieren von Nachrichten

; Ein Bit ist 0 oder 1
(define bit
  (signature (one-of 0 1)))

; Decodiere eine Liste von Bits mit Hilfe eines Huffman-Baumes
(: decode ((list-of bit) tree -> (list-of string)))
(define decode
  (lambda (bits tree)
    (decode-1 bits tree tree)))

; Decodiere eine Liste von Bits mit einem Huffman-Teilbaum (+ Originalbaum)
(: decode-1 ((list-of bit) tree tree -> (list-of string)))
(define decode-1
  (lambda (bits tree current-branch)
    (if (empty? bits)
        empty
        (decode-next-branch (rest bits)
                            tree
                            (choose-branch (first bits) current-branch)))))

(: choose-branch (bit node -> tree))
(define choose-branch
  (lambda (bit branch)
    (cond ((= bit 0) (node-left branch))
          ((= bit 1) (node-right branch)))))

(: decode-next-branch ((list-of bit) tree tree -> (list-of string)))
(define decode-next-branch
  (lambda (restbits tree next-branch)
    (cond ((leaf? next-branch) (cons (leaf-symbol next-branch)
                                     (decode-1 restbits tree tree)))
          ((node? next-branch) (decode-1 restbits tree next-branch)))))


; Konstruktion von Huffman-Bäumen:
; aus einer Menge von Huffman-Bäume suche zwei mit kleinstem Gewicht
; hierzu: Menge von Huffman-Bäumen ist geordnet nach kleinstem Gewicht

; Einfügen in eine geordnete Menge von gewichteten Huffman-Bäumen:
(: add-weighted-set (tree (list-of tree) -> (list-of tree)))
(define add-weighted-set
  (lambda (x set)
    (cond ((empty? set) (cons x empty))
          ((< (weight x) (weight (first set))) (cons x set))
          (else (cons (first set) (add-weighted-set x (rest set)))))))

; Aus einer Menge von (ungeordneten) Liste von Blättern
; eines Huffman-Baums (Symbol/Häufigkeits-Paare)
; eine nach Gewicht geordnete Liste von Blättern konstruieren:
(: make-leaf-set ((list-of leaf) -> (list-of tree)))
(define make-leaf-set
  (lambda (leaves)
    (cond ((empty? leaves) empty)
          ((cons? leaves) (add-weighted-set
                             (first leaves)
                             (make-leaf-set (rest leaves)))))))

(define leavesABCD
  (list (make-leaf "A" 8)
        (make-leaf "B" 3)
        (make-leaf "C" 1)
        (make-leaf "D" 1)))