A little BTree.

Persistent (immutable) datastructure.

diff --git a/implementations/scheme-chicken/btree.scm b/implementations/scheme-chicken/btree.scm
new file mode 100644 (file)
index 0000000..a0aa8d7
--- /dev/null
+++ b/implementations/scheme-chicken/btree.scm
@@ -0,0 +1,62 @@
+(import srfi-1)
+(import srfi-12)
+(import matchable)
+
+; Importing srfi-67 did not actually make available symbol-compare.  Boo!
+
+(define (symbol<? a b) (string<? (symbol->string a) (symbol->string b)))
+
+; a BTree is a four-tuple of (name value left right) | ()
+
+(define (btree-get key btree)
+  (match btree
+    (() (abort "Key not found."))
+    ((k value left right)
+      (if (eq? key k)
+        value
+        (btree-get key (if (symbol<? key k) left right))))
+    (_ (abort "Not a BTree."))))
+
+
+(define (btree-insert key value btree)
+  (match btree
+    (() (list key value '() '()))
+    ((k v left right)
+      (if (eq? key k)
+        (list k value left right)
+        (if (symbol<? key k)
+          (list k v (btree-insert key value left) right)
+          (list k v left (btree-insert key value right)))))
+    (_ (abort "Not a BTree."))))
+
+(set! T '())
+(set! T (btree-insert 'larry 23 T))
+(set! T (btree-insert 'barry 18 T))
+(set! T (btree-insert 'carry 99 T))
+(display T)
+(newline)
+
+
+
+(define (balance el)
+  (if (null-list? el)
+    el
+    (balance0 el (halve (length el)))))
+
+(define (balance0 el midpoint)
+  (receive (prefix suffix) (split-at el midpoint)
+    (cons
+      (first suffix)
+      (append 
+        (balance prefix)
+        (balance (cdr suffix))))))
+
+(define (halve n) (quotient n 2))
+
+(set! T (iota 23))
+
+;(define (btree-sorted-list items)
+;  (btree-sorted-list0 items (length items)))
+
+;(define (btree-sorted-list items len)
+;  ())

diff --git a/implementations/scheme-chicken/joy.scm b/implementations/scheme-chicken/joy.scm
index 8de7620..78df1c1 100644 (file)
--- a/implementations/scheme-chicken/joy.scm
+++ b/implementations/scheme-chicken/joy.scm
@@ -26,6 +26,7 @@
 
 (import (chicken io))
 (import (chicken string))
+(import srfi-1)
 (import srfi-12)
 (import srfi-69)
 (import matchable)
@@ -274,3 +275,21 @@
 ;(display (doit "1 2 true [4 5 false] loop <"))
 ;(newline)
 
+
+; Importing srfi-67 did not actually make available symbol-compare.  Boo!
+
+(define (symbol<? a b) (string<? (symbol->string a) (symbol->string b)))
+
+; a BTree is a four-tuple of (name value left right) | ()
+
+(define (btree-get key btree)
+  (match btree
+    (() (abort "Key not found."))
+    ((k value left right)
+      (if (eq? key k)
+        value
+        (btree-get key (if (symbol<? key k) left right))))
+    (_ (abort "Not a BTree."))))
+
+
+