sicp-ex-2.70

  
 (define rock-lyrics 
   '((A 2) 
     (BOOM 1) 
     (GET 2) 
     (JOB 2) 
     (NA 16) 
     (SHA 3) 
     (YIP 9) 
     (WAH 1))) 
 (define rock-tree 
   (generate-huffman-tree rock-lyrics)) 
  
 (define song 
   '(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)) 
  
  
 ;; convenience func I wrote for printing a series of labeled messages         
 (display-block (cons "huffman-encoding length" 
                      (length (encode song rock-tree))) 
                (cons "min fixed-length encoding length" 
                      (* (log (length rock-lyrics) 2) (length song)))) 
  
  
  

ANSWER

huffman-encoding length
--------
84

min fixed-length encoding length
--------
108.0

My code gives:

 (define rocktree (generate-huffman-tree '((A 2) (NA 16) (BOOM  1) (SHA 3) (GET 2) (YIP 9) (JOB 2) (WAH 1)))) 
  
 rocktree 
  
 ((leaf na 16) ((leaf yip 9) (((leaf a 2) ((leaf wah 1) (leaf boom 1) (wah boom) 2) (a wah boom) 4) ((leaf sha 3) ((leaf job 2) (leaf get 2) (job get) 4) (sha job get) 7) (a wah boom sha job get) 11) (yip a wah boom sha job get) 20) (na yip a wah boom sha job get) 36) 

We can then encode the song:

 (define rock-song '(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)) 
  
 (define encoded-rock-song (encode rock-song rocktree)) 
  
 encoded-rock-song 
  
 (1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 0 1 1 1 1 0 1 1 1 0 0 0 0 0 0 0 0 0 1 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 1 1 0 1 1 0 1 1) 

And compare the length of the encoded message vs. its fixed-length version:

 (length encoded-rock-song) 
 84 
  
 ; If we were to use a fixed-length encoding on that rock song, we would need 3 bits (8 = 2^3) per symbol, i.e.: 
 (* 3 (length rock-song)) 
 108 

A 22% gain in size seems to be coherent.

The book ignores newline characters printed in the text. I decided that they also should be encoded and came up with this:

 (let* 
   ([message 
      (string-replace 
        (string-append 
          "Get a job\n" 
          "Sha na na na na na na na na\n" 
          "Get a job\n" 
          "Sha na na na na na na na na\n" 
          "Wah yip yip yip yip yip yip yip yip yip\n" 
          "Sha boom") "\n" " \n ")] 
     [symbols-message (map string->symbol (string-split (string-upcase message) " "))] 
     ;; this list of count pairs would have to be calculated by the programm actually ... 
     [huffman-tree (generate-huffman-tree (list 
                                            (cons 'BOOM 1) 
                                            (cons 'WAH 1) 
                                            (cons 'A 2) 
                                            (cons 'GET 2) 
                                            (cons 'JOB 2) 
                                            (cons 'SHA 3) 
                                            (cons (string->symbol "\n") 5) 
                                            (cons 'YIP 9) 
                                            (cons 'NA 16)))]) 
   (display huffman-tree) (newline) 
   (display (encode symbols-message huffman-tree)) (newline) 
   (display (length (encode symbols-message huffman-tree))) (newline))