#Lang Racket (define (length items) (if(NULL? items)0 (+ 1(Length (cdr items)))) (Define (element- of-set? x set) (Cond (NULL? Setfalse) ((Equal X (car set) )true) (Else(element- of-set x (cdr set)))) (Define (make-leaf symbol weight) (list'leaf symbol weight))(define (leaf)?Object) (eq?) (CarObject)'leaf))( define (Symbol-leaf x) (Cadr x)) (define (Weight-leaf x) (Caddr x)) (define (Make-code-tree left right) (list left Right (append (symbols left) (symbols right)) (+ (weight left) (weight right))) (Define (Left-branch tre e) (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)) (Define (decode bits tree) (Define (decode-1bits 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-1bits tree)) (Define (Choose-branch bit branch) (Cond (= bit0) ( left-branch Branch)) ((= Bit1) (Right-branch Branch)) (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))))) (Define (Encode message tree) (if(NULL? message)'()(Append (encode-symbol (car message) tree) (Encode (CDR message) tree)))) (Define (Encode-symbol symbol tree) (if(element- of-set symbol (symbols tree)) (if(leaf tree)'()( Let(Left-tree (Left-branch tree)) ( right-tree (right-branch tree )) (if(or(NULL? Left-tree) (Not (element- of-set symbol (symbols left-tree)))) (Cons1(Encode-symbol symbol Right-tree)) (Cons0(Encode-symbol symbol Left-tree)))) (Error"symbol does not exist--Encode-symbol"symbol))) (Define (Generate-huffman-tree pairs) (Successive-merge (Make-leaf-set pairs))) (Define (Successive-merge set) (Cond (NULL? Set'())((=1(length set)) (car set)) (Else( Successive-merge (Adjoin-set (Make-code-tree (car set) (Cadr set)) (Cddr SE T)))) (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 ))))(Encode'(a D a b b C A) sample-tree)(Define Sample-message'(0 1 1 0 0 1 0 1 0 1 1 1 0))( decode Sample-message sample-tree) (define Hip-tree (Generate-huffman-tree'( (a 2) (Boom 1) (Get 2) (Job 2) (NA) (Sha 3) (Yip 9) (Wah 1 )))(display Hip-tree) (define Hip-message'(Get a jobSha Na na na na na na na na Get a job Sha na na na na na na na na Wah Yip Yip Yip Yip Yip Yip Yip Yip Yi P Sha Boom) (Length (Encode hip-message hip-tree ))
[Implementation of Sicp]huffman encoding @ Scheme