xanadu - -btree

scsh/xanadu/b-tree.scm

@@ -26,41 +26,43 @@
 ;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
 ;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-(define (vector-median v)
-  (let ((len (ceiling (/ (vector-length v) 2))))
-    (let ((retl (make-vector len))
-          (retr (make-vector len))) 
-      (do ((i 0 (+ i 1)))
-        ((= i len) (list retl retr))
-        (vector-set! retl i (vector-ref v i))
-	(vector-set! retr (- len (- i 1)) (vector-ref v (- len (- i 1))))
-        ))))
-
 (define (make-b-tree)
   (let ((*tree (make-vector 0)))
 
+    (define (vector-median v)
+      (let ((len (ceiling (/ (vector-length v) 2))))
+        (let ((retl (make-vector len))
+              (retr (if (odd? len) (make-vector (- len 1)) (make-vector len))))
+          (do ((i 0 (+ i 1)))
+              ((= i len) (list retl retr))
+            (vector-set! retl i (vector-ref v i))
+	(vector-set! retr (- len (- i 1)) (vector-ref v (- len (- i 1))))
+        ))))
+
     (define (goto-left-node str i tree)
       (cond ((= (vector-length tree) i) (display "null node") (vector-set! tree i str))
-            (else #f))) 
+            (else #f)))
 
     (define (grow-up upper-node)
       (cond ((eq? node *tree)
-             (set! *tree (vector-median *tree 
+             (
 
     (define (add-rec str tree upper-node)
-      (do ((i 0 (+ i 1)))
-	  ((eq? i (vector-length tree))
-           (grow-up upper-node) 
-        (let ((vi (vector-ref tree i)))
-          (cond ((string<=? str vi)
-                 0)
-                ((string>=? str vi)
-                 (grow-down))
-               ((string=? str vi)
-                (set! i (vector-length tree)))
-               (else (display "never reached."))))
-      ))
-        
+      (let ((len (vector-length tree)))
+        (do ((i 0 (+ i 1)))
+            ((cond ((>= i (- len 1));;last node
+                    (grow-up upper-node))
+                   ((and (string<=? str (vector-ref tree i))
+                         (string>=? str (vector-ref tree (+ i 1))))
+                    (add-rec str (vector-ref tree i)))
+                   ((string>=? str (vector-ref tree i))
+                    (grow-down))
+                   ((string=? str (vector-ref tree i))
+                    (set! i (vector-length tree)))
+                   (else (display "never reached."))))
+          )))
+
+
     (define (add str)
       (add-rec *tree *tree))