[rucksack-devel] PATCH: b-tree binary search

[Cyrus Harmon]

Ok, I think this is working now:


--- p-btrees.lisp	26 Aug 2006 05:55:34 -0700	1.10
+++ p-btrees.lisp	14 Jan 2007 11:51:57 -0800	
@@ -495,30 +495,69 @@
(defun find-subnode (btree node key)
    "Returns the subnode that contains more information for the given  
key."
-  ;; Find the first binding with a key >= the given key and return
-  ;; the corresponding subnode.
-  ;; EFFICIENCY: We should probably use binary search for this.
-  (loop with btree-key< = (btree-key< btree)
-        with last-index = (1- (btree-node-index-count node))
-        for i to last-index
-        for binding = (node-binding node i)
-        when (or (= i last-index)
-                 (funcall btree-key< key (binding-key binding))
-                 (not (funcall btree-key< (binding-key binding) key)))
-        do (return-from find-subnode (binding-value binding)))
-  (error "This shouldn't happen."))
+  (let ((btree-key< (btree-key< btree))
+        (last (1- (btree-node-index-count node))))
+    (labels ((binary-search (start end)
+               (let* ((mid (+ start (truncate (- end start) 2)))
+                      (mid-binding (node-binding node mid)))
+                 (if (= start mid)
+                     (if (not (funcall btree-key< (binding-key mid- 
binding) key))
+                         (binding-value mid-binding)
+                         (binding-value (node-binding node (1+ mid))))
+                     (if (not (funcall btree-key< (binding-key mid- 
binding) key))
+                         (binary-search start mid)
+                         (binary-search mid end))))))
+      (if (funcall btree-key< (binding-key (node-binding node (1-  
last))) key)
+          (binding-value (node-binding node last))
+          (binary-search 0 (1- last)))))
+  ;;; this is the old (linear search) version kept here for reference
+  ;;; for the moment
+  #+nil
+  (progn
+    (loop with btree-key< = (btree-key< btree)
+       with last-index = (1- (btree-node-index-count node))
+       for i to last-index
+       for binding = (node-binding node i)
+       when (or (= i last-index)
+                (funcall btree-key< key (binding-key binding))
+                (not (funcall btree-key< (binding-key binding) key)))
+       do (return-from find-subnode (binding-value binding)))
+    (error "This shouldn't happen.")))
(defun find-binding-in-node (key node btree)
+  (let ((btree-key< (btree-key< btree))
+        (array (btree-node-index node))
+        (index-count (btree-node-index-count node)))
+    (labels ((binary-search (start end)
+               (let* ((mid (+ start (truncate (- end start) 2)))
+                      (mid-binding (p-aref array mid))
+                      (mid-key (binding-key mid-binding)))
+                 (if (= start mid)
+                     (if (not (funcall btree-key< (binding-key mid- 
binding) key))
+                         (when (funcall (btree-key= btree) key mid-key)
+                           mid-binding)
+                         (when (< mid end)
+                           (let* ((next-binding (p-aref array (1+  
mid)))
+                                  (next-key (binding-key next- 
binding)))
+                             (when (funcall (btree-key= btree) key  
next-key)
+                               next-binding))))
+                     (if (not (funcall btree-key< (binding-key mid- 
binding) key))
+                         (binary-search start mid)
+                         (binary-search (1+ mid) end))))))
+      (when (plusp index-count)
+        (binary-search 0 (1- index-count)))))
+
+  #+nil
    (let ((index-count (btree-node-index-count node)))
      (and (plusp index-count)
           (loop with array = (btree-node-index node)
-               with btree-key< = (btree-key< btree)
-               for i from 0 below index-count
-               for candidate = (p-aref array i)
-               for candidate-key = (binding-key candidate)
-               while (funcall btree-key< candidate-key key)
-               finally (when (funcall (btree-key= btree) key  
candidate-key)
-                         (return candidate))))))
+            with btree-key< = (btree-key< btree)
+            for i from 0 below index-count
+            for candidate = (p-aref array i)
+            for candidate-key = (binding-key candidate)
+            while (funcall btree-key< candidate-key key)
+            finally (when (funcall (btree-key= btree) key candidate- 
key)
+                      (return  candidate))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;;;;;
;;; Insert