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

本文转自mfrbuaa博客园博客，原文链接：http://www.cnblogs.com/mfrbuaa/p/5256645.html，如需转载请自行联系原作者