#lang racket/load (define (element-of-set? x set) (cond ((null? set) #f) ((equal? x (car set)) #t) (else (element-of-set? x (cdr set))))) (define (adjoin-set x set) (cond ((element-of-set? x set) set) (else (cons x set)))) (define (intersection-set set1 set2) (cond ((or (null? set1) (null set2)) '()) ((element-of-set? (car set1) set2) (cons (car set1) (intersection-set (cdr set1) set2))) (else (intersection-set (cdr set1) set2)))) ;;; huffman tree (define (make-leaf symbol weight) (list 'leaf symbol weight)) (define (leaf? node) (eq? (car node) 'leaf)) (define (symbol-leaf node) (car (cdr node))) (define (weight-leaf node) (car (cdr (cdr node)))) (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) (car (cdr tree))) (define (symbols tree) (if (leaf? tree) (list (symbol-leaf tree)) (car (cdr (cdr tree))))) (define (weight tree) (if (leaf? tree) (weight-leaf tree) (car (cdr (cdr (cdr tree)))))) ;; decoding (define (decode bits tree) (define (decode-1 bits current-branch) (if (null? bits) '() (let ((next-branch (choose-branch (car bits) tree))) (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 tree) (cond ((= bit 0) (left-branch tree)) ((= bit 1) (right-branch tree)) (else (error "bad bit -- choose-branch" bit)))) ;; sets of weighted elements ;; arrange items in the increasing order of weight (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)))))) ;; (provide element-of-set? adjoin-set intersection-set)