[rucksack-devel] Re: rucksack-devel Digest, Vol 9, Issue 13

[Cyrus Harmon]

Ok, Kenny's email got me thinking. I think the code was working  
before, but for reasons I didn't quite understand. The issue has to  
do with the boundary conditions and how we do the splitting. In  
particular, what happens when the key we are looking for falls in  
between the last key of the left child and the first key of the right  
child. I think it was working properly before, but this version is  
perhaps a bit more explicit in ensuring that:


(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.
   (let ((btree-key< (btree-key< btree))
         (last (1- (btree-node-index-count node))))
     (labels ((binary-search (start end)
                (let* ((mid (+ start (ash (- end start) -1))))
                  (cond ((= start mid)
                         (let ((start-binding (node-binding node  
start)))
                           (if (funcall btree-key< (binding-key start- 
binding) key)
                               (binding-value (node-binding node end))
                               (binding-value start-binding))))
                        (t
                         (let ((mid-binding (node-binding node mid)))
                           (if (funcall btree-key< (binding-key mid- 
binding) key)
                               (binary-search mid end)
                               (binary-search start mid))))))))
       (if (funcall btree-key< (binding-key (node-binding node (1-  
last))) key)
           (binding-value (node-binding node last))
           (binary-search 0 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 (ash (- end start) -1))))
                  (cond ((= start mid)
                         (let ((start-binding (p-aref array start)))
                           (if (funcall btree-key< (binding-key start- 
binding) key)
                               (when (< end index-count)
                                 (p-aref array end))
                               start-binding)))
                        (t (let ((mid-binding (p-aref array mid)))
                             (if (funcall btree-key< (binding-key mid- 
binding) key)
                                 (binary-search mid end)
                                 (binary-search start mid))))))))
       (when (plusp index-count)
         (let ((candidate (binary-search 0 index-count)))
           (when (and candidate
                      (funcall (btree-key= btree) (binding-key  
candidate) key))
             candidate)))))
   ;;; this is the old (linear search) version kept here for reference
   ;;; for the moment
   #+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))))))




Cyrus


On Jan 15, 2007, at 9:08 AM, Ken Tilton wrote:
>> On Jan 14, 2007, at 3:10 PM, Cyrus Harmon wrote:
>>
>>> On Jan 14, 2007, at 3:02 PM, Arthur Lemmens wrote:
>>>
>>>> Cyrus Harmon wrote:
>>>>
>>>>
>>>>
>>>>> +                     (if (not (funcall btree-key< (binding- 
>>>>> key  mid-binding) key))
>>>>> +                         (binary-search start mid)
>>>>> +                         (binary-search mid end))))))
>>>>>
>>>> Same here.
>>>>
>>> ditto
>>>
>>
>> hmm... should that be (binary-search (1+ mid) end) ?
>>
> Not if it is traditionally Lispy:
>
> (let ((s "abc123")
>      (m 3))
>  (list (subseq s 0 m)(subseq s m))) -> "abc123"
>
> kt