Add exercise 3.26
This commit is contained in:
parent
0ebcd12c64
commit
69afb16beb
|
@ -0,0 +1,97 @@
|
|||
#lang sicp
|
||||
|
||||
(#%require racket/trace)
|
||||
|
||||
;; Binary tree set
|
||||
(define (make-entry key value)
|
||||
(cons key value))
|
||||
(define (key entry)
|
||||
(car entry))
|
||||
(define (value entry)
|
||||
(cdr entry))
|
||||
(define (set-value! entry value)
|
||||
(set-cdr! entry value))
|
||||
|
||||
(define (make-tree entry left right)
|
||||
(list entry left right))
|
||||
|
||||
(define (entry tree) (car tree))
|
||||
(define (left-branch tree) (cadr tree))
|
||||
(define (right-branch tree) (caddr tree))
|
||||
(define (empty? tree) (or (null? tree) (null? (entry tree))))
|
||||
|
||||
(define (adjoin-set x set)
|
||||
(cond ((empty? set) (make-tree x '() '()))
|
||||
((= (key x) (key (entry set))) set)
|
||||
((< (key x) (key (entry set)))
|
||||
(make-tree (entry set)
|
||||
(adjoin-set x (left-branch set))
|
||||
(right-branch set)))
|
||||
((> (key x) (key (entry set)))
|
||||
(make-tree (entry set)
|
||||
(left-branch set)
|
||||
(adjoin-set x (right-branch set))))))
|
||||
|
||||
(define (lookup-set given-key set)
|
||||
(cond ((empty? set) false)
|
||||
((= given-key (key (entry set))) (entry set))
|
||||
((< given-key (key (entry set)))
|
||||
(lookup-set given-key (left-branch set)))
|
||||
(else (lookup-set given-key (right-branch set)))))
|
||||
|
||||
(define (make-empty-set)
|
||||
(make-tree '() '() '()))
|
||||
|
||||
;; 2-d table
|
||||
(define (make-table)
|
||||
(cons '*table* (make-empty-set)))
|
||||
|
||||
(define (lookup key-1 key-2 table)
|
||||
(let ((subtable (lookup-set key-1 (cdr table))))
|
||||
(if subtable
|
||||
(let ((record (lookup-set key-2 (cdr subtable))))
|
||||
(if record
|
||||
(value record)
|
||||
false))
|
||||
false)))
|
||||
|
||||
(define (insert! key-1 key-2 value table)
|
||||
(let ((subtable (lookup-set key-1 (cdr table))))
|
||||
(if subtable
|
||||
(let ((record (lookup-set key-2 (cdr subtable))))
|
||||
(if record
|
||||
(set-value! record value)
|
||||
(set-value! subtable
|
||||
(adjoin-set
|
||||
(make-entry key-2 value)
|
||||
(cdr subtable)))))
|
||||
(set-cdr! table
|
||||
(adjoin-set
|
||||
(make-entry key-1
|
||||
(adjoin-set
|
||||
(make-entry key-2 value)
|
||||
(make-empty-set)))
|
||||
(cdr table)))))
|
||||
'ok)
|
||||
|
||||
|
||||
(#%require (only racket/base module+))
|
||||
|
||||
(module+ test
|
||||
(#%require rackunit)
|
||||
|
||||
(test-begin
|
||||
(define t (make-table))
|
||||
(insert! 10 10 'a t)
|
||||
(check-equal? (lookup 10 10 t) 'a)
|
||||
(insert! 20 20 'b t)
|
||||
(check-equal? (lookup 20 20 t) 'b)
|
||||
(insert! 30 30 'f t)
|
||||
(check-equal? (lookup 30 30 t) 'f)
|
||||
(insert! 10 10 'c t)
|
||||
(check-equal? (lookup 10 10 t) 'c)
|
||||
(insert! 10 11 'd t)
|
||||
(check-equal? (lookup 10 11 t) 'd)
|
||||
(check-equal? (lookup 10 10 t) 'c)))
|
||||
|
||||
|
Loading…
Reference in New Issue