From: Ramakrishnan Muthukrishnan <vu3rdd@gmail.com>
Date: Wed, 15 Sep 2010 18:21:48 +0000 (+0530)
Subject: huffman tree examples
X-Git-Url: https://git.rkrishnan.org/pf/content/en/seg/priv/install.html?a=commitdiff_plain;h=1dc43c5987da3169bce59bd422ab5be041a03d0a;p=sicp.git

huffman tree examples
---

diff --git a/src/sicp/ch2_3.rkt b/src/sicp/ch2_3.rkt
new file mode 100644
index 0000000..4515758
--- /dev/null
+++ b/src/sicp/ch2_3.rkt
@@ -0,0 +1,73 @@
+#lang racket
+
+;; leaf nodes
+(define (make-leaf leaf weight)
+  (list 'leaf leaf weight))
+
+(define (leaf? object)
+  (eq? (car object) 'leaf))
+
+(define (symbol-leaf object)
+  (cadr object))
+
+(define (weight-leaf object)
+  (caddr object))
+
+;;;; constructors and selectors
+
+;; tree node consists of a list which has left branch, right branch
+;; set of symbols in left and right and total weight
+(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 (right-branch tree) (cadr tree))
+
+(define (symbols tree)
+  (if (leaf? tree)
+      (list (symbol-leaf tree))
+      (caddr tree)))
+
+(define (weight tree)
+  (if (leaf? tree)
+      (weight-leaf tree)
+      (cadddr tree)))
+
+;; now decoding
+(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 tree)
+  (cond [(= bit 0) (left-branch tree)]
+        [(= bit 1) (right-branch tree)]
+        [else (error "Bad bit -- CHOOSE-BRANCH" bit)]))
+
+(define (adjoin-set x set)
+  (cond [(null? set) (list x)]
+        [(< (weight x) (weight (car set))) (cons x set)]
+        [else (cons (car set)
+                    (adjoin-set x (cdr set)))]))
+
+(define (make-leaf-set pairs)
+  (if (null? pairs)
+      '()
+      (let ([pair (car pairs)])
+        (adjoin-set (make-leaf (car pair)
+                               (cadr pair))
+                    (make-leaf-set (cdr pairs))))))
+
+(provide make-code-tree make-leaf decode leaf? symbol-leaf left-branch right-branch symbols)
\ No newline at end of file