<< Previous exercise (2.67) | Index | Next exercise (2.69) >>
(define (encode message tree) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) (define (encode-symbol sym tree) (if (leaf? tree) (if (eq? sym (symbol-leaf tree)) '() (error "missing symbol: ENCODE-SYMBOL" sym)) (let ((left (left-branch tree))) (if (memq sym (symbols left)) (cons 0 (encode-symbol sym left)) (cons 1 (encode-symbol sym (right-branch tree)))))))
I think my solution is clean.
(define (encode message tree) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) (define (element-of-set? x set) (cond ((null? set) false) ((equal? x (car set)) true) (else (element-of-set? x (cdr set))))) (define (encode-symbol symbol tree) (define (search symbol tree) (cond ((leaf? tree) '()) ((element-of-set? symbol (symbols (left-branch tree))) (cons 0 (encode-symbol symbol (left-branch tree)))) (else (cons 1 (encode-symbol symbol (right-branch tree)))))) (if (element-of-set? symbol (symbols tree)) (search symbol tree) (error "try to encode NO exist symbol -- ENCODE-SYMBOL" symbol)))
;; ----------------------------------------------- ;; EXERCISE 2.68 ;; ----------------------------------------------- ;; helpers (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 (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-leaf x) (caddr x)) (define (make-code-tree left right) (list left right (append (symbols left) (symbols right)) (+ (weight left) (weight right)))) (define (weight tree) (if (leaf? tree) (weight-leaf tree) (cadddr tree))) (define (encode message tree) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) ;; solution (define (encode-symbol smb tree) (define (branch-correct? branch) (if (leaf? branch) (equal? smb (symbol-leaf branch)) (element-of-set? smb (symbols branch)))) (let ((lb (left-branch tree)) (rb (right-branch tree))) (cond ((branch-correct? lb) (if (leaf? lb) '(0) (cons 0 (encode-symbol smb lb)))) ((branch-correct? rb) (if (leaf? rb) '(1) (cons 1 (encode-symbol smb rb)))) (else (error "bad symbol -- ENCODE-SYMBOL" bit))))) ;; tests (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) ; (0 1 1 0 0 1 0 1 0 1 1 1 0)
From a SICP newbie :-):
(define (encode message tree) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) (define (encode-symbol symbol tree) (define (encode-symbol-1 result t) (cond ((null? t) '()) ((leaf? t) (if (not (eq? symbol (symbol-leaf t))) '() result)) (else (let ((left-iter (encode-symbol-1 (cons 0 result) (left-branch t))) (right-iter (encode-symbol-1 (cons 1 result) (right-branch t)))) (cond ((and (not (null? left-iter)) (not (null? right-iter))) (error "malformed tree -- ENCODE-SYMBOL" tree)) ((null? left-iter) right-iter) ((null? right-iter) left-iter) (else '())))))) (let ((encoded-symbol (reverse (encode-symbol-1 '() tree)))) (if (null? encoded-symbol) (error "symbol not found -- ENCODE-SYMBOL" symbol) encoded-symbol))) (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)) (define sample-word (decode sample-message sample-tree))
testing:
1 ]=> (equal? (encode sample-word sample-tree) sample-message) ;Value: #t
(define (encode-symbol symbol tree)
(cond
((leaf? tree) '())
((member symbol (symbols tree))
(let ((left (left-branch tree)) (right (right-branch tree)))
(if (member symbol (symbols left))
(cons 0 (encode-symbol symbol left))
(cons 1 (encode-symbol symbol right)))))
(else (error "bad symbol -- ENCODE-SYMBOL" symbol))))
(define (encode-symbol symbol tree)
(if (not (element-of-set? symbol (symbols tree)))
(error "symbol cannot be encoded")
(if (leaf? tree)
'()
(let ((left-set (symbols (left-branch tree)))
(right-set (symbols (right-branch tree))))
(cond ((element-of-set? symbol left-set)
(cons 0 (encode-symbol symbol (left-branch tree))))
((element-of-set? symbol right-set)
(cons 1 (encode-symbol symbol (right-branch tree)))))))))
I had the same approach. You do the error check for all nodes you visit. Since a node knows which symbols its children contain, you only need to check it once.
(define (encode-symbol symbol tree)
(define (search symbol tree)
(let ((left-branch (left-branch tree))
(right-branch (right-branch tree)))
(cond ((leaf? tree) '())
((element-of-set? symbol (symbols left-branch))
(cons 0 (search symbol left-branch)))
((element-of-set? symbol (symbols right-branch))
(cons 1 (search symbol right-branch))))))
(if (not (element-of-set? symbol (symbols tree)))
(error "symbol not in tree -- ENCODE-SYMBOL" symbol)
(search symbol tree)))
Short and simple. Also iterative.
(define (encode-symbol symbol tree)
(define (encode-symbol-1 tree bits)
(cond ((and (leaf? tree) (eq? symbol (symbol-leaf tree)))
(reverse bits))
((memq symbol (symbols (left-branch tree)))
(encode-symbol-1 (left-branch tree) (cons 0 bits)))
((memq symbol (symbols (right-branch tree)))
(encode-symbol-1 (right-branch tree) (cons 1 bits)))
(else (error "symbol not in tree: ENCODE-SYMBOL" symbol))))
(encode-symbol-1 tree '()))
Has both iterative and recursive
(define (encode-symbol symbol tree)
(define (encode-1 symbol tree result)
(cond ((leaf? tree) result)
((element-of-set? symbol (symbols (left-branch tree)))
(encode-1 symbol (left-branch tree) (append result '(0))))
(else
(encode-1 symbol (right-branch tree) (append result '(1))))))
(define (encode-1-rec symbol tree)
(cond ((leaf? tree) '())
((element-of-set? symbol (symbols (left-branch tree)))
(cons 0 (encode-1-rec symbol (left-branch tree))))
(else
(cons 1 (encode-1-rec symbol (right-branch tree))))))
(if (not (element-of-set? symbol (symbols tree)))
'()
(encode-1-rec symbol tree)))
use a intree? function
(define (encode-symbol symbol branch)
(define (in? symbol symbols)
(if (null? symbols) false
(if (eq? symbol (car symbols)) true
(in? symbol (cdr symbols)))))
(define (intree? symbol tree)
(if (leaf? tree) (eq? symbol (symbol-leaf tree))
(in? symbol (symbols tree))))
(cond ((leaf? branch) '())
((intree? symbol (left-branch branch))
(cons 0 (encode-symbol symbol (left-branch branch))))
((intree? symbol (right-branch branch))
(cons 1 (encode-symbol symbol (right-branch branch))))
(else (error "error"))))
Use what we've learnt in chap 1 (procedural abstraction) to simplify the code
(define (encode-symbol symbol tree)
(define (has-symbol side)
(element-of-set? symbol (symbols (side tree))))
(define (check-branch branch bit)
(if (has-symbol branch)
(cons bit (encode-symbol symbol (branch tree)))))
(cond ((leaf? tree) '())
((check-branch left-branch 0))
((check-branch right-branch 1))
(else (error "no such symbol" symbol))))
Although it's a little different from the SICP, it should be more efficient.
;; Convert a Huffman coded binary tree into a list (define (tree->list bits branch) (if (leaf? branch) (list (cons (symbol-leaf branch) (reverse bits))) (append (tree->list (cons 0 bits) (left-branch branch)) (tree->list (cons 1 bits) (right-branch branch))))) (define (encode message tree) (define symbol-list (tree->list '() tree)) (define (encode-symbol symbol symbol-list) (let ((this-code (filter (lambda (x) (eq? (car x) symbol)) symbol-list))) (if (null? this-code) (error "bad symbol -- find-code" symbol) (cdar this-code)))) (define (encode-rec message symbol-list) (if (null? message) '() (append (encode-symbol (car message) symbol-list) (encode-rec (cdr message) symbol-list)))) (encode-rec message symbol-list))
Many examples before included a procedure to test if a symbol was contained in the tree or not, but this procedure was not define (e.g. GPE's has-symbol and eliyak's member)
Here is a solution using let to define a test to see if a symbol is contained in the tree. Luckly the way we are expressing trees already tells us which symbols each node contains. We can use that not only to create the error message, but also to decide if we want do go to the left or right branch:
;; (define (encode-symbol symbol tree) (let ((ingroup? (lambda (symbol tree) (memq symbol (caddr tree))))) (if (not (ingroup? symbol tree)) (error "bad symbol -- NOT ON TREE") (cond ((eq? symbol (symbol-leaf (left-branch tree))) '(0)) ((eq? symbol (symbol-leaf (right-branch tree))) '(1)) ((ingroup? symbol (right-branch tree)) (cons 1 (encode-symbol symbol (right-branch tree)))) ((ingroup? symbol (left-branch tree)) (cons 0 (encode-symbol symbol (left-branch tree))))))))
;; Use an recursive function encode-symbol return the result or true or false (define (encode-symbol s tree) (define (encode-symbol-i s current-tree result) [cond [(leaf? current-tree) (if (eq? (symbol-leaf current-tree) s) result false)] [else [let ([left-result (encode-symbol-i s (left-branch current-tree) (append result (list 0)))]) (if left-result left-result [let ([right-result (encode-symbol-i s (right-branch current-tree) (append result (list 1)))]) (if right-result right-result (error "no symbol s in the tree"))])]]]) (encode-symbol-i s tree '()))
Self contained solution
(define (encode message tree) (define (append list1 list2) (if (null? list1) list2 (cons (car list1) (append (cdr list1) list2)))) (define (encode-symbol symbol tree) (define (symbol-in-list? symbol lst) (cond ((null? lst) #f) ((eq? symbol (car lst)) #t) (else (symbol-in-list? symbol (cdr lst))))) (define (encode-1 symbol message tree) (cond ; left-branch is leaf, right-branch not: ; check if symbol is in leaf ; YES: append 0 to message ; NO: append 1 to message with let, encode-1 with right-branch ((and (leaf? (left-branch tree)) (not (leaf? (right-branch tree)))) (if (eq? symbol (symbol-leaf (left-branch tree))) (append message (list 0)) (let ((msg (append message (list 1)))) (encode-1 symbol msg (right-branch tree))))) ; right-branch is leaf, left-branch not: ; check if symbol is in leaf ; YES: append 1 to message ; NO: append 0 to message with let, encode-1 with left-branch ((and (leaf? (right-branch tree)) (not (leaf? (left-branch tree)))) (if (eq? symbol (symbol-leaf (right-branch tree))) (append message (list 1)) (let ((msg (append message (list 0)))) (encode-1 symbol msg (left-branch tree))))) ; neither left-branch nor right-branch are leafs: ; check whether symbol is in caddr left-branch or caddr right-branch ; LEFT: append 0 to message with let, encode-1 with left-branch ; RIGHT: append 1 to message with let, encode-1 with right-branch ((and (not (leaf? (right-branch tree))) (not (leaf? (left-branch tree)))) (cond ((symbol-in-list? symbol (caddr (left-branch tree))) (let ((msg (append message (list 0)))) (encode-1 symbol msg (left-branch tree)))) ((symbol-in-list? symbol (caddr (right-branch tree))) (let ((msg (append message (list 1)))) (encode-1 symbol msg (right-branch tree)))) (else (error "Symbol not found (2)")))) ; both left-branch and right-branch are leafs: ; check whether symbol in left leaf or right leaf ; LEFT: append 0 to message ; RIGHT: append 1 to message (else (cond ((eq? symbol (symbol-leaf (left-branch tree))) (append message (list 0))) ((eq? symbol (symbol-leaf (right-branch tree))) (append message (list 1))) (else (error "Symbol not found (1)")))))) (encode-1 symbol '() tree)) (if (null? message) '() (append (encode-symbol (car message) tree) (encode (cdr message) tree)))) ; test (display sample-message)(newline) (decode sample-message sample-tree) (encode (decode sample-message sample-tree) sample-tree) (encode '(A B E) sample-tree)
It took me a while to come up with this. It was quite similar to the first answer, I suppose.
(define (encode-symbol symbol tree)
; Return the list of bits that encodes a given symbol according to a given
; tree. It signals an error if the symbol is not in the tree at all.
(if (leaf? tree)
(if (eq? (symbol-leaf tree) symbol)
(list)
(error "bad symbol: ENCODE-SYMBOL" symbol))
(let ((left-leaf (left-branch tree)))
(if (eq? (symbol-leaf left-leaf)
symbol)
(list 0)
(append (list 1)
(encode-symbol symbol
(right-branch tree)))))))
My solution works by tracing the path to the leaf node containing the target symbol recording the direction taken in the path with a 0 for left and 1 for right.
;; HELPER FUNCTIONS BEGIN (define (fold-left op initial sequence) ;; here (define (iter seq result) (if (null? seq) result (iter (cdr seq) (op (car seq) result)))) (iter sequence initial)) (define (any? predicate? elements) (fold-left (lambda (left right) (or (predicate? left) right)) #f elements)) ;; HELPER FUNCTIONS END ;;SOLUTION (define (encode-symbol symbol tree) (define (in-symbols? tree) (any? (lambda (x) (eq? symbol x)) (symbols tree))) (cond ((and (leaf? tree) (eq? (symbol-leaf tree) symbol)) '()) ((in-symbols? (left-branch tree)) (cons 0 (encode-symbol symbol (left-branch tree)))) ((in-symbols? (right-branch tree)) (cons 1 (encode-symbol symbol (right-branch tree)))) (else (error "invald symbol -- ENCODE-SYMBOL --" symbol))))
Simple recursive solution