标签:
#lang racket (define (length items) (if (null? items) 0 (+ 1 (length (cdr items))))) (define (element-of-set? x set) (cond ((null? set) false) ((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? (car object) ‘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) (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-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 branch) (cond ((= bit 0) (left-branch branch)) ((= bit 1) (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)))) (cons 1 (encode-symbol symbol right-tree)) (cons 0 (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 set)))))) (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 16) (Sha 3) (yip 9) (Wah 1)))) (display hip-tree) (define hip-message ‘(Get a job Sha 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 yip Sha boom)) (length (encode hip-message hip-tree))
标签:
原文地址:http://www.cnblogs.com/zuoyuan/p/4745764.html