SICP 2.3.4 Huffman Coding Exercises
#lang racket | |
;; From SICP 2.3.4 | |
;; Leaf defintions | |
(define (make-leaf symbol weight) | |
(list 'leaf symbol weight)) | |
(define (leaf? object) | |
(eq? (car object) 'leaf)) | |
(define (leaf-symbol x) (cadr x)) | |
(define (leaf-weight x) (caddr x)) | |
(define (make-code-tree left right) | |
(list left | |
right | |
(append (symbols left) (symbols right)) | |
(+ (weight left) (weight right)))) | |
(define (left-branch tree) (car tree)) | |
(define (right-branch tree) (cadr tree)) | |
;; Generic method for getting the list of symbols | |
;; at a given tree or leaf. | |
(define (symbols tree) | |
(if (leaf? tree) | |
(list (leaf-symbol tree)) | |
(caddr tree))) | |
;; Generic method for getting a weight for a tree | |
;; node or leaf. | |
(define (weight tree) | |
(if (leaf? tree) | |
(leaf-weight tree) | |
(cadddr tree))) | |
;; Given a bitstring and a huffman tree | |
;; traverse the tree to decode the characters | |
;; from the bitstring and return the decoded result. | |
(define (decode bits tree) | |
(define (decode-1 bits current-branch) | |
(if (empty? bits) | |
empty | |
(let ([next-branch | |
(choose-branch (car bits) current-branch)]) | |
(if (leaf? next-branch) | |
(cons (leaf-symbol next-branch) | |
(decode-1 (cdr bits) tree)) | |
(decode-1 (cdr bits) next-branch))))) | |
(decode-1 bits tree)) | |
(define (choose-branch bit tree) | |
(cond [(= bit 0) (left-branch tree)] | |
[(= bit 1) (right-branch tree)] | |
[else (error "Bit must be one or zero: choose-branch" bit)])) | |
;; Adds an item to an ordered set | |
;; NOTE: Could probably optimize this to return early if x | |
;; is found in the set. | |
(define (adjoin-set x set) | |
(cond [(null? set) (list x)] | |
[(< (weight x) (weight (car set))) (cons x set)] | |
[else (cons (car set) | |
(adjoin-set x (cdr set)))])) | |
(define (element-of-set? x set) | |
(cond [(empty? set) false] | |
[(eq? x (car set)) true] | |
[else (element-of-set? x (cdr set))])) | |
;; Given a list of lists, return an ordered set of leaf | |
;; objects. | |
(define (make-leaf-set pairs) | |
(if (empty? pairs) | |
empty | |
(let ([pair (car pairs)]) | |
(adjoin-set (make-leaf (car pair) | |
(cadr pair)) | |
(make-leaf-set (cdr pairs)))))) | |
(define (encode message tree) | |
(if (empty? message) | |
empty | |
(append (encode-symbol (car message) tree) | |
(encode (cdr message) tree)))) | |
;; Given a letter, return a bitstring from the huffman encoding tree | |
;; Should error if the symbol doesn't exist in the tree | |
;; | |
;; If the symbol is in the symbols of the left branch (cons 0 (encode-symbol letter (left-branch tree)) | |
(define (encode-symbol letter tree) | |
(if (leaf? tree) | |
empty | |
(let ([left (left-branch tree)] | |
[right (right-branch tree)]) | |
(cond [(element-of-set? letter (symbols left)) | |
(cons 0 (encode-symbol letter left))] | |
[(element-of-set? letter (symbols right)) | |
(cons 1 (encode-symbol letter right))] | |
[else (error "letter does not exist in tree")])))) | |
(define (generate-huffman-tree pairs) | |
(successive-merge (make-leaf-set pairs))) | |
;; Find the two smallest weight things and replace them with a merged version | |
;; of the two leafs | |
(define (successive-merge leaf-set) | |
(if (empty? (cdr leaf-set)) | |
(car leaf-set) | |
(successive-merge | |
(adjoin-set (make-code-tree (car leaf-set) | |
(cadr leaf-set)) | |
(cddr leaf-set))))) | |
;; 2.70 | |
(define song-alphabet '((A 2) (BOOM 1) (GET 2) (JOB 2) (NA 16) (SHA 3) (YIP 9) (WAH 1))) | |
(define song-tree (generate-huffman-tree song-alphabet)) | |
(define song '(GET A JOB SHA 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)) | |
(define encoded-song (encode song song-tree)) | |
(decode encoded-song song-tree) | |
;; Bonus | |
;; Get frequency distribution | |
;; Make something that takes the text and turns it into a symbol list | |
;; trim out non alphabet characters | |
(define allstar-alphabet | |
'((A 114) (B 22) (C 29) (D 67) (E 175) (F 22) (G 74) (H 84) (I 83) (J 1) (K 21) (L 93) (M 38) (N 108) (O 163) (P 20) (R 91) (S 103) (T 165) (U 58) (V 7) (W 40) (Y 61))) | |
(define allstar-string "SOMEBODYONCETOLDMETHEWORLDISGONNAROLLMEIAINTTHESHARPESTTOOLINTHESHEDSHEWASLOOKINGKINDOFDUMBWITHHERFINGERANDHERTHUMBINTHESHAPEOFANLONHERFOREHEADWELLTHEYEARSSTARTCOMINGANDTHEYDONTSTOPCOMINGFEDTOTHERULESANDIHITTHEGROUNDRUNNINGDIDNTMAKESENSENOTTOLIVEFORFUNYOURBRAINGETSSMARTBUTYOURHEADGETSDUMBSOMUCHTODOSOMUCHTOSEESOWHATSWRONGWITHTAKINGTHEBACKSTREETSYOULLNEVERKNOWIFYOUDONTGOYOULLNEVERSHINEIFYOUDONTGLOWHEYNOWYOUREANALLSTARGETYOURGAMEONGOPLAYHEYNOWYOUREAROCKSTARGETTHESHOWONGETPAIDANDALLTHATGLITTERSISGOLDONLYSHOOTINGSTARSBREAKTHEMOLDITSACOOLPLACEANDTHEYSAYITGETSCOLDERYOUREBUNDLEDUPNOWWAITTILLYOUGETOLDERBUTTHEMETEORMENBEGTODIFFERJUDGINGBYTHEHOLEINTHESATELLITEPICTURETHEICEWESKATEISGETTINGPRETTYTHINTHEWATERSGETTINGWARMSOYOUMIGHTASWELLSWIMMYWORLDSONFIREHOWABOUTYOURSTHATSTHEWAYILIKEITANDINEVERGETBOREDHEYNOWYOUREANALLSTARGETYOURGAMEONGOPLAYHEYNOWYOUREAROCKSTARGETTHESHOWONGETPAIDALLTHATGLITTERSISGOLDONLYSHOOTINGSTARSBREAKTHEMOLDHEYNOWYOUREANALLSTARGETYOURGAMEONGOPLAYHEYNOWYOUREAROCKSTARGETTHESHOWONGETPAIDANDALLTHATGLITTERSISGOLDONLYSHOOTINGSTARSSOMEBODYONCEASKEDCOULDISPARESOMECHANGEFORGASINEEDTOGETMYSELFAWAYFROMTHISPLACEISAIDYEPWHATACONCEPTICOULDUSEALITTLEFUELMYSELFANDWECOULDALLUSEALITTLECHANGEWELLTHEYEARSSTARTCOMINGANDTHEYDONTSTOPCOMINGFEDTOTHERULESANDIHITTHEGROUNDRUNNINGDIDNTMAKESENSENOTTOLIVEFORFUNYOURBRAINGETSSMARTBUTYOURHEADGETSDUMBSOMUCHTODOSOMUCHTOSEESOWHATSWRONGWITHTAKINGTHEBACKSTREETSYOULLNEVERKNOWIFYOUDONTGOGOYOULLNEVERSHINEIFYOUDONTGLOWHEYNOWYOUREANALLSTARGETYOURGAMEONGOPLAYHEYNOWYOUREAROCKSTARGETTHESHOWONGETPAIDANDALLTHATGLITTERSISGOLDONLYSHOOTINGSTARSBREAKTHEMOLDANDALLTHATGLITTERSISGOLDONLYSHOOTINGSTARSBREAKTHEMOLD") | |
(define allstar-song | |
(map string->symbol | |
(filter (λ (character) (not (string=? "" character))) | |
(string-split allstar-string "")))) | |
(define allstar-tree (generate-huffman-tree allstar-alphabet)) | |
(length (encode allstar-song allstar-tree)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment