sicp-ex-2.69

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

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

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

Perhaps Corrent Answer~~~

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

  
 (define (successive-merge llst) 
   (cond ((<= (length llst) 1) (car llst)) 
         (else 
          (successive-merge 
           (debug-set-sort  ;debug-S  
            (set-sort 
             (cons (make-code-tree (car llst) 
                                   (cadr llst)) 
                   (cddr llst))) 
            'nodebug) ;debug-E 'debug  
           )))) 

It's Important!!!! Sort!!!

1. '(1 1 3 7 10) -> (2 3 7 10) -> (5 7 10) -> (12 10) -sort-> (10 12) -> (22)

2. '(2 3 4 4 8 10) -> (5 4 4 8 10) -sort-> (4 4 5 8 10) -> (8 5 8 10) -sort-> (5 8 8 10) -> (13 8 10) -sort-> (8 10 13) -> (18 13) -sort-> (13 18) ->(31)

  
 (define (set-sort llst) 
   (cond ((null? llst) '()) 
         (else 
          (adjoin-set (car llst) 
                      (set-sort (cdr llst)))))) 

  
 (define (debug-set-sort prog switch) 
   (if (eq? switch 'debug) 
       (displayln prog) 
       (void)) 
   prog)