diff options
Diffstat (limited to 'coding-exercises/2/67.rkt')
| -rw-r--r-- | coding-exercises/2/67.rkt | 106 |
1 files changed, 90 insertions, 16 deletions
diff --git a/coding-exercises/2/67.rkt b/coding-exercises/2/67.rkt index d6021b1..fec1388 100644 --- a/coding-exercises/2/67.rkt +++ b/coding-exercises/2/67.rkt @@ -56,8 +56,7 @@ (define (adjoin-set x mset) (cond ((null? mset) (list x)) - ((< (weight x) (weight (car mset)) - (cons x mset))) + ((< (weight x) (weight (car mset))) (cons x mset)) (else (cons (car mset) (adjoin-set x (cdr mset)))))) @@ -67,7 +66,7 @@ (let ((pair (car pairs))) (adjoin-set (make-leaf (car pair) (cadr pair)) - (make-leaf-set (cdr pairs)))))) + (make-leaf-set (cdr pairs)))))) ;; 67 (define sample-tree @@ -88,18 +87,93 @@ (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) + +;; just use id as key +(define (key x) + x) + +;; scan for symbol +(define (list-lookup given-key set-of-records) + (cond ((null? set-of-records) false) + ((equal? given-key (key (car set-of-records))) + (car set-of-records)) + (else (list-lookup given-key (cdr set-of-records))))) + +;; without using symbol list, for some reason +;; This is probably not the best way to do it because we cannot short circuit the search using the symbol list that is available at each node. +;; (define (encode-symbol s tree) +;; (define (bits result subtree) +;; (cond ((and (leaf? subtree) +;; (equal? s (car (symbol-set subtree)))) +;; result) +;; ((leaf? subtree) '()) +;; (else +;; (let ((left (bits +;; (cons 0 result) +;; (left-branch subtree)))) +;; (if (null? left) +;; (bits (cons 1 result) (right-branch subtree)) +;; left))))) +;; (reverse (bits '() tree))) + (define (encode-symbol s tree) - (define (bits result subtree) - (cond ((and (leaf? subtree) - (equal? s (car (symbol-set subtree)))) - result) - ((leaf? subtree) '()) - (else - (let ((left (bits - (cons 0 result) - (left-branch subtree)))) - (if (null? left) - (bits (cons 1 result) (right-branch subtree)) - left))))) - (reverse (bits '() tree))) + (cond ((leaf? tree) '()) + ((list-lookup s (symbol-set (left-branch tree))) + (cons 0 (encode-symbol s (left-branch tree)))) + ((list-lookup s (symbol-set (right-branch tree))) + (cons 1 (encode-symbol s (right-branch tree)))) + (else (error "Symbol not in tree -- ENCODE-SYMBOL" s tree)))) (encode (decode sample-message sample-tree) sample-tree) +(encode '(E) sample-tree) + +;; 69 +(define (generate-huffman-tree pairs) + (successive-merge (make-leaf-set pairs))) + +(define (successive-merge weighted-leafs) + (define (merge lightest leafs) + (if (null? leafs) + lightest + (let ((leafs-with-node + (adjoin-set (make-code-tree + lightest + (car leafs)) + (cdr leafs)))) + (merge (car leafs-with-node) + (cdr leafs-with-node))))) + (merge (car weighted-leafs) + (cdr weighted-leafs))) +(generate-huffman-tree '((A 4) (B 2) (C 1) (D 1))) + +;; 70 +(define rock-songs-leafs '((A 2) (BOOM 1) + (GET 2) (JOB 2) + (NA 16) (SHA 3) + (YIP 9) (WAH 1))) +(define rock-songs-tree + (generate-huffman-tree rock-songs-leafs)) + +(define rock-songs-bits + (encode '(GET A JOB + SHA NA NA NA NA NA NA NA NA + GET A JOB + SHA NA NA NA NA NA NA NA NA + WAH YIP YIP YIP YIP YIP YIP YIP YIP YIP + SHA BOOM) + rock-songs-tree)) +;; variable length codes with huffman tree +(length rock-songs-bits) +;; fixed length codes with 8 symbols +(expt 2 (length rock-songs-leafs)) + +;; 71 +;; Most frequent is always a leaf from the root, so only one bit +;; Least frequent requires d bits where d is the depth of the tree, +;; in this case the tree is unbalanced so the depth is linear or n-1. +;; (= (+ 2**(i-2) 2**(i-1)) (- 2**i 1)) + +;; 72 +;; You can do best worst case scenario's for searches and positions in the tree +;; and you can argue average time complexities for different known weight distributions that result in balanced or unbalanced trees. +;; I did them on paper and I'm a messy louise reasoner. +;; Maybe I'll come back someday and write it up. |