sicp-ex-2.69



<< Previous exercise (2.68) | Index | Next exercise (2.70) >>


Exercise 2.69: The following procedure takes as its argument a list of symbol-frequency pairs (where no symbol appears in more than one pair) and generates a Huffman encoding tree according to the Huffman algorithm.

  
 (define (generate-huffman-tree pairs) 
    (successive-merge (make-leaf-set pairs))) 
  

`make-leaf-set` is the procedure given above that transforms the list of pairs into an ordered set of leaves. `successive-merge` is the procedure you must write, using `make-codetree` to successively merge the smallest-weight elements of the set until there is only one element left, which is the desired Huffman tree. (This procedure is slightly tricky, but not really complicated. If you find yourself designing a complex procedure, then you are almost certainly doing something wrong. You can take significant advantage of the fact that we are using an ordered set representation.)


bro_chenzox

There is a little modification to adjoin-set for result that makes from a pair set

 '((A 4) (B 2) (C 1) (D 1)) 

the following Huffman's tree

'((leaf A 4) ((leaf B 2) ((leaf D 1) (leaf C 1) (D C) 2) (B D C) 4) (A B D C) 8) :
(define (adjoin-set x set)
   (cond ((null? set) (list x))
        ((> (weight x) (weight (car set))) (cons (car set)
                    (adjoin-set x (cdr set))))
          (else (cons x set))))

"This procedure is slightly tricky, but not really complicated. If you find yourself designing a complex procedure, then you are almost certainly doing something wrong." This is not our case, right? (I use embedded foldl instead of accumulate) :

(define (successive-merge set)
  (foldl make-code-tree (car set) (cdr set)))


jirf

I used the same strategy as chessweb. The text said "Successive-merge is the procedure you must write, using make-code-tree to successively merge the smallest-weight elements".

Although we can expect the initial input to be ordered, After merging the first code-tree that is no longer guaranteed. For example

(4 5 6 7 8 8.5) -merge-> (9 6 7 8 8.5)
-merge-> (15 7 8 8.5) ...

Easiest way I could think of successively merging the smallest elements was to order the set before each successive-merge, which can be done in O(n) time because the (intersection tree-set (make-set newly-created-tree)) is ordered.

Solution

  
 (define (generate-huffman-tree pairs) 
   (define (order-tree-set tree tree-set) 
     (cond ((null? tree-set) (list tree)) 
           ((>= (weight (car tree-set)) (weight tree)) 
            (cons tree tree-set)) 
           ((< (weight (car tree-set)) (weight tree)) 
            (cons (car tree-set) 
                  (order-tree-set tree (cdr tree-set)))))) 
   (define (successive-merge leaf-set) 
     (cond ((null? leaf-set) nil) 
           ((null? (cdr leaf-set)) (car leaf-set)) 
           (else 
            (let ((new-tree (make-code-tree (cadr leaf-set) 
                                            (car leaf-set)))) 
              (successive-merge (order-tree-set new-tree 
                                                (cddr leaf-set))))))) 
   (successive-merge (make-leaf-set pairs))) 
  
  

 (define (successive-merge trees) 
   (let ((lightest-tree (car trees)) (heavier-trees (cdr trees))) 
     (if (null? heavier-trees) 
         lightest-tree 
         (successive-merge (adjoin-set (make-code-tree lightest-tree (car heavier-trees)) 
                                       (cdr heavier-trees)))))) 

brave one

@tyler's answer has too much abstraction sorry: `first-in-ordered-set`, `second-in-ordered-set`, `subset`.

since set operations are just inner workings of our program, it's perfectly fine (and i believe intended) to use direct list access operations here. abstraction is not a law, but rather guideline.


tyler

Chris's answer is correct, succinct, clear, but stylistically poor. Ordered sets may be implemented as lists, but abstraction dictates that we should never use list operators on them directly! By using a few name changes and methods we can respect the abstraction and remind ourselves what the objects actually are. I changed the code from Racket to Scheme for posting it here, sorry if there is some Racket remains in it.

  
 (define (successive-merge tree-ordered-set) 
   (if (= (size-of-set tree-ordered-set) 1) 
       (first-in-ordered-set leaf-set) 
       (let ((first (first-in-ordered-set tree-ordered-set)) 
             (second (second-in-ordered-set tree-ordered-set)) 
             (rest (subset tree-ordered-set 2))) 
         (successive-merge (adjoin-set (make-code-tree first second) 
                                       rest))))) 
  
 (define size-of-set length) 
 (define first-in-ordered-set car) 
 (define second-in-ordered-set cadr) 
 (define (subset set n) 
     (if (= n 0) 
         set  
         (subset (cdr set) (- n 1)))) 

chris

vlad's answer is not correct!

Try this case:

  
 (define test-tree (generate-huffman-tree '((A 3) (B 5) (C 6) (D 6)))) 
  
 (encode '(A B C D) test-tree) 
  

vlad's solution gets (1 1 1 1 1 0 0 1 0) while the shortest is just eight bits.

This is my solution. It's similar to frandibar's solution but I think there're some flaws in that solution.

  
 (define (successive-merge leaf-set) 
   (if (= (length leaf-set) 1) 
       (car leaf-set) 
       (let ((first (car leaf-set)) 
             (second (cadr leaf-set)) 
             (rest (cddr leaf-set))) 
         (successive-merge (adjoin-set (make-code-tree first second) 
                                       rest))))) 
  

With the same test case, it gets (0 0 0 1 1 1 1 0).


frandibar

I guess this works...

  
 (define (successive-merge leaf-set) 
     (if (<= (length leaf-set) 1) 
         leaf-set 
         (let ([left (car leaf-set)] 
               [right (cadr leaf-set)]) 
             (successive-merge (adjoin-set (make-code-tree left right) (cddr leaf-set)))))) 

vlad

Seems like the best solution is iterative ? Anyhow here is mine :

  
 (define (generate-huffman-tree pairs) 
   (successive-merge (make-leaf-set pairs))) 
  
 (define (successive-merge leaf-list) 
   (define (successive-it ll tree) 
     (if (null? ll) tree 
         (successive-it (cdr ll) (make-code-tree (car ll) tree)))) 
   (successive-it (cdr leaf-list) (car leaf-list))) 
  

anonymous

Both frandibar's and vlad's solutions are incorrect. The problem with frandibar's solution is that when the length of leaf-set is 1, it returns leaf-set. The correct solution returns (car leaf-set).

The correct solution can be more simply written as:

  
 (define (successive-merge leaves) 
   (if (null? (cdr leaves)) 
       (car leaves) 
       (successive-merge 
        (adjoin-set (make-code-tree (car leaves) (cadr leaves)) 
                    (cddr leaves))))) 
  

ZelphirKaltstahl

I build on the knowledge form some of the provided solutions here and came up with the following one. Not much different from others, only using a let* to assign names to some in between results.

  
 (define (successive-merge ordered-nodes-set) 
   (cond 
     ;; For an empty set of nodes, we return the empty set. 
     [(null? ordered-nodes-set) nil] 
     ;; If there are less than 2 (1) elements in the set of nodes to merge, we are done. 
     [(< (length ordered-nodes-set) 2) (car ordered-nodes-set)] 
     ;; Otherwise merge the first two elements into a subtree, since they are the ones with lowest weight. 
     [else 
      (let* 
        ([new-node (combine-subtrees (car ordered-nodes-set) 
                                     (cadr ordered-nodes-set))] 
         [updated-ordered-nodes-set (adjoin-set new-node 
                                                (cddr ordered-nodes-set))]) 
        (successive-merge updated-ordered-nodes-set))])) 

GPE

My solution

  
 (define (successive-merge leafset) 
   (if (null? (cddr leafset)) 
         leafset 
         (successive-merge (cons (make-code-tree (car leafset) (cadr leafset)) (cddr leafset))))) 
  

zenAndroid

Am i missing something here?

My solution is this ...

 (define (generate-huffman-tree pairs) 
   (define (succ-merge leafs) 
     (cond ((null? leafs) (error "No leafs?")) 
           (else (foldl make-hufftree (car leafs) (cdr leafs))))) 
   (succ-merge (make-leaf-set pairs))) 
 (generate-huffman-tree '((a 7) (b 8) (g 2) (t 6))) 
 ((leaf b 8) 
  ((leaf a 7) ((leaf t 6) (leaf g 2) (t g) 8) (a t g) 15) 
  (b a t g) 
  23) 
 > (generate-huffman-tree '((a 7))) 
 (leaf a 7) 
 > (generate-huffman-tree '()) 
 <error symbols in racket> No leafs? 

The most likely scenario is that i've missed something ??? but i dont know what ???


chessweb

This solution is inspired by the example on page 222 of the book. It has been tested with the following three examples as well as with excercise 2.70:

  
 ((C 1) (D 1)) 
 ((A 4) (B 2) (C 1) (D 1)) 
 ((A 8) (B 3) (C 1) (D 1) (E 1) (F 1) (G 1) (H 1)) 
  
 (define (successive-merge leaf-set) 
   ; inserts tree into tree-set such that the result remains 
   ; ordered with respect to the weights  
   (define (insert tree tree-set) 
     (cond 
       ((null? tree-set) (list tree)) 
       ((< (weight tree) (weight (car tree-set))) (cons tree tree-set)) 
       (else (cons (car tree-set) (insert tree (cdr tree-set)))))) 
   (cond 
     ((null? (cdr leaf-set)) (car leaf-set)) 
     (else (successive-merge (insert (make-code-tree (car leaf-set) (cadr leaf-set)) 
                                     (cddr leaf-set)))))) 
  

newone

The procedure `make-leaf-set` gives a leaf set as an ordered list and `adjoin-set` keeps this order untouched. In each expansion step, I just merge the first two leaves of the leaf set and insert the new node back to the set.

  
 (define (generate-huffman-tree pairs) 
   (successive-merge (make-leaf-set pairs))) 
  
 (define (successive-merge leafs) 
   (cond ((null? leafs) '()) ; no leaf 
         ((null? (cdr leafs)) (car leafs)) ; just one leaf 
         (else ; two leaves or more 
           (successive-merge (cddr 
                               (adjoin-set 
                                 (make-code-tree (car leafs) (cadr leafs)) 
                                 leafs))))))