Chat (Lingr.com)
Informaiton
Daily
Column
- MySQL日本語の旅(5/1)
- アクセス向上秘伝(5/9)
- 一風変ったHaskellλ門(6/13)
- SICP Answer Book (5/31) 問題3.26追加
Zope Solution
Extra
アーカイブ
OSS案内所
Site Info
関連リンク
##(link2sicp "book-Z-H-22.html#%_thm_3.26" "Exercise 3.26")
解答例
(define (make-tree compfunc)
(let ((local-tree 'initial))
(define (make-tree key value left right)
(list key value left right))
(define (key-tree tree) (car tree))
(define (value-tree tree) (cadr tree))
(define (left-tree tree) (caddr tree))
(define (right-tree tree) (cadddr tree))
(define (set-value-tree! tree value)
(set-car! (cdr tree) value))
(define (set-left-tree! tree value)
(set-car! (cddr tree) value))
(define (set-right-tree! tree value)
(set-car! (cdddr tree) value))
(define (lookup key)
(define (lookup-aux key tree)
(if (not (pair? tree))
false
(let ((result (compfunc key (key-tree tree))))
(cond ((= result 0)
(value-tree tree))
((> result 0)
(lookup-aux key (left-tree tree)))
((< result 0)
(lookup-aux key (right-tree tree)))))))
(lookup-aux key local-tree))
(define (insert! key value)
(define (make-subtree key value)
(make-tree key value '() '()))
(define (insert!-aux key value tree)
(cond ((eq? tree 'initial)
(set! local-tree (make-subtree key value)))
(else
(let ((result (compfunc key (key-tree tree))))
(cond ((= result 0)
(set-value-tree! tree value))
((> result 0)
(if (null? (left-tree tree))
(set-left-tree! tree
(make-subtree key value))
(insert!-aux key value (left-tree tree))))
((< result 0)
(if (null? (right-tree tree))
(set-right-tree! tree
(make-subtree key value))
(insert!-aux key value (right-tree tree)))))))))
(insert!-aux key value local-tree)
'ok)
(define (print) (display local-tree) (newline))
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
((eq? m 'print-proc) print)
(else (error "Unknown operation -- TABLE" m))))
dispatch))
実行例
gosh> (define operation-tree (make-tree (lambda (x y) (- x y)))) operation-tree gosh> (define get-tree (operation-tree 'lookup-proc)) get-tree gosh> (define put-tree (operation-tree 'insert-proc!)) put-tree gosh> (define print-tree (operation-tree 'print-proc)) print-tree gosh> (put-tree 0 0) ok gosh> (put-tree -10 -10) ok gosh> (put-tree 10 10) ok gosh> (print-tree) (0 0 (10 10 () ()) (-10 -10 () ())) #<undef> gosh> (get-tree 0) 0 gosh> (get-tree 10) 10 gosh> (get-tree -10) -10 gosh> (put-tree 0 'zero) ok gosh> (get-tree 0) zero gosh> (put-tree 1 1) ok gosh> (put-tree 2 2) ok gosh> (put-tree 3 3) ok gosh> (put-tree 4 4) ok gosh> (print-tree) (0 zero (10 10 () (1 1 (2 2 (3 3 (4 4 () ()) ()) ()) ())) (-10 -10 () ())) #<undef>
--hidenao
コード
##(sicp-answer-code "ex-3.26.scm")
