Encode-symbol for Huffman tree

From the text:

Exercise 2.68. The encode procedure takes as arguments a message and a tree and produces the list of bits that gives the encoded message.

(define (encode message tree)
(if (null? message)
'()
(append (encode-symbol (car message) tree)
(encode (cdr message) tree))))

Encode-symbol is a procedure, which you must write, that returns the list of bits that encodes a given symbol according to a given tree. You should design encode-symbol so that it signals an error if the symbol is not in the tree at all. Test your procedure by encoding the result you obtained in exercise 2.67 with the sample tree and seeing whether it is the same as the original sample message.

The textbook provides the following definitions:

(define (make-leaf symbol weight)
(list 'leaf symbol weight))
(define (leaf? object)
(eq? (car object) 'leaf))

(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 (symbols tree)
(if (leaf? tree)
(list (symbol-leaf tree))

(define (weight tree)
(if (leaf? tree)
(weight-leaf tree)

(define (decode bits tree)
(define (decode-1 bits current-branch)
(if (null? bits)
'()
(let ((next-branch
(choose-branch (car bits) current-branch)))
(if (leaf? next-branch)
(cons (symbol-leaf next-branch)
(decode-1 (cdr bits) tree))
(decode-1 (cdr bits) next-branch)))))
(decode-1 bits tree))
(define (choose-branch bit branch)
(cond ((= bit 0) (left-branch branch))
((= bit 1) (right-branch branch))
(else (error "bad bit -- CHOOSE-BRANCH" bit))))
(cond ((null? set) (list x))
((< (weight x) (weight (car set))) (cons x set))
(else (cons (car set)

(define (make-leaf-set pairs)
(if (null? pairs)
'()
(let ((pair (car pairs)))
(adjoin-set (make-leaf (car pair)    ; symbol
(make-leaf-set (cdr pairs))))))

(define sample-tree
(make-code-tree (make-leaf 'A 4)
(make-code-tree
(make-leaf 'B 2)
(make-code-tree (make-leaf 'D 1)
(make-leaf 'C 1)))))

(define sample-message '(0 1 1 0 0 1 0 1 0 1 1 1 0))

(define (encode message tree)
(if (null? message)
'()
(append (encode-symbol (car message) tree)
(encode (cdr message) tree))))

And I wrote the following answer:

(define (member? x set)
(not (equal? (member x set) false)))

(define (encode-branch symbol tree)
(let ((left (left-branch tree))
(right (right-branch tree)))
(cond ((member? symbol (symbols left)) (list 0 left))
((member? symbol (symbols right)) (list 1 right))
(else (error "Symbol is not a member of either left or right branches of the tree - can't encode" symbol tree)))))

(define (encode-symbol symbol tree)
(if (leaf? tree) '()
(let ((new-branch (encode-branch symbol tree)))
(cons (car new-branch) (encode-symbol symbol (cadr new-branch))))))

How can I improve my solution?

Wouldn't it be easier to unpack the tree into a dictionary mapping each symbol to its corresponding bit string? Then you could simply look up each symbol in the input to generate the corresponding output bits.

EDIT: As suggested by syb0rg, here is an implementation (C#, I'm afraid -- my Lisp is far too rusty -- although it's almost pure). The part pertaining to my suggestion above lives in the HuffmanCodes function at the end.

void Main()
{
var corpus = @"Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat.";
var hcs = HuffmanCodes(corpus);
Console.WriteLine(hcs);
}

Dictionary<char, int> Histogram(string corpus) {
var hg = new Dictionary<char, int>();
foreach (var x in corpus) {
int f;
hg.TryGetValue(x, out f);
hg[x] = f + 1;
}
return hg;
}

class HuffTree {
internal char? Sym; // Non-null iff this is a leaf node with no children.
internal int Freq;
internal HuffTree L;
internal HuffTree R;
}

// Oh, for a priority queue.  This is *really* inefficient!
HuffTree HuffmanTree(string corpus) {
var hg = Histogram(corpus);
var hts = hg.Keys.Select(x => new HuffTree { Sym = x, Freq = hg[x] }).OrderBy(t => t.Freq).ToList();
while (2 <= hts.Count) {
var leasts = hts.Take(2).ToList();
var l = leasts;
var r = leasts;
var newHt = new HuffTree { Freq = l.Freq + r.Freq, L = l, R = r };
hts = hts.Skip(2).Concat(new HuffTree[] { newHt }).OrderBy(t => t.Freq).ToList();
}
return hts.First();
}

Dictionary<char, string> HuffmanCodes(string corpus) {
var codes = new Dictionary<char, string>();
Action<HuffTree, string> a = null; // Sweet recursion.
a = (ht, code) => {
if (ht.Sym != null) {
codes[(char)ht.Sym] = code;
} else {
a(ht.L, code + "0");
a(ht.R, code + "1");
}
};
a(HuffmanTree(corpus), "");
return codes;
}
• You should show the OP how to do that, and not just tell him an arbitrary way of how to do it. This is how people learn. Feb 4 '14 at 2:36
• @syb0rg, I thought my answer had an obvious implementation. Since the original poster didn't ask for one, maybe he did, too. I can add some code if you'd like to see it.
– Rafe
Feb 4 '14 at 2:47
• @Rafe I get the obvious implementation. but implementing in a functional way requires more... Jul 24 '19 at 0:44
• @fjch1997 I'm not clear I understand your point. Are you saying that a purely functional implementation would do things differently? If so I agree, in that one would use somewhat different data structures; the algorithm would remain the same.
– Rafe
Jul 24 '19 at 6:54
• @fjch1997 There's an easy way to transform immediate tail recursive functions like that. That is, (functional) f(x) = if p(x) then g(x) else f(h(x)) is equivalent to (imperative) f(x) { while (!p(x)) x = h(x); return g(x); }.
– Rafe
Jul 25 '19 at 1:48

For the best performance, a Hashmap (or Dictoinary) data stucture must be used. However, scheme itself does not define such type so I opted for simply traversing the Huffman tree for simpler code.

(define (left-branch tree) (car tree))

(define (encode message tree)
(if (null? message)
'()
(append (encode-symbol (car message) tree)
(encode (cdr message) tree))))

(define (encode-symbol-helper symbol tree current-code)
(if (leaf? tree)
(if (equal? symbol (cadr tree)) current-code null)
(let ((left-result (encode-symbol-helper symbol (left-branch tree) (append current-code '(0))))
(right-result (encode-symbol-helper symbol (right-branch tree) (append current-code '(1)))))
(if (not (null? left-result)) left-result right-result)
)))

(define (encode-symbol symbol tree) (encode-symbol-helper symbol tree null))

• I see one piece of proposed code. What insight does your answer provide about the code presented in the question? Jul 24 '19 at 2:51
• @greybeard feel free to improve my answer Jul 24 '19 at 3:13