KVV and balancing.

src/util-bst.scm

@@ -16,12 +16,21 @@
 
   bst-set
   bst-remove
+  ;; bst-update
 
-  ;;bst->kvv
-  ;;kvv->bst
-  ;;kvv-filter
+  bst-keys
+
+  bst->kvv
+  kvv->bst
+  kvv-filter
   
-  ;;bst-balance
+  bst-balance
+
+  ;; bst-find-pair
+  ;; bst-filter-pairs
+
+  ;; bst-map-list
+  ;; bst-map-dict
 
   util-bst-tests!
   )
@@ -213,6 +222,79 @@
 			      new-root
 			      (- (bst-count bst) sub-count))))))
 
+ ;; Unique tag for static vector representation that retains type info
+ (define TAG-KVV (make-tag kvv))
+
+ ;; Iterates over given BST and passes the KV pairs to given proc
+ (define (bst-iter-kv bst proc)
+   (let-comparators
+    (EQ? <? bst)
+    (let loop ((n (bst-root bst)))
+      (when n
+	(loop (bst-node-left n))
+	(proc (bst-node-kv n))
+	(loop (bst-node-right n))))))
+
+
+ (define/doc (bst-keys bst)
+   ("Returns all the keys contained in given dictionary.")
+   (let ((res '()))
+     (bst-iter-kv bst
+		  (lambda (k v)
+		    (set! res (cons k res))))
+     (reverse res)))
+
+ ;; Converts BST to KVV
+ (define (bst->kvv bst)
+   (let ((vec (make-vector (bst-count bst)))
+	 (idx 0))
+     (bst-iter-kv bst
+		  (lambda (kv)
+		    (vector-set! vec idx kv)
+		    (set! idx (add1 idx))))
+     (cons TAG-KVV
+	   (cons vec
+		 (cddr bst)))))
+
+ ;; Converts a vector of key-value cons cells to BST dictionary
+ (define (kvv->bst kvv)
+   (let* ((vec (cadr kvv))
+	  (count (vector-length vec)))
+     (cons TAG-BST
+	   (cons (cons (let loop ((s 0)
+				  (e count))
+			 (if (= s e)
+			     #f
+			     (let* ((c (- e s))
+				    (h (quotient c 2))
+				    (m (+ s h))
+				    (kv (vector-ref vec m)))
+			       (cons kv
+				     (cons (loop s m)
+					   (loop (add1 m) e))))))
+		       count)
+		 (cddr kvv)))))
+
+ ;; Returns KVV that contains only KV pairs matching pred?
+ (define (kvv-filter kvv pred?)
+   (cons (car kvv)
+	 (cons (apply vector
+		      (let ((vec (cadr kvv)))
+			(let loop ((idx (sub1 (vector-length vec)))
+				   (res '()))
+			  (if (< idx 0)
+			      res
+			      (let ((kv (vector-ref vec idx)))
+				(loop (if (pred? (car kv) (cdr kv))
+					  (cons kv res)
+					  res)))))))
+	       (cddr kvv))))
+
+ (define/doc (bst-balance bst)
+   ("Unconditionally balances the BST.")
+   (kvv->bst
+    (bst->kvv bst)))
+
  ;; Module self-tests
  (define (util-bst-tests!)
    (run-tests
@@ -241,12 +323,25 @@
 		 (bst-count
 		  (make-bst 'fixnum eq? <))
 		 0)
-    (test-equal? bst-count
+    (test-equal? bst-set
 		 (bst-count
 		  (bst-set
 		   (make-bst 'fixnum eq? <)
 		   1 2))
 		 1)
+    (test-true bst-remove
+	       (bst-empty?
+		(bst-remove
+		 (bst-set
+		  (make-bst 'fixnum eq? <)
+		  1 2) 1)))
+    (test-equal? bst-balance
+		 (bst-count
+		  (bst-balance
+		   (bst-set
+		    (make-bst 'fixnum eq? <)
+		    1 2)))
+		 1)
     ))
 
  )