[rucksack-devel] binary search in find-subnode

[Cyrus Harmon]

And for find-binding-in-node:

(defun find-subnode (btree node key)
   "Returns the subnode that contains more information for the given  
key."
   (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.")))

Cyrus



On Jan 14, 2007, at 11:02 AM, Cyrus Harmon wrote:

>
> Well, it took me longer than I'd care to admit to get this right,  
> but here's what I came up with for the binary search routine. I'm  
> sure this could be cleaned up a bit, but if anyone with a fresh set  
> of eyes wants to take a look at this, I'd appreciate it:
>
> (defun find-subnode (btree node key)
>   "Returns the subnode that contains more information for the given  
> key."
>   (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.")))
>
>
> Thanks,
>
> Cyrus
>
> _______________________________________________
> rucksack-devel mailing list
> rucksack-devel at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/rucksack-devel