#lang scheme
( define nil '() )
( define ( make-leaf symbol weight )
( list 'leaf symbol weight ) )
( define ( leaf?
obj )
( eq?
( car obj ) '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 tree )
( car tree ) )
( define ( right-branch tree )
( cadr tree ) )
( define ( symbols tree )
( cond [ ( leaf? tree )
( list ( symbol-leaf tree ) ) ]
[ else ( caddr tree ) ] ) )
( define ( weight tree )
( cond [ ( leaf?
tree )
( weight-leaf tree ) ]
[ else ( cadddr tree ) ] ) )
( define ( decode bits tree )
( define ( decode-1 bits cur-branch )
( cond [ ( null?
bits ) nil ]
[ else ( let ( [ next-branch
( choose-branch ( car bits ) cur-branch ) ] )
( cond [ ( 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 "Pass" ) ] ) )
( 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 ) )
( decode sample-message sample-tree )