1 files changed, 42 insertions, 0 deletions
diff --git a/lore/sicp/set.scm b/lore/sicp/set.scm
new file mode 100644
index 0000000..3d60c5c
--- /dev/null
+++ b/lore/sicp/set.scm
@@ -0,0 +1,42 @@
+;; A set module, based on binary trees (from sicp)
+
+(define (entry tree) (car tree))
+(define (left-branch tree) (cadr tree))
+(define (right-branch tree) (caddr tree))
+
+(define (make-tree entry left right)
+  (list entry left right))
+
+(define (element-of-set? x set)
+  (cond ((null? set) #f)
+        ((= x (entry set)) #t)
+        ((< x (entry set))
+         (element-of-set? x (left-branch set)))
+        ((> x (entry set))
+         (element-of-set? x (right-branch set)))))
+
+(define (adjoin-set x set)
+  (cond ((null? set) (make-tree x '() '()))
+        ((= x (entry set)) set)
+        ((< x (entry set))
+         (make-tree (entry set)
+                    (adjoin-set x (left-branch set))
+                    (right-branch set)))
+        ((> x (entry set))
+         (make-tree (entry set)
+                    (left-branch set)
+                    (adjoin-set x (right-branch set))))))
+
+(define (intersection-set set1 set2)
+  (if (or (null? set1) (null? set2))
+    '()
+    (let ((x1 (car set1))
+          (x2 (car set2)))
+      (cond ((= x1 x2)
+             (cons x1
+                   (intersection-set (cdr set1)
+                                     (cdr set2))))
+            ((< x1 x2)
+             (intersection-set (cdr set1) set2))
+            ((< x2 x1)
+             (intersection-set set1 (cdr set2)))))))