ray/guile-algorithms
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add tests, fix nasty bug in sink function

Browse source
This commit is contained in:
Ray Miller 2024-12-07 16:34:40 +00:00
parent a6c660b00e
commit c36209028d
Signed by: ray
GPG key ID: 043F786C4CD681B8
2 changed files with 80 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

29
algo/priority-queue.scm
View file

@ -5,7 +5,8 @@
pq-push!
pq-pop!
pq-peek
pq-empty?))
pq-empty?
pq-drain!))
;; The heap implementation is the based on Chapter 6: Heapsort of "Introduction
;; to Algorithms" by Cormen, Leiserson, Rivest, and Stein.
@ -31,9 +32,6 @@
;; The sink function is called to maintain the heap property when the root node
;; is removed and swapped with the last node in the heap. The new root node
;; might need to "sink" down to maintain the heap ordering.
;;
;; priority is a function that returns the priority of an element.
;; cmp will be > for a max heap or < for a min heap.
(define (sink A i priority cmp)
(let ((heap-size (vector-ref A 0)))
(let loop ((i i))
@ -41,9 +39,8 @@
(r (right-child i)))
(cond
((and (<= r heap-size)
(cmp (priority (vector-ref A r))
(priority (vector-ref A l))
(priority (vector-ref A i))))
(cmp (priority (vector-ref A r)) (priority (vector-ref A l)))
(cmp (priority (vector-ref A r)) (priority (vector-ref A i))))
(vector-swap! A i r)
(loop r))
((and (<= l heap-size)
@ -53,12 +50,12 @@
(loop l)))))))
;; The swim function is used to restore the heap property when a new node is
;; added to the heap: it's initally added at the end of the heap with and
;; may need to "swim" up the heap to maintain the order.
;; added to the heap: it's initally added at the end of the heap and may need to
;; "swim" up the heap to maintain the order.
(define (swim A i priority cmp)
(let loop ((i i))
(when (and (> (parent i) 0) (not (cmp (priority (vector-ref A (parent i)))
(priority (vector-ref A i)))))
(when (and (> (parent i) 0) (cmp (priority (vector-ref A i))
(priority (vector-ref A (parent i)))))
(vector-swap! A i (parent i))
(loop (parent i)))))
@ -69,6 +66,8 @@
(let ((A (make-vector initial-capacity)))
(vector-set! A 0 0)
(match-lambda*
(('dump)
A)
(('size)
(vector-ref A 0))
(('peek)
@ -110,3 +109,11 @@
(q 'peek))
(define pq-empty? (compose zero? pq-length))
;; Pop all elements of a queue onto a list, emptying the queue in the process.
;; Return the resulting list.
(define (pq-drain! q)
(let loop ((result '()))
(if (pq-empty? q)
(reverse result)
(loop (cons (pq-pop! q) result)))))