[rucksack-devel] binary search in find-subnode

[Cyrus Harmon]

Ah, whoops. Pasted wrong function. But the one I have doesn't work  
either. Will resend in a moment after I (hopefully) fix it.

Cyrus

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

> 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
>
> _______________________________________________
> rucksack-devel mailing list
> rucksack-devel at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/rucksack-devel