Add exercise 3.26

3_26.rkt

@@ -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)))
+  
+