[cl-containers-devel] Two bugs in heaps.lisp

[Cosmin Marian]

Hello,

Playing with the cl-containers and the heap implementation I come across 
what looks like two bugs in heaps.lisp:

1/ delete-item/sift does not use the key of the elements stored in the 
heap in order to compare them. This is easy to see in the source code.

2/ it looks like node-parent-index is incorrect as you use 0 based indexes:

It says:

(defmethod node-parent-index ((node heap-node))
       (ash (index node) -1))

But it should be

(defmethod node-parent-index ((node heap-node))
      (ash (1- (index node)) -1))


This is easy to test if you look at the result of

(node-parent-index (r-child-index 0))

It should be 0 but returns 1.

The formula for parent node index using 0 based indexes is documented in 
wikipedia: http://en.wikipedia.org/wiki/Binary_heap#Heap_implementation. 
It is parent/= a/[floor((/i/-1)/2)]

This causes some subtle bugs, harder to catch.

I attach two tests in a file.

Regards,
Cosmin
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cl-containers-devel/attachments/20121218/db25acc5/attachment.html>
-------------- next part --------------
(in-package cl-containers)

(defun test-parent ()
  (let ((heap (make-container 'heap-container)))
    (insert-item heap (make-node-for-container heap 0))
    (insert-item heap (make-node-for-container heap 3))
    (insert-item heap (make-node-for-container heap 7))

    (let* ((nodes (contents heap))
	   (l-child-index 1)
	   (r-child-index 2)
	   (p-index 0))
      (and
       (eq p-index (cl-containers::node-parent-index (aref nodes l-child-index)))
       (eq p-index (cl-containers::node-parent-index (aref nodes r-child-index)))))))

       
(defun test-sift ()
  (let ((heap (make-container 'heap-container :sorter #'< :key #'car)))
    (insert-item heap (make-node-for-container heap '(0 20)))
    (insert-item heap (make-node-for-container heap '(3 20)))
    (insert-item heap (make-node-for-container heap '(7 20)))
    (insert-item heap (make-node-for-container heap '(4 20)))
    (insert-item heap (make-node-for-container heap '(5 20)))
    (insert-item heap (make-node-for-container heap '(8 20)))
    (insert-item heap (make-node-for-container heap '(9 20)))
    (insert-item heap (make-node-for-container heap '(6 20)))

    ;; we just get the a node from the contents array
    ;; this will cause a sift and expose the bug
    ;; the test data works only after fixing the parent bug
    ;; but it is easy to come up with test data even if not fixing the bug
    (print (contents heap))
    (delete-item heap (aref (contents heap) 5))))