;;; -*- Mode: Lisp; Syntax: Common-Lisp; -*- File: utilities/queue.lisp ;;;; The Queue datatype ;;; We can remove elements form the front of a queue. We can add elements in ;;; three ways: to the front, to the back, or ordered by some numeric score. ;;; This is done with the following enqueing functions, which make use of the ;;; following implementations of the elements: ;;; ENQUEUE-AT-FRONT - elements are a list ;;; ENQUEUE-AT-END - elements are a list, with a pointer to end ;;; ENQUEUE-BY-PRIORITY - elements are a heap, implemented as an array ;;; The best element in the queue is always in position 0. ;;; The heap implementation is taken from "Introduction to Algorithms" by ;;; Cormen, Lieserson & Rivest [CL&R], Chapter 7. We could certainly speed ;;; up the constant factors of this implementation. It is meant to be clear ;;; and simple and O(log n), but not super efficient. Consider a Fibonacci ;;; heap [Page 420 CL&R] if you really have large queues to deal with. (defstruct q (key #'identity) (last nil) (elements nil)) ;;;; Basic Operations on Queues (defun make-empty-queue () (make-q)) (defun empty-queue? (q) "Are there no elements in the queue?" (= (length (q-elements q)) 0)) (defun queue-front (q) "Return the element at the front of the queue." (elt (q-elements q) 0)) (defun remove-front (q) "Remove the element from the front of the queue and return it." (if (listp (q-elements q)) (pop (q-elements q)) (heap-extract-min (q-elements q) (q-key q)))) ;;;; The Three Enqueing Functions (defun enqueue-at-front (q items) "Add a list of items to the front of the queue." (setf (q-elements q) (nconc items (q-elements q)))) (defun enqueue-at-end (q items) "Add a list of items to the end of the queue." ;; To make this more efficient, keep a pointer to the last cons in the queue (cond ((null items) nil) ((or (null (q-last q)) (null (q-elements q))) (setf (q-last q) (last items) (q-elements q) (nconc (q-elements q) items))) (t (setf (cdr (q-last q)) items (q-last q) (last items))))) (defun enqueue-by-priority (q items key) "Insert the items by priority according to the key function." ;; First make sure the queue is in a consistent state (setf (q-key q) key) (when (null (q-elements q)) (setf (q-elements q) (make-heap))) ;; Now insert the items (for each item in items do (heap-insert (q-elements q) item key))) ;;;; The Heap Implementation of Priority Queues ;;; The idea is to store a heap in an array so that the heap property is ;;; maintained for all elements: heap[Parent(i)] <= heap[i]. Note that we ;;; start at index 0, not 1, and that we put the lowest value at the top of ;;; the heap, not the highest value. ;; These could be made inline (defun heap-val (heap i key) (declare (fixnum i)) (funcall key (aref heap i))) (defun heap-parent (i) (declare (fixnum i)) (floor (- i 1) 2)) (defun heap-left (i) (declare (fixnum i)) (the fixnum (+ 1 i i))) (defun heap-right (i) (declare (fixnum i)) (the fixnum (+ 2 i i))) (defun heapify (heap i key) "Assume that the children of i are heaps, but that heap[i] may be larger than its children. If it is, move heap[i] down where it belongs. [Page 143 CL&R]." (let ((l (heap-left i)) (r (heap-right i)) (N (- (length heap) 1)) smallest) (setf smallest (if (and (<= l N) (<= (heap-val heap l key) (heap-val heap i key))) l i)) (if (and (<= r N) (<= (heap-val heap r key) (heap-val heap smallest key))) (setf smallest r)) (when (/= smallest i) (rotatef (aref heap i) (aref heap smallest)) (heapify heap smallest key)))) (defun heap-extract-min (heap key) "Pop the best (lowest valued) item off the heap. [Page 150 CL&R]." (let ((min (aref heap 0))) (setf (aref heap 0) (aref heap (- (length heap) 1))) (decf (fill-pointer heap)) (heapify heap 0 key) min)) (defun heap-insert (heap item key) "Put an item into a heap. [Page 150 CL&R]." ;; Note that ITEM is the value to be inserted, and KEY is a function ;; that extracts the numeric value from the item. (vector-push-extend nil heap) (let ((i (- (length heap) 1)) (val (funcall key item))) (while (and (> i 0) (>= (heap-val heap (heap-parent i) key) val)) do (setf (aref heap i) (aref heap (heap-parent i)) i (heap-parent i))) (setf (aref heap i) item))) (defun make-heap (&optional (size 100)) (make-array size :fill-pointer 0 :adjustable t)) (defun heap-sort (numbers &key (key #'identity)) "Return a sorted list, with elements that are < according to key first." ;; Mostly for testing the heap implementation ;; There are more efficient ways of sorting (even of heap-sorting) (let ((heap (make-heap)) (result nil)) (for each n in numbers do (heap-insert heap n key)) (while (> (length heap) 0) do (push (heap-extract-min heap key) result)) (nreverse result)))