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


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.

 (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) 
 (define size-of-set length) 
 (define first-in-ordered-set car) 
 (define second-in-ordered-set cadr) 
 (define (subset set n) 
     (if (= n 0) 
         (subset (cdr set) (- n 1)))) 

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) 

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

I guess this works...

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

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))) 

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) 
        (adjoin-set (make-code-tree (car leaves) (cadr leaves)) 
                    (cddr leaves)))))