You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('') and can be up to 35 characters long.
84 lines
2.4 KiB
84 lines
2.4 KiB
(load "displaylib.scm")


(title "Exercise 2.67")


(print "


Define an encoding tree and a sample message:




(define sampletree


(makecodetree (makeleaf 'A 4)


(makecodetree


(makeleaf 'B 2)


(makecodetree (makeleaf 'D 1)


(makeleaf 'C 1)))))




(define samplemessage '(0 1 1 0 0 1 0 1 0 1 1 1 0))




Use the decode procedure to decode the message, and give the result.


")




; Leaf representation


(define (makeleaf symbol weight)


(list 'leaf symbol weight))


(define (leaf? object)


(eq? (car object) 'leaf))


(define (symbolleaf x) (cadr x))


(define (weightleaf x) (caddr x))




(define (makecodetree left right)


(list left


right


(append (symbols left) (symbols right))


(+ (weight left) (weight right))))




(define (leftbranch tree) (car tree))


(define (rightbranch tree) (cadr tree))


(define (symbols tree)


(if (leaf? tree)


(list (symbolleaf tree))


(caddr tree)))


(define (weight tree)


(if (leaf? tree)


(weightleaf tree)


(cadddr tree)))


; Decoding procedure


(define (decode bits tree)


(define (decodel bits currentbranch)


(if (null? bits)


'()


(let ((nextbranch


(choosebranch (car bits) currentbranch)))


(if (leaf? nextbranch)


(cons (symbolleaf nextbranch)


(decodel (cdr bits) tree))


(decodel (cdr bits) nextbranch)))))


(decodel bits tree))




(define (choosebranch bit branch)


(cond ((= bit 0) (leftbranch branch))


((= bit 1) (rightbranch branch))


(else (error "bad bit  CHOOSEBRANCH" bit))))




(define (adjoinset x set)


(cond ((null? set) (list x))


((< (weight x) (weight (car set))) (cons x set))


(else (cons (car set)


(adjoinset x (cdr set))))))




(define (makeleafset pairs)


(if (null? pairs)


'()


(let ((pair (car pairs)))


(adjoinset (makeleaf (car pair)


(cadr pair))


(makeleafset (cdr pairs))))))






(define sampletree


(makecodetree (makeleaf 'A 4)


(makecodetree


(makeleaf 'B 2)


(makecodetree (makeleaf 'D 1)


(makeleaf 'C 1)))))




(define samplemessage '(0 1 1 0 0 1 0 1 0 1 1 1 0))




(display (decode samplemessage sampletree))


