implementations/scheme-chicken/btree.scm

   1 (import srfi-1)
   2 (import srfi-12)
   3 (import matchable)
   4
   5 ; Importing srfi-67 did not actually make available symbol-compare.  Boo!
   6
   7 (define (symbol<? a b) (string<? (symbol->string a) (symbol->string b)))
   8
   9 ; a BTree is a four-tuple of (name value left right) | ()
  10
  11 (define (btree-get key btree)
  12   (match btree
  13     (() (abort "Key not found."))
  14     ((k value left right)
  15       (if (eq? key k)
  16         value
  17         (btree-get key (if (symbol<? key k) left right))))
  18     (_ (abort "Not a BTree."))))
  19
  20
  21 (define (btree-insert key value btree)
  22   (match btree
  23     (() (list key value '() '()))
  24     ((k v left right)
  25       (if (eq? key k)
  26         (list k value left right)
  27         (if (symbol<? key k)
  28           (list k v (btree-insert key value left) right)
  29           (list k v left (btree-insert key value right)))))
  30     (_ (abort "Not a BTree."))))
  31
  32 (set! T '())
  33 (set! T (btree-insert 'larry 23 T))
  34 (set! T (btree-insert 'barry 18 T))
  35 (set! T (btree-insert 'carry 99 T))
  36 (display T)
  37 (newline)
  38
  39
  40
  41 (define (balance el)
  42   (if (null-list? el)
  43     el
  44     (balance0 el (halve (length el)))))
  45
  46 (define (balance0 el midpoint)
  47   (receive (prefix suffix) (split-at el midpoint)
  48     (cons
  49       (first suffix)
  50       (append
  51         (balance prefix)
  52         (balance (cdr suffix))))))
  53
  54 (define (halve n) (quotient n 2))
  55
  56 (set! T (iota 23))
  57
  58 ;(define (btree-sorted-list items)
  59 ;  (btree-sorted-list0 items (length items)))
  60
  61 ;(define (btree-sorted-list items len)
  62 ;  ())