├── .gitignore ├── LICENSE ├── README.md ├── damn-fast-priority-queue ├── damn-fast-priority-queue.asd ├── src.lisp └── test.lisp ├── damn-fast-stable-priority-queue ├── damn-fast-stable-priority-queue.asd ├── src.lisp ├── test-distinct.lisp ├── test-same.lisp └── test.lisp └── priority-queue-benchmark ├── README.md ├── benchmark.lisp └── priority-queue-benchmark.asd /.gitignore: -------------------------------------------------------------------------------- 1 | *.FASL 2 | *.fasl 3 | *.lisp-temp 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2024 Michał "phoe" Herda. 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Damn Fast Priority Queue 2 | 3 | A heap-based priority queue whose first and foremost priority is [**speed**](https://www.youtube.com/watch?v=AkagvXwDsYU). Optionally comes in a stable flavor. 4 | 5 | Blame [@mfiano](https://github.com/mfiano/) for the existence of this library. He's the one who wanted a priority queue that's going to run as fast as possible in one of the hottest loops of his game engine ~~and then figured out that hey, he actually doesn't need a prio queue there~~. 6 | 7 | ## License 8 | 9 | MIT. 10 | 11 | ## Systems 12 | 13 | * This repository contains two systems: 14 | * `damn-fast-priority-queue`, a faster but unstable priority queue (elements with the same priority are dequeued in unspecified order), 15 | * `damn-fast-stable-priority-queue`, a fast and stable priority queue (elements with the same priority are dequeued in FIFO order). 16 | * The queues have identical APIs. 17 | * These APIs are not generic, i.e. operators for one queue type must not be used on a queue instance of the other type. 18 | 19 | ## Description 20 | 21 | * The queue enqueues objects along with their priorities. 22 | * The stored objects may be of arbitrary type. 23 | * The objects' priorities must be of type `(unsigned-byte 32)`. 24 | * The queue is a minimum queue (i.e. smallest priorities are dequeued first). 25 | * The queue is unbounded by default. 26 | * The queue's storage automatically expands (which reallocates the queue storage). 27 | * The queue's storage can be manually trimmed (which reallocates the queue storage). 28 | * The queue can instead be configured to signal an error upon reaching its size limit. 29 | * The queue is **not** thread-safe. 30 | * The queue is **not** reentrant. 31 | 32 | ## Implementation details 33 | 34 | * The queue internally uses two simple vectors: one for data, specialized on `t`, and another for priorities, specialized on `(unsigned-byte 32)`. 35 | * The stable queue also uses a third simple vector for storing element insertion order, specialized on `(unsigned-byte 32)`. 36 | * The queue's storage has its initial storage size set to `256`. This value is customizable in the constructor. 37 | * Each time the queue runs out of storage, the storage is reallocated via `adjust-array` and its size is expanded by the `extension-factor` value provided at queue instantiation. 38 | * We assume that using simple vectors, calling `adjust-array` on them, and manually setting queue slots to the new vectors is faster than using adjustable vectors. 39 | 40 | ## Optimization settings 41 | 42 | * The code uses structure classes in favor of standard classes. 43 | * The code uses standard, `inline`-proclaimed functions in favor of generic functions. 44 | * All functions are optimized for maximum `speed`. 45 | * By default, the code retains the default values of `debug`, `safety`, `space`, and `compilation-speed` optimize qualities. To set them all to 0, pray to your favorite deity and push a feature into `*features*` before compiling the respective system. 46 | * for `damn-fast-priority-queue`, push `:real-damn-fast-priority-queue`, 47 | * for `damn-fast-stable-priority-queue`, push `:real-damn-fast-stable-priority-queue`. 48 | 49 | ## Exports 50 | 51 | All exported functions are proclaimed `inline` by default. 52 | 53 | * **Classes** 54 | * `queue` - names the priority queue structure class. 55 | * **Functions** 56 | * `(make-queue &optional initial-storage-size extension-factor extend-queue-p)` - make a priority queue. 57 | * The initial storage size must be a non-negative integer. Its default value is `256`. 58 | * The extension factor value must be a positive integer between `2` and `256`. Its default value is `2`. 59 | * The queue can be configured to signal an error of type `queue-size-limit-reached` when its size is reached, instead of extending its storage. It is possible to retrieve the queue via the `queue-size-limit-reached-queue` reader and the object that was attempted to be stored via `queue-size-limit-reached-object`. 60 | * `(copy-queue queue)` - makes a deep copy of the provided queue (including its storage vectors). 61 | * `(enqueue queue object priority)` - enqueue an object. 62 | * `(dequeue queue)` - dequeue an object. 63 | * Secondary return value is true if the object was found and false if the queue was empty. 64 | * `(peek queue)` - peek at an object that is first to be dequeued. 65 | * Secondary return value is true if the object was found and false if the queue was empty. 66 | * `(size queue)` - get the current element count of the queue. 67 | * `(trim queue)` - trim the queue's storage by calling `adjust-array` on it with the current queue size. 68 | * `(map queue function)` - calls the function on each element of `queue` in unspecified order and returns `nil`. 69 | * **Macros** 70 | * `(do-queue (object queue &optional result) &body body)` - evaluates `body` with `object` bound to each element of `queue` in unspecified order and returns `result`. 71 | 72 | ## Tests 73 | 74 | * For `damn-fast-priority-queue`: 75 | * Non-verbose test: `(asdf:test-system :damn-fast-priority-queue)` 76 | * Verbose test: `(damn-fast-priority-queue/test:run t)` 77 | * For `damn-fast-stable-priority-queue`: 78 | * Non-verbose test: `(asdf:test-system :damn-fast-stable-priority-queue)` 79 | * Verbose test: `(damn-fast-stable-priority-queue/test:run t)` 80 | 81 | ## Performance tests 82 | 83 | See [the Priority Queue Benchmark README](priority-queue-benchmark/README.md). 84 | -------------------------------------------------------------------------------- /damn-fast-priority-queue/damn-fast-priority-queue.asd: -------------------------------------------------------------------------------- 1 | ;;;; damn-fast-priority-queue.asd 2 | 3 | (asdf:defsystem #:damn-fast-priority-queue 4 | :description "A heap-based priority queue whose first and foremost priority is speed." 5 | :author "Michał \"phoe\" Herda " 6 | :license "MIT" 7 | :version "0.0.2" 8 | :serial t 9 | :depends-on (#:alexandria) 10 | :components ((:file "src")) 11 | :in-order-to ((test-op (load-op #:damn-fast-priority-queue/test))) 12 | :perform (test-op (o c) (symbol-call "DAMN-FAST-PRIORITY-QUEUE/TEST" "RUN"))) 13 | 14 | (asdf:defsystem #:damn-fast-priority-queue/test 15 | :description "Tests for Damn Fast Priority Queue" 16 | :author "Michał \"phoe\" Herda " 17 | :license "MIT" 18 | :version "0.0.2" 19 | :serial t 20 | :depends-on (#:alexandria #:damn-fast-priority-queue) 21 | :components ((:file "test"))) 22 | -------------------------------------------------------------------------------- /damn-fast-priority-queue/src.lisp: -------------------------------------------------------------------------------- 1 | ;;;; damn-fast-priority-queue.lisp 2 | 3 | (defpackage #:damn-fast-priority-queue 4 | (:use #:cl) 5 | (:shadow #:map) 6 | (:local-nicknames (#:a #:alexandria)) 7 | (:export #:queue #:make-queue #:copy-queue 8 | #:enqueue #:dequeue #:peek #:size #:trim #:map #:do-queue 9 | #:queue-size-limit-reached 10 | #:queue-size-limit-reached-queue #:queue-size-limit-reached-object)) 11 | 12 | (in-package #:damn-fast-priority-queue) 13 | 14 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 15 | ;;;; Read-time variables 16 | 17 | (eval-when (:compile-toplevel :load-toplevel :execute) 18 | (defparameter *optimize-qualities* 19 | #+real-damn-fast-priority-queue 20 | ;; Good luck. 21 | `(optimize (speed 3) (debug 0) (safety 0) (space 0) (compilation-speed 0)) 22 | #-real-damn-fast-priority-queue 23 | `(optimize (speed 3)))) 24 | 25 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26 | ;;;; Type definitions 27 | 28 | (deftype data-type () 't) 29 | 30 | (deftype data-vector-type () '(simple-array data-type (*))) 31 | 32 | (deftype prio-type () '(unsigned-byte 32)) 33 | 34 | (deftype prio-vector-type () '(simple-array prio-type (*))) 35 | 36 | (deftype extension-factor-type () '(integer 2 256)) 37 | 38 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 39 | ;;;; Structure definition 40 | 41 | (declaim (inline %make %data-vector %prio-vector %size %extension-factor)) 42 | 43 | (defstruct (queue (:conc-name #:%) (:constructor %make) 44 | (:predicate nil) (:copier nil)) 45 | (data-vector (make-array 256 :element-type 'data-type) :type data-vector-type) 46 | (prio-vector (make-array 256 :element-type 'prio-type) :type prio-vector-type) 47 | (size 0 :type a:array-length) 48 | (extension-factor 2 :type extension-factor-type) 49 | (extend-queue-p t :type boolean)) 50 | 51 | (declaim (inline make-queue copy-queue)) 52 | 53 | (declaim (ftype (function 54 | (&optional a:array-index extension-factor-type boolean) 55 | (values queue &optional)) 56 | make-queue)) 57 | (defun make-queue (&optional 58 | (initial-storage-size 256) 59 | (extension-factor 2) 60 | (extend-queue-p t)) 61 | (declare (type extension-factor-type extension-factor)) 62 | (declare #.*optimize-qualities*) 63 | (%make :extension-factor extension-factor 64 | :data-vector (make-array initial-storage-size 65 | :element-type 'data-type) 66 | :prio-vector (make-array initial-storage-size 67 | :element-type 'prio-type) 68 | :extend-queue-p extend-queue-p)) 69 | 70 | (defmethod print-object ((object queue) stream) 71 | (print-unreadable-object (object stream :type t :identity t) 72 | (format stream "(~D)" (%size object)))) 73 | 74 | (declaim (ftype (function (queue) (values queue &optional)) copy-queue)) 75 | (defun copy-queue (queue) 76 | (declare (type queue queue)) 77 | (declare #.*optimize-qualities*) 78 | (%make :extension-factor (%extension-factor queue) 79 | :size (%size queue) 80 | :extend-queue-p (%extend-queue-p queue) 81 | :data-vector (copy-seq (%data-vector queue)) 82 | :prio-vector (copy-seq (%prio-vector queue)))) 83 | 84 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 85 | ;;;; Enqueueing 86 | 87 | (declaim (inline heapify-upwards enqueue)) 88 | 89 | (declaim (ftype (function (data-vector-type prio-vector-type a:array-length) 90 | (values null &optional)) 91 | heapify-upwards)) 92 | (defun heapify-upwards (data-vector prio-vector index) 93 | (declare (type data-vector-type data-vector)) 94 | (declare (type prio-vector-type prio-vector)) 95 | (declare (type a:array-length index)) 96 | (declare #.*optimize-qualities*) 97 | (do ((child-index index parent-index) 98 | (parent-index (ash (1- index) -1) (ash (1- parent-index) -1))) 99 | ((= child-index 0)) 100 | (let ((child-priority (aref prio-vector child-index)) 101 | (parent-priority (aref prio-vector parent-index))) 102 | (cond ((< child-priority parent-priority) 103 | (rotatef (aref prio-vector parent-index) 104 | (aref prio-vector child-index)) 105 | (rotatef (aref data-vector parent-index) 106 | (aref data-vector child-index))) 107 | (t (return)))))) 108 | 109 | (declaim (ftype (function (queue t prio-type) (values null &optional)) enqueue)) 110 | (defun enqueue (queue object priority) 111 | (declare (type queue queue)) 112 | (declare (type prio-type priority)) 113 | (declare #.*optimize-qualities*) 114 | (symbol-macrolet ((data-vector (%data-vector queue)) 115 | (prio-vector (%prio-vector queue))) 116 | (let ((size (%size queue)) 117 | (extension-factor (%extension-factor queue)) 118 | (length (array-total-size data-vector))) 119 | (when (>= size length) 120 | (unless (%extend-queue-p queue) 121 | (error 'queue-size-limit-reached :queue queue :element object)) 122 | (let ((new-length (max 1 (mod (* length extension-factor) 123 | (ash 1 64))))) 124 | (declare (type a:array-length new-length)) 125 | (when (<= new-length length) 126 | (error "Integer overflow while resizing array: new-length ~D is ~ 127 | smaller than old length ~D" new-length length)) 128 | (setf data-vector (adjust-array data-vector new-length) 129 | prio-vector (adjust-array prio-vector new-length)))) 130 | (setf (aref data-vector size) object 131 | (aref prio-vector size) priority) 132 | (heapify-upwards data-vector prio-vector (%size queue)) 133 | (incf (%size queue)) 134 | nil))) 135 | 136 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 137 | ;;;; Dequeueing 138 | 139 | (declaim (inline heapify-downwards dequeue)) 140 | 141 | (declaim (ftype (function (data-vector-type prio-vector-type a:array-index) 142 | (values null &optional)) 143 | heapify-downwards)) 144 | (defun heapify-downwards (data-vector prio-vector size) 145 | (declare (type data-vector-type data-vector)) 146 | (declare (type prio-vector-type prio-vector)) 147 | (declare #.*optimize-qualities*) 148 | (let ((parent-index 0)) 149 | (loop 150 | (let* ((left-index (+ (* parent-index 2) 1)) 151 | (left-index-validp (< left-index size)) 152 | (right-index (+ (* parent-index 2) 2)) 153 | (right-index-validp (< right-index size))) 154 | (flet ((swap-left () 155 | (rotatef (aref prio-vector parent-index) 156 | (aref prio-vector left-index)) 157 | (rotatef (aref data-vector parent-index) 158 | (aref data-vector left-index)) 159 | (setf parent-index left-index)) 160 | (swap-right () 161 | (rotatef (aref prio-vector parent-index) 162 | (aref prio-vector right-index)) 163 | (rotatef (aref data-vector parent-index) 164 | (aref data-vector right-index)) 165 | (setf parent-index right-index))) 166 | (declare (inline swap-left swap-right)) 167 | (when (and (not left-index-validp) 168 | (not right-index-validp)) 169 | (return)) 170 | (when (and left-index-validp 171 | (< (aref prio-vector parent-index) 172 | (aref prio-vector left-index)) 173 | (or (not right-index-validp) 174 | (< (aref prio-vector parent-index) 175 | (aref prio-vector right-index)))) 176 | (return)) 177 | (if (and right-index-validp 178 | (<= (aref prio-vector right-index) 179 | (aref prio-vector left-index))) 180 | (swap-right) 181 | (swap-left))))))) 182 | 183 | (declaim (ftype (function (queue) (values t boolean &optional)) dequeue)) 184 | (defun dequeue (queue) 185 | (declare (type queue queue)) 186 | (declare #.*optimize-qualities*) 187 | (if (= 0 (%size queue)) 188 | (values nil nil) 189 | (let ((data-vector (%data-vector queue)) 190 | (prio-vector (%prio-vector queue))) 191 | (multiple-value-prog1 (values (aref data-vector 0) t) 192 | (decf (%size queue)) 193 | (let ((old-data (aref data-vector (%size queue))) 194 | (old-prio (aref prio-vector (%size queue)))) 195 | (setf (aref data-vector 0) old-data 196 | (aref prio-vector 0) old-prio)) 197 | (heapify-downwards data-vector prio-vector (%size queue)))))) 198 | 199 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 200 | ;;;; Introspection and maintenance 201 | 202 | (declaim (inline peek size trim map)) 203 | 204 | (declaim (ftype (function (queue) (values t boolean &optional)) peek)) 205 | (defun peek (queue) 206 | (declare (type queue queue)) 207 | (declare #.*optimize-qualities*) 208 | (if (= 0 (%size queue)) 209 | (values nil nil) 210 | (values (aref (%data-vector queue) 0) t))) 211 | 212 | (declaim (ftype (function (queue) (values a:array-length &optional)) size)) 213 | (defun size (queue) 214 | (declare (type queue queue)) 215 | (declare #.*optimize-qualities*) 216 | (%size queue)) 217 | 218 | (declaim (ftype (function (queue) (values null &optional)) trim)) 219 | (defun trim (queue) 220 | (declare (type queue queue)) 221 | (declare #.*optimize-qualities*) 222 | (let ((size (%size queue))) 223 | (setf (%data-vector queue) (adjust-array (%data-vector queue) size) 224 | (%prio-vector queue) (adjust-array (%prio-vector queue) size)) 225 | nil)) 226 | 227 | (declaim (ftype (function (queue (function (t) t)) (values null &optional)) 228 | map)) 229 | (defun map (queue function) 230 | (dotimes (i (%size queue)) 231 | (funcall function (aref (%data-vector queue) i)))) 232 | 233 | (defmacro do-queue ((object queue &optional result) &body body) 234 | (multiple-value-bind (forms declarations) (a:parse-body body) 235 | (a:with-gensyms (i) 236 | (a:once-only (queue) 237 | `(dotimes (,i (%size ,queue) ,result) 238 | (let ((,object (aref (%data-vector ,queue) ,i))) 239 | ,@declarations 240 | (tagbody ,@forms))))))) 241 | 242 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 243 | ;;;; Conditions 244 | 245 | (defun report-queue-size-limit-reached (condition stream) 246 | (let ((queue (queue-size-limit-reached-queue condition)) 247 | (element (queue-size-limit-reached-object condition))) 248 | (format stream "Size limit (~D) reached for non-extensible ~ 249 | queue ~S while trying to enqueue element ~S onto it." 250 | (length (%data-vector queue)) queue element))) 251 | 252 | (define-condition queue-size-limit-reached (error) 253 | ((%queue :reader queue-size-limit-reached-queue :initarg :queue) 254 | (%object :reader queue-size-limit-reached-object :initarg :element)) 255 | (:default-initargs :queue (a:required-argument :queue) 256 | :object (a:required-argument :object)) 257 | (:report report-queue-size-limit-reached)) 258 | -------------------------------------------------------------------------------- /damn-fast-priority-queue/test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; damn-fast-priority-queue-test.lisp 2 | 3 | (defpackage #:damn-fast-priority-queue/test 4 | (:use #:cl) 5 | (:local-nicknames (#:a #:alexandria) 6 | (#:q #:damn-fast-priority-queue)) 7 | (:export #:run)) 8 | 9 | (in-package #:damn-fast-priority-queue/test) 10 | 11 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12 | ;;;; Utilities 13 | 14 | (defun verify-heap-property (vector) 15 | (loop with length = (length vector) 16 | for parent from 0 below (truncate length 2) 17 | for left = (+ (* parent 2) 1) 18 | for right = (+ (* parent 2) 2) 19 | do (assert (< (aref vector parent) (aref vector left)) () 20 | "VERIFY-HEAP-PROPERTY: Invalid left child: ~D -> ~D" 21 | (aref vector parent) (aref vector left)) 22 | when (oddp length) 23 | do (assert (< (aref vector parent) (aref vector right)) () 24 | "VERIFY-HEAP-PROPERTY: Invalid right child: ~D -> ~D" 25 | (aref vector parent) (aref vector right)))) 26 | 27 | (defun stringify (i) (format nil "~D" i)) 28 | 29 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 30 | ;;;; Main interface 31 | 32 | (defvar *verbose* nil) 33 | 34 | (defun run (&optional *verbose*) 35 | (dolist (length (nconc (a:iota 64 :start 1) '(256 1024 4096))) 36 | (when *verbose* (format t "~&Testing with ~4,' D elements" length)) 37 | (let ((queue (q:make-queue (max 1 (ash length -4))))) 38 | (perform-test queue (a:iota length)) 39 | (perform-test queue (nreverse (a:iota length))) 40 | (dotimes (i 100) 41 | (perform-test queue (a:shuffle (a:iota length)))))) 42 | (perform-error-test) 43 | (perform-copy-test)) 44 | 45 | (defun perform-test (queue list) 46 | (when *verbose* (princ ".")) 47 | (test-enqueue queue list) 48 | (test-map queue list) 49 | (test-do-queue queue list) 50 | (test-dequeue-and-peek queue list) 51 | (test-dequeue-and-peek-empty queue) 52 | (test-trim queue list)) 53 | 54 | (defun perform-error-test () 55 | (let ((queue (q:make-queue 4 2 nil))) 56 | (dotimes (i 4) (q:enqueue queue (princ-to-string i) i)) 57 | (flet ((perform () 58 | (multiple-value-bind (value error) 59 | (ignore-errors (q:enqueue queue "4" 4)) 60 | (assert (null value)) 61 | (assert (typep error 'q:queue-size-limit-reached)) 62 | (assert (eq queue (q:queue-size-limit-reached-queue error))) 63 | (assert (string= "4" 64 | (q:queue-size-limit-reached-object error)))))) 65 | (dotimes (i 4) (perform))))) 66 | 67 | (defun perform-copy-test () 68 | (let ((queue-1 (q:make-queue))) 69 | (q:enqueue queue-1 42 1) 70 | (let ((queue-2 (q:copy-queue queue-1))) 71 | (q:enqueue queue-2 24 0) 72 | ;; Check QUEUE-1 73 | (multiple-value-bind (value foundp) (q:dequeue queue-1) 74 | (assert (= 42 value)) 75 | (assert (eq t foundp))) 76 | (multiple-value-bind (value foundp) (q:dequeue queue-1) 77 | (assert (null value)) 78 | (assert (null foundp))) 79 | ;; Check QUEUE-2 80 | (multiple-value-bind (value foundp) (q:dequeue queue-2) 81 | (assert (= 24 value)) 82 | (assert (eq t foundp))) 83 | (multiple-value-bind (value foundp) (q:dequeue queue-2) 84 | (assert (= 42 value)) 85 | (assert (eq t foundp))) 86 | (multiple-value-bind (value foundp) (q:dequeue queue-2) 87 | (assert (null value)) 88 | (assert (null foundp)))))) 89 | 90 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 91 | ;;;; Subtests 92 | 93 | (defun test-enqueue (queue list) 94 | (let ((counter 0)) 95 | (dolist (i list) 96 | (q:enqueue queue (stringify i) i) 97 | (assert (= (incf counter) (q:size queue))) 98 | (verify-heap-property (subseq (q::%prio-vector queue) 99 | 0 (q:size queue)))))) 100 | 101 | (defun test-map (queue list) 102 | (let ((expected (reduce #'+ list)) 103 | (actual 0)) 104 | (q:map queue (lambda (x) (incf actual (parse-integer x)))) 105 | (assert (= expected actual)))) 106 | 107 | (defun test-do-queue (queue list) 108 | (let ((expected (reduce #'+ list)) 109 | (actual 0)) 110 | (q:do-queue (x queue) (incf actual (parse-integer x))) 111 | (assert (= expected actual)))) 112 | 113 | (defun test-dequeue (queue expected-value expected-foundp) 114 | (multiple-value-bind (value foundp) (q:dequeue queue) 115 | (assert (equal expected-value value)) 116 | (assert (eql expected-foundp foundp)))) 117 | 118 | (defun test-peek (queue expected-value expected-foundp) 119 | (multiple-value-bind (value foundp) (q:peek queue) 120 | (assert (equal expected-value value)) 121 | (assert (eql expected-foundp foundp)))) 122 | 123 | (defun test-dequeue-and-peek (queue list) 124 | (let ((counter (q:size queue))) 125 | (dotimes (i (length list)) 126 | (test-peek queue (stringify i) t) 127 | (assert (= counter (q:size queue))) 128 | (test-dequeue queue (stringify i) t) 129 | (assert (= (decf counter) (q:size queue)))))) 130 | 131 | (defun test-dequeue-and-peek-empty (queue) 132 | (test-peek queue nil nil) 133 | (assert (= 0 (q:size queue))) 134 | (test-dequeue queue nil nil) 135 | (assert (= 0 (q:size queue)))) 136 | 137 | (defun test-trim (queue list) 138 | (assert (<= (length list) (length (q::%prio-vector queue)))) 139 | (assert (<= (length list) (length (q::%data-vector queue)))) 140 | (q:trim queue) 141 | (assert (= 0 (length (q::%prio-vector queue)))) 142 | (assert (= 0 (length (q::%data-vector queue))))) 143 | -------------------------------------------------------------------------------- /damn-fast-stable-priority-queue/damn-fast-stable-priority-queue.asd: -------------------------------------------------------------------------------- 1 | ;;;; damn-fast-stable-priority-queue.asd 2 | 3 | (asdf:defsystem #:damn-fast-stable-priority-queue 4 | :description "A heap-based stable priority queue whose first and foremost priority is speed." 5 | :author "Michał \"phoe\" Herda " 6 | :license "MIT" 7 | :version "0.0.2" 8 | :serial t 9 | :depends-on (#:alexandria) 10 | :components ((:file "src")) 11 | :in-order-to ((test-op (load-op #:damn-fast-stable-priority-queue/test))) 12 | :perform (test-op (o c) (symbol-call "DAMN-FAST-STABLE-PRIORITY-QUEUE/TEST" "RUN"))) 13 | 14 | (asdf:defsystem #:damn-fast-stable-priority-queue/test 15 | :description "Tests for Damn Fast Stable Priority Queue" 16 | :author "Michał \"phoe\" Herda " 17 | :license "MIT" 18 | :version "0.0.2" 19 | :serial t 20 | :depends-on (#:alexandria #:damn-fast-stable-priority-queue) 21 | :components ((:file "test-distinct") 22 | (:file "test-same") 23 | (:file "test"))) 24 | -------------------------------------------------------------------------------- /damn-fast-stable-priority-queue/src.lisp: -------------------------------------------------------------------------------- 1 | ;;;; damn-fast-stable-priority-queue.lisp 2 | 3 | (defpackage #:damn-fast-stable-priority-queue 4 | (:use #:cl) 5 | (:shadow #:map) 6 | (:local-nicknames (#:a #:alexandria)) 7 | (:export #:queue #:make-queue #:copy-queue 8 | #:enqueue #:dequeue #:peek #:size #:trim #:map #:do-queue 9 | #:queue-size-limit-reached 10 | #:queue-size-limit-reached-queue 11 | #:queue-size-limit-reached-object)) 12 | 13 | (in-package #:damn-fast-stable-priority-queue) 14 | 15 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16 | ;;;; Read-time variables 17 | 18 | (eval-when (:compile-toplevel :load-toplevel :execute) 19 | (defparameter *optimize-qualities* 20 | #+real-damn-fast-stable-priority-queue 21 | ;; Good luck. 22 | `(optimize (speed 3) (debug 0) (safety 0) (space 0) (compilation-speed 0)) 23 | #-real-damn-fast-stable-priority-queue 24 | `(optimize (speed 3)))) 25 | 26 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 27 | ;;;; Type definitions 28 | 29 | (deftype data-type () 't) 30 | 31 | (deftype data-vector-type () '(simple-array data-type (*))) 32 | 33 | (deftype prio-type () '(unsigned-byte 32)) 34 | 35 | (deftype prio-vector-type () '(simple-array prio-type (*))) 36 | 37 | (deftype count-type () '(unsigned-byte 32)) 38 | 39 | (deftype count-vector-type () '(simple-array count-type (*))) 40 | 41 | (deftype extension-factor-type () '(integer 2 256)) 42 | 43 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 44 | ;;;; Structure definition 45 | 46 | (declaim (inline %make %data-vector %prio-vector %count-vector %count %size 47 | %extension-factor)) 48 | 49 | (defstruct (queue (:conc-name #:%) (:constructor %make) 50 | (:predicate nil) (:copier nil)) 51 | (data-vector (make-array 256 :element-type 'data-type) 52 | :type data-vector-type) 53 | (prio-vector (make-array 256 :element-type 'prio-type) 54 | :type prio-vector-type) 55 | (count-vector (make-array 256 :element-type 'count-type) 56 | :type count-vector-type) 57 | (count 0 :type count-type) 58 | (size 0 :type a:array-length) 59 | (extension-factor 2 :type extension-factor-type) 60 | (extend-queue-p t :type boolean)) 61 | 62 | (declaim (inline make-queue copy-queue)) 63 | 64 | (declaim (ftype (function 65 | (&optional a:array-index extension-factor-type boolean) 66 | (values queue &optional)) 67 | make-queue)) 68 | (defun make-queue (&optional 69 | (initial-storage-size 256) 70 | (extension-factor 2) 71 | (extend-queue-p t)) 72 | (declare (type extension-factor-type extension-factor)) 73 | (declare #.*optimize-qualities*) 74 | (%make :extension-factor extension-factor 75 | :data-vector (make-array initial-storage-size 76 | :element-type 'data-type) 77 | :prio-vector (make-array initial-storage-size 78 | :element-type 'prio-type) 79 | :count-vector (make-array initial-storage-size 80 | :element-type 'count-type) 81 | :extend-queue-p extend-queue-p)) 82 | 83 | (defmethod print-object ((object queue) stream) 84 | (print-unreadable-object (object stream :type t :identity t) 85 | (format stream "(~D)" (%size object)))) 86 | 87 | (declaim (ftype (function (queue) (values queue &optional)) copy-queue)) 88 | (defun copy-queue (queue) 89 | (declare (type queue queue)) 90 | (declare #.*optimize-qualities*) 91 | (%make :extension-factor (%extension-factor queue) 92 | :size (%size queue) 93 | :count (%count queue) 94 | :extend-queue-p (%extend-queue-p queue) 95 | :data-vector (copy-seq (%data-vector queue)) 96 | :prio-vector (copy-seq (%prio-vector queue)) 97 | :count-vector (copy-seq (%count-vector queue)))) 98 | 99 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 100 | ;;;; Enqueueing 101 | 102 | (declaim (inline heapify-upwards enqueue)) 103 | 104 | (declaim (ftype (function (data-vector-type prio-vector-type count-vector-type 105 | a:array-length) 106 | (values null &optional)) 107 | heapify-upwards)) 108 | (defun heapify-upwards (data-vector prio-vector count-vector index) 109 | (declare (type data-vector-type data-vector)) 110 | (declare (type prio-vector-type prio-vector)) 111 | (declare (type count-vector-type count-vector)) 112 | (declare (type a:array-length index)) 113 | (declare #.*optimize-qualities*) 114 | (do ((child-index index parent-index) 115 | (parent-index (ash (1- index) -1) (ash (1- parent-index) -1))) 116 | ((= child-index 0)) 117 | (let ((child-priority (aref prio-vector child-index)) 118 | (parent-priority (aref prio-vector parent-index))) 119 | (cond ((or (< child-priority parent-priority) 120 | (and (= child-priority parent-priority) 121 | (let ((child-count (aref count-vector child-index)) 122 | (parent-count (aref count-vector parent-index))) 123 | (< child-count parent-count)))) 124 | (rotatef (aref prio-vector parent-index) 125 | (aref prio-vector child-index)) 126 | (rotatef (aref data-vector parent-index) 127 | (aref data-vector child-index)) 128 | (rotatef (aref count-vector parent-index) 129 | (aref count-vector child-index))) 130 | (t (return)))))) 131 | 132 | (declaim (ftype (function (queue t prio-type) (values null &optional)) enqueue)) 133 | (defun enqueue (queue object priority) 134 | (declare (type queue queue)) 135 | (declare (type prio-type priority)) 136 | (declare #.*optimize-qualities*) 137 | (symbol-macrolet ((data-vector (%data-vector queue)) 138 | (prio-vector (%prio-vector queue)) 139 | (count-vector (%count-vector queue))) 140 | (let ((size (%size queue)) 141 | (count (%count queue)) 142 | (extension-factor (%extension-factor queue)) 143 | (length (array-total-size data-vector))) 144 | (when (>= size length) 145 | (unless (%extend-queue-p queue) 146 | (error 'queue-size-limit-reached :queue queue :element object)) 147 | (let ((new-length (max 1 (mod (* length extension-factor) 148 | (ash 1 64))))) 149 | (declare (type a:array-length new-length)) 150 | (when (<= new-length length) 151 | (error "Integer overflow while resizing array: new-length ~D is ~ 152 | smaller than old length ~D" new-length length)) 153 | (setf data-vector (adjust-array data-vector new-length) 154 | prio-vector (adjust-array prio-vector new-length) 155 | count-vector (adjust-array count-vector new-length)))) 156 | (setf (aref data-vector size) object 157 | (aref prio-vector size) priority 158 | (aref count-vector size) count) 159 | (heapify-upwards data-vector prio-vector count-vector (%size queue)) 160 | (incf (%size queue)) 161 | (incf (%count queue)) 162 | nil))) 163 | 164 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 165 | ;;;; Dequeueing 166 | 167 | (declaim (inline heapify-downwards dequeue)) 168 | 169 | (declaim (ftype (function (data-vector-type prio-vector-type count-vector-type 170 | a:array-index) 171 | (values null &optional)) 172 | heapify-downwards)) 173 | (defun heapify-downwards (data-vector prio-vector count-vector size) 174 | (declare (type data-vector-type data-vector)) 175 | (declare (type prio-vector-type prio-vector)) 176 | (declare (type count-vector-type count-vector)) 177 | (declare #.*optimize-qualities*) 178 | (let ((parent-index 0)) 179 | (declare (type (unsigned-byte 48) parent-index)) 180 | (loop 181 | (let* ((left-index (+ (* parent-index 2) 1)) 182 | (left-index-validp (< left-index size)) 183 | (right-index (+ (* parent-index 2) 2)) 184 | (right-index-validp (< right-index size))) 185 | (flet ((swap-left () 186 | ;;(print "swap-left") 187 | (rotatef (aref prio-vector parent-index) 188 | (aref prio-vector left-index)) 189 | (rotatef (aref data-vector parent-index) 190 | (aref data-vector left-index)) 191 | (rotatef (aref count-vector parent-index) 192 | (aref count-vector left-index)) 193 | (setf parent-index left-index)) 194 | (swap-right () 195 | ;;(print "swap-right") 196 | (rotatef (aref prio-vector parent-index) 197 | (aref prio-vector right-index)) 198 | (rotatef (aref data-vector parent-index) 199 | (aref data-vector right-index)) 200 | (rotatef (aref count-vector parent-index) 201 | (aref count-vector right-index)) 202 | (setf parent-index right-index))) 203 | (declare (inline swap-left swap-right)) 204 | (when (and (not left-index-validp) 205 | (not right-index-validp)) 206 | (return)) 207 | (when (and left-index-validp 208 | (or (< (aref prio-vector parent-index) 209 | (aref prio-vector left-index)) 210 | (and (= (aref prio-vector parent-index) 211 | (aref prio-vector left-index)) 212 | (< (aref count-vector parent-index) 213 | (aref count-vector left-index)))) 214 | (or (not right-index-validp) 215 | (< (aref prio-vector parent-index) 216 | (aref prio-vector right-index)) 217 | (and (= (aref prio-vector parent-index) 218 | (aref prio-vector right-index)) 219 | (< (aref count-vector parent-index) 220 | (aref count-vector right-index))))) 221 | (return)) 222 | (if (and right-index-validp 223 | (or (< (aref prio-vector right-index) 224 | (aref prio-vector left-index)) 225 | (and (= (aref prio-vector right-index) 226 | (aref prio-vector left-index)) 227 | (< (aref count-vector right-index) 228 | (aref count-vector left-index))))) 229 | (swap-right) 230 | (swap-left))))))) 231 | 232 | (declaim (ftype (function (queue) (values t boolean &optional)) dequeue)) 233 | (defun dequeue (queue) 234 | (declare (type queue queue)) 235 | (declare #.*optimize-qualities*) 236 | (if (= 0 (%size queue)) 237 | (values nil nil) 238 | (let ((data-vector (%data-vector queue)) 239 | (prio-vector (%prio-vector queue)) 240 | (count-vector (%count-vector queue))) 241 | (multiple-value-prog1 (values (aref data-vector 0) t) 242 | (decf (%size queue)) 243 | (let ((old-data (aref data-vector (%size queue))) 244 | (old-prio (aref prio-vector (%size queue))) 245 | (old-count (aref count-vector (%size queue)))) 246 | (setf (aref data-vector 0) old-data 247 | (aref prio-vector 0) old-prio 248 | (aref count-vector 0) old-count)) 249 | (heapify-downwards data-vector prio-vector count-vector 250 | (%size queue)))))) 251 | 252 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 253 | ;;;; Introspection and maintenance 254 | 255 | (declaim (inline peek size trim)) 256 | 257 | (declaim (ftype (function (queue) (values t boolean &optional)) peek)) 258 | (defun peek (queue) 259 | (declare (type queue queue)) 260 | (declare #.*optimize-qualities*) 261 | (if (= 0 (%size queue)) 262 | (values nil nil) 263 | (values (aref (%data-vector queue) 0) t))) 264 | 265 | (declaim (ftype (function (queue) (values a:array-length &optional)) size)) 266 | (defun size (queue) 267 | (declare (type queue queue)) 268 | (declare #.*optimize-qualities*) 269 | (%size queue)) 270 | 271 | (declaim (ftype (function (queue) (values null &optional)) trim)) 272 | (defun trim (queue) 273 | (declare (type queue queue)) 274 | (declare #.*optimize-qualities*) 275 | (let ((size (%size queue))) 276 | (setf (%data-vector queue) (adjust-array (%data-vector queue) size) 277 | (%prio-vector queue) (adjust-array (%prio-vector queue) size) 278 | (%count-vector queue) (adjust-array (%count-vector queue) size)) 279 | nil)) 280 | 281 | (declaim (ftype (function (queue (function (t) t)) (values null &optional)) 282 | map)) 283 | (defun map (queue function) 284 | (dotimes (i (%size queue)) 285 | (funcall function (aref (%data-vector queue) i)))) 286 | 287 | (defmacro do-queue ((object queue &optional result) &body body) 288 | (multiple-value-bind (forms declarations) (a:parse-body body) 289 | (a:with-gensyms (i) 290 | (a:once-only (queue) 291 | `(dotimes (,i (%size ,queue) ,result) 292 | (let ((,object (aref (%data-vector ,queue) ,i))) 293 | ,@declarations 294 | (tagbody ,@forms))))))) 295 | 296 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 297 | ;;;; Conditions 298 | 299 | (defun report-queue-size-limit-reached (condition stream) 300 | (let ((queue (queue-size-limit-reached-queue condition)) 301 | (element (queue-size-limit-reached-object condition))) 302 | (format stream "Size limit (~D) reached for non-extensible ~ 303 | queue ~S while trying to enqueue element ~S onto it." 304 | (length (%data-vector queue)) queue element))) 305 | 306 | (define-condition queue-size-limit-reached (error) 307 | ((%queue :reader queue-size-limit-reached-queue :initarg :queue) 308 | (%object :reader queue-size-limit-reached-object :initarg :element)) 309 | (:default-initargs :queue (a:required-argument :queue) 310 | :object (a:required-argument :object)) 311 | (:report report-queue-size-limit-reached)) 312 | -------------------------------------------------------------------------------- /damn-fast-stable-priority-queue/test-distinct.lisp: -------------------------------------------------------------------------------- 1 | ;;;; damn-fast-stable-priority-queue-test-distinct.lisp 2 | 3 | (defpackage #:damn-fast-stable-priority-queue/test-distinct-priorities 4 | (:use #:cl) 5 | (:local-nicknames (#:a #:alexandria) 6 | (#:q #:damn-fast-stable-priority-queue)) 7 | (:export #:run)) 8 | 9 | (in-package #:damn-fast-stable-priority-queue/test-distinct-priorities) 10 | 11 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12 | ;;;; Utilities 13 | 14 | (defun verify-heap-property (vector) 15 | (loop with length = (length vector) 16 | for parent from 0 below (truncate length 2) 17 | for left = (+ (* parent 2) 1) 18 | for right = (+ (* parent 2) 2) 19 | do (assert (< (aref vector parent) (aref vector left)) () 20 | "VERIFY-HEAP-PROPERTY: Invalid left child: ~D -> ~D" 21 | (aref vector parent) (aref vector left)) 22 | when (oddp length) 23 | do (assert (< (aref vector parent) (aref vector right)) () 24 | "VERIFY-HEAP-PROPERTY: Invalid right child: ~D -> ~D" 25 | (aref vector parent) (aref vector right)))) 26 | 27 | (defun stringify (i) (format nil "~D" i)) 28 | 29 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 30 | ;;;; Main interface 31 | 32 | (defvar *verbose* nil) 33 | 34 | (defun run (&optional *verbose*) 35 | (dolist (length (nconc (a:iota 64 :start 1) '(256 1024 4096))) 36 | (when *verbose* (format t "~&Testing with ~4,' D elements" length)) 37 | (let ((queue (q:make-queue (max 1 (ash length -4))))) 38 | (perform-test queue (a:iota length)) 39 | (perform-test queue (nreverse (a:iota length))) 40 | (dotimes (i 100) 41 | (perform-test queue (a:shuffle (a:iota length))))))) 42 | 43 | (defun perform-test (queue list) 44 | (when *verbose* (princ ".")) 45 | (test-enqueue queue list) 46 | (test-map queue list) 47 | (test-do-queue queue list) 48 | (test-dequeue-and-peek queue list) 49 | (test-dequeue-and-peek-empty queue) 50 | (test-trim queue list)) 51 | 52 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 53 | ;;;; Subtests 54 | 55 | (defun test-enqueue (queue list) 56 | (let ((counter 0)) 57 | (dolist (i list) 58 | (q:enqueue queue (stringify i) i) 59 | (assert (= (incf counter) (q:size queue))) 60 | (verify-heap-property (subseq (q::%prio-vector queue) 61 | 0 (q:size queue)))))) 62 | 63 | (defun test-map (queue list) 64 | (let ((expected (reduce #'+ list)) 65 | (actual 0)) 66 | (q:map queue (lambda (x) (incf actual (parse-integer x)))) 67 | (assert (= expected actual)))) 68 | 69 | (defun test-do-queue (queue list) 70 | (let ((expected (reduce #'+ list)) 71 | (actual 0)) 72 | (q:do-queue (x queue) (incf actual (parse-integer x))) 73 | (assert (= expected actual)))) 74 | 75 | (defun test-dequeue (queue expected-value expected-foundp) 76 | (multiple-value-bind (value foundp) (q:dequeue queue) 77 | (assert (equal expected-value value)) 78 | (assert (eql expected-foundp foundp)))) 79 | 80 | (defun test-peek (queue expected-value expected-foundp) 81 | (multiple-value-bind (value foundp) (q:peek queue) 82 | (assert (equal expected-value value)) 83 | (assert (eql expected-foundp foundp)))) 84 | 85 | (defun test-dequeue-and-peek (queue list) 86 | (let ((counter (q:size queue))) 87 | (dotimes (i (length list)) 88 | (test-peek queue (stringify i) t) 89 | (assert (= counter (q:size queue))) 90 | (test-dequeue queue (stringify i) t) 91 | (assert (= (decf counter) (q:size queue)))))) 92 | 93 | (defun test-dequeue-and-peek-empty (queue) 94 | (test-peek queue nil nil) 95 | (assert (= 0 (q:size queue))) 96 | (test-dequeue queue nil nil) 97 | (assert (= 0 (q:size queue)))) 98 | 99 | (defun test-trim (queue list) 100 | (assert (<= (length list) (length (q::%prio-vector queue)))) 101 | (assert (<= (length list) (length (q::%data-vector queue)))) 102 | (assert (<= (length list) (length (q::%count-vector queue)))) 103 | (q:trim queue) 104 | (assert (= 0 (length (q::%prio-vector queue)))) 105 | (assert (= 0 (length (q::%data-vector queue)))) 106 | (assert (= 0 (length (q::%count-vector queue))))) 107 | -------------------------------------------------------------------------------- /damn-fast-stable-priority-queue/test-same.lisp: -------------------------------------------------------------------------------- 1 | ;;;; damn-fast-stable-priority-queue-test-same.lisp 2 | 3 | (defpackage #:damn-fast-stable-priority-queue/test-same-priorities 4 | (:use #:cl) 5 | (:local-nicknames (#:a #:alexandria) 6 | (#:q #:damn-fast-stable-priority-queue)) 7 | (:export #:run)) 8 | 9 | (in-package #:damn-fast-stable-priority-queue/test-same-priorities) 10 | 11 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 12 | ;;;; Utilities 13 | 14 | (defun verify-heap-property (vector) 15 | (loop with length = (length vector) 16 | for parent from 0 below (truncate length 2) 17 | for left = (+ (* parent 2) 1) 18 | for right = (+ (* parent 2) 2) 19 | do (assert (< (aref vector parent) (aref vector left)) () 20 | "VERIFY-HEAP-PROPERTY: Invalid left child: ~D -> ~D" 21 | (aref vector parent) (aref vector left)) 22 | when (oddp length) 23 | do (assert (< (aref vector parent) (aref vector right)) () 24 | "VERIFY-HEAP-PROPERTY: Invalid right child: ~D -> ~D" 25 | (aref vector parent) (aref vector right)))) 26 | 27 | (defun stringify (i) (format nil "~D" i)) 28 | 29 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 30 | ;;;; Main interface 31 | 32 | (defvar *verbose* nil) 33 | 34 | (defun run (&optional *verbose*) 35 | (dolist (length (nconc (a:iota 64 :start 1) '(256 1024 4096))) 36 | (when *verbose* (format t "~&Testing with ~4,' D elements" length)) 37 | (let ((queue (q:make-queue (max 1 (ash length -4))))) 38 | (perform-test queue (a:iota length)) 39 | (perform-test queue (nreverse (a:iota length))) 40 | (dotimes (i 100) 41 | (perform-test queue (a:shuffle (a:iota length))))))) 42 | 43 | (defun perform-test (queue list) 44 | (when *verbose* (princ ".")) 45 | (test-enqueue queue list) 46 | (test-map queue list) 47 | (test-do-queue queue list) 48 | (test-dequeue-and-peek queue list) 49 | (test-dequeue-and-peek-empty queue) 50 | (test-trim queue list) 51 | (setf (q::%count queue) 0)) 52 | 53 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 54 | ;;;; Subtests 55 | 56 | (defun test-enqueue (queue list) 57 | (let ((counter 0)) 58 | (dolist (i list) 59 | (q:enqueue queue (stringify i) 0) 60 | (assert (= (incf counter) (q:size queue))) 61 | (verify-heap-property (subseq (q::%count-vector queue) 62 | 0 (q:size queue)))))) 63 | 64 | (defun test-map (queue list) 65 | (let ((expected (reduce #'+ list)) 66 | (actual 0)) 67 | (q:map queue (lambda (x) (incf actual (parse-integer x)))) 68 | (assert (= expected actual)))) 69 | 70 | (defun test-do-queue (queue list) 71 | (let ((expected (reduce #'+ list)) 72 | (actual 0)) 73 | (q:do-queue (x queue) (incf actual (parse-integer x))) 74 | (assert (= expected actual)))) 75 | 76 | (defun test-dequeue (queue expected-value expected-foundp) 77 | (multiple-value-bind (value foundp) (q:dequeue queue) 78 | (assert (equal expected-value value)) 79 | (assert (eql expected-foundp foundp)))) 80 | 81 | (defun test-peek (queue expected-value expected-foundp) 82 | (multiple-value-bind (value foundp) (q:peek queue) 83 | (assert (equal expected-value value)) 84 | (assert (eql expected-foundp foundp)))) 85 | 86 | (defun test-dequeue-and-peek (queue list) 87 | (let ((counter (q:size queue))) 88 | (loop for i from 0 89 | for elt in list 90 | do (test-peek queue (stringify elt) t) 91 | (assert (= counter (q:size queue))) 92 | (test-dequeue queue (stringify elt) t) 93 | (assert (= (decf counter) (q:size queue)))))) 94 | 95 | (defun test-dequeue-and-peek-empty (queue) 96 | (test-peek queue nil nil) 97 | (assert (= 0 (q:size queue))) 98 | (test-dequeue queue nil nil) 99 | (assert (= 0 (q:size queue)))) 100 | 101 | (defun test-trim (queue list) 102 | (assert (<= (length list) (length (q::%prio-vector queue)))) 103 | (assert (<= (length list) (length (q::%data-vector queue)))) 104 | (assert (<= (length list) (length (q::%count-vector queue)))) 105 | (q:trim queue) 106 | (assert (= 0 (length (q::%prio-vector queue)))) 107 | (assert (= 0 (length (q::%data-vector queue)))) 108 | (assert (= 0 (length (q::%count-vector queue))))) 109 | -------------------------------------------------------------------------------- /damn-fast-stable-priority-queue/test.lisp: -------------------------------------------------------------------------------- 1 | ;;;; damn-fast-stable-priority-queue-test.lisp 2 | 3 | (defpackage #:damn-fast-stable-priority-queue/test 4 | (:use #:cl) 5 | (:local-nicknames (#:q #:damn-fast-stable-priority-queue)) 6 | (:export #:run)) 7 | 8 | (in-package #:damn-fast-stable-priority-queue/test) 9 | 10 | (defun run (&optional verbose) 11 | (when verbose (format t "~&;;; Testing with the same priorities.")) 12 | (damn-fast-stable-priority-queue/test-same-priorities:run verbose) 13 | (when verbose (format t "~&;;; Testing with distinct priorities.")) 14 | (damn-fast-stable-priority-queue/test-distinct-priorities:run verbose) 15 | (when verbose (format t "~&;;; Testing semantics.")) 16 | (perform-error-test) 17 | (perform-copy-test) 18 | (when verbose (format t "~&;;; Test complete."))) 19 | 20 | (defun perform-error-test () 21 | (let ((queue (q:make-queue 4 2 nil))) 22 | (dotimes (i 4) (q:enqueue queue (princ-to-string i) i)) 23 | (flet ((perform () 24 | (multiple-value-bind (value error) 25 | (ignore-errors (q:enqueue queue "4" 4)) 26 | (assert (null value)) 27 | (assert (typep error 'q:queue-size-limit-reached)) 28 | (assert (eq queue (q:queue-size-limit-reached-queue error))) 29 | (assert (string= "4" 30 | (q:queue-size-limit-reached-object error)))))) 31 | (dotimes (i 4) (perform))))) 32 | 33 | (defun perform-copy-test () 34 | (let ((queue-1 (q:make-queue))) 35 | (q:enqueue queue-1 42 1) 36 | (let ((queue-2 (q:copy-queue queue-1))) 37 | (q:enqueue queue-2 24 0) 38 | ;; Check QUEUE-1 39 | (multiple-value-bind (value foundp) (q:dequeue queue-1) 40 | (assert (= 42 value)) 41 | (assert (eq t foundp))) 42 | (multiple-value-bind (value foundp) (q:dequeue queue-1) 43 | (assert (null value)) 44 | (assert (null foundp))) 45 | ;; Check QUEUE-2 46 | (multiple-value-bind (value foundp) (q:dequeue queue-2) 47 | (assert (= 24 value)) 48 | (assert (eq t foundp))) 49 | (multiple-value-bind (value foundp) (q:dequeue queue-2) 50 | (assert (= 42 value)) 51 | (assert (eq t foundp))) 52 | (multiple-value-bind (value foundp) (q:dequeue queue-2) 53 | (assert (null value)) 54 | (assert (null foundp)))))) 55 | -------------------------------------------------------------------------------- /priority-queue-benchmark/README.md: -------------------------------------------------------------------------------- 1 | # Priority Queue Benchmark 2 | 3 | The ASDF system `priority-queue-benchmark` contains a simple performance test with three tweakable parameters: 4 | * `+capacity+` - how many elements will be pushed into the queue, 5 | * `+repeat-count+` - how many times the test will be repeated, 6 | * `+pass-capacity-p+` - should the test pass the value of `+capacity+` into the queue? 7 | * Note: not all tested queue libraries support passing the initial capacity or extension factor as parameters when constructing the queue. Therefore, for some libraries, this parameter is a no-op. 8 | 9 | The performance test includes multiple priority queue/heap libraries available on Quicklisp, tested against four synthetic datasets: 10 | * an array of unique numbers from `0` to `n`, in increasing order, 11 | * an array of unique numbers from `0` to `n`, in decreasing order, 12 | * an array of unique numbers from `0` to `n`, in shuffled order, 13 | * an array of `n` zeroes. 14 | 15 | All test functions are compiled with `(optimize speed)`. 16 | 17 | `:real-damn-fast-priority-queue` is `:damn-fast-priority-queue` compiled with `:real-damn-fast-priority-queue` pushed into `*features*`. 18 | 19 | `:real-damn-fast-stable-priority-queue` is `:damn-fast-stable-priority-queue` compiled with `:real-damn-fast-stable-priority-queue` pushed into `*features*`. 20 | 21 | The listed timing does not include the time required to prepare the test vectors or to construct the priority queue object. 22 | 23 | Please feel free to question, verify, and improve the code and results of this benchmark. 24 | 25 | ## 409600 elements, 10 repeats, capacity passed 26 | 27 | | Library \ Vector | :increasing | :decreasing | :shuffled | :zero | 28 | |---------------------------------------|-------------|-------------|-----------|-----------| 29 | | :pettomato-indexed-priority-queue | 4.323 | 5.943 | 6.463 | 0.687 | 30 | | :priority-queue | 6.335 | 10.195 | 7.251 | 0.911 | 31 | | :queues.priority-queue | 7.663 | 7.295 | 13.539 | 3.463 | 32 | | :pileup | 2.019 | 2.207 | 2.143 | 2.083 | 33 | | :bodge-heap | 5.703 | 12.203 | 6.359 | 5.039 | 34 | | :cl-heap | 9.483 | 10.471 | 28.119 | 29.563 | 35 | | :heap | 9.491 | 12.167 | 9.287 | 0.895 | 36 | | :minheap | 6.335 | 7.951 | 7.663 | **0.551** | 37 | | :damn-fast-priority-queue | **0.599** | **0.719** | **0.819** | 0.631 | 38 | | :real-damn-fast-priority-queue | **0.543** | **0.647** | **0.739** | 0.599 | 39 | | :damn-fast-stable-priority-queue | 0.663 | 0.807 | 1.031 | 0.791 | 40 | | :real-damn-fast-stable-priority-queue | 0.543 | 0.723 | 0.899 | 0.599 | 41 | 42 | ## 409600 elements, 10 repeats, capacity not passed 43 | 44 | | Library \ Vector | :increasing | :decreasing | :shuffled | :zero | 45 | |---------------------------------------|-------------|-------------|-----------|-----------| 46 | | :pettomato-indexed-priority-queue | 4.759 | 5.963 | 7.311 | 0.671 | 47 | | :priority-queue | 6.339 | 10.067 | 7.427 | 0.915 | 48 | | :queues.priority-queue | 7.223 | 7.207 | 11.807 | 3.487 | 49 | | :pileup | 1.851 | 2.187 | 2.111 | 2.103 | 50 | | :bodge-heap | 5.423 | 12.403 | 8.051 | 5.067 | 51 | | :cl-heap | 9.035 | 10.715 | 31.211 | 28.767 | 52 | | :heap | 8.583 | 12.263 | 8.999 | 0.875 | 53 | | :minheap | 5.523 | 7.789 | 11.335 | **0.535** | 54 | | :damn-fast-priority-queue | **0.575** | **0.727** | **0.931** | 0.627 | 55 | | :real-damn-fast-priority-queue | **0.519** | **0.623** | **0.715** | 0.599 | 56 | | :damn-fast-stable-priority-queue | 0.635 | 0.803 | 1.007 | 0.795 | 57 | | :real-damn-fast-stable-priority-queue | 0.555 | 0.727 | 0.887 | 0.639 | 58 | 59 | ## 4096 elements, 1000 repeats, capacity passed 60 | 61 | | Library \ Vector | :increasing | :decreasing | :shuffled | :zero | 62 | |---------------------------------------|-------------|-------------|-----------|-----------| 63 | | :pettomato-indexed-priority-queue | 2.567 | 3.599 | 2.887 | 0.675 | 64 | | :priority-queue | 3.863 | 5.995 | 4.359 | 0.863 | 65 | | :queues.priority-queue | 5.491 | 4.963 | 5.231 | 2.583 | 66 | | :pileup | 1.391 | 1.591 | 1.471 | 1.487 | 67 | | :bodge-heap | 3.471 | 8.271 | 3.991 | 3.127 | 68 | | :cl-heap | 6.467 | 10.795 | 13.807 | 13.807 | 69 | | :heap | 5.187 | 8.339 | 5.587 | 0.879 | 70 | | :minheap | 3.135 | 5.767 | 3.531 | 0.527 | 71 | | :damn-fast-priority-queue | **0.375** | **0.455** | **0.471** | **0.267** | 72 | | :real-damn-fast-priority-queue | **0.327** | **0.371** | **0.411** | **0.215** | 73 | | :damn-fast-stable-priority-queue | 0.435 | 0.491 | 0.511 | 0.491 | 74 | | :real-damn-fast-stable-priority-queue | 0.351 | 0.419 | 0.435 | 0.419 | 75 | 76 | ## 4096 elements, 1000 repeats, capacity not passed 77 | 78 | | Library \ Vector | :increasing | :decreasing | :shuffled | :zero | 79 | |---------------------------------------|-------------|-------------|-----------|-----------| 80 | | :pettomato-indexed-priority-queue | 2.555 | 3.607 | 2.943 | 0.699 | 81 | | :priority-queue | 3.831 | 6.647 | 4.311 | 0.867 | 82 | | :queues.priority-queue | 4.855 | 6.579 | 5.231 | 2.567 | 83 | | :pileup | 1.399 | 1.611 | 1.503 | 1.479 | 84 | | :bodge-heap | 3.419 | 8.199 | 4.171 | 3.107 | 85 | | :cl-heap | 6.479 | 8.527 | 13.967 | 13.987 | 86 | | :heap | 5.243 | 7.539 | 5.619 | 0.915 | 87 | | :minheap | 3.215 | 4.487 | 3.471 | 0.547 | 88 | | :damn-fast-priority-queue | **0.379** | **0.467** | **0.467** | **0.271** | 89 | | :real-damn-fast-priority-queue | **0.323** | **0.387** | **0.415** | **0.215** | 90 | | :damn-fast-stable-priority-queue | 0.403 | 0.491 | 0.495 | 0.491 | 91 | | :real-damn-fast-stable-priority-queue | 0.347 | 0.427 | 0.431 | 0.411 | 92 | -------------------------------------------------------------------------------- /priority-queue-benchmark/benchmark.lisp: -------------------------------------------------------------------------------- 1 | ;;;; benchmark.lisp 2 | 3 | (defpackage #:priority-queue-benchmark 4 | (:use #:cl) 5 | (:local-nicknames (#:a #:alexandria)) 6 | (:export #:run)) 7 | 8 | (in-package #:priority-queue-benchmark) 9 | 10 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 11 | ;;;; Test parameters 12 | 13 | (defconstant +capacity+ 409600) 14 | (defconstant +repeat-count+ 10) 15 | (defconstant +pass-capacity-p+ t) 16 | 17 | (defparameter *test-vectors* 18 | '(:increasing :decreasing :shuffled :zero)) 19 | 20 | (defparameter *test-functions* 21 | (list 'test-pettomato-indexed-priority-queue 22 | 'test-priority-queue 23 | 'test-queues 24 | 'test-pileup 25 | 'test-bodge-heap 26 | 'test-cl-heap 27 | 'test-heap 28 | 'test-minheap 29 | 'test-damn-fast-priority-queue 30 | 'test-damn-fast-stable-priority-queue)) 31 | 32 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 33 | ;;;; Performance testq 34 | 35 | (defun perform-test (name vector-name vector 36 | &key make-fn push-fn peek-fn pop-fn) 37 | (declare (type function make-fn push-fn peek-fn pop-fn)) 38 | (declare (optimize speed)) 39 | (let* ((queue (funcall make-fn))) 40 | (format t "~&;;; Library: ~A" name) 41 | (format t "~&;;; Element order: ~A~%~%" vector-name) 42 | (trivial-garbage:gc :full t) 43 | (time (dotimes (i +repeat-count+) 44 | (map nil (lambda (i) (funcall push-fn queue i)) vector) 45 | (if (eq vector-name :zero) 46 | (dotimes (i +capacity+) 47 | (assert (= 0 (the fixnum (funcall peek-fn queue)))) 48 | (assert (= 0 (the fixnum (funcall pop-fn queue))))) 49 | (dotimes (i +capacity+) 50 | (assert (= i (the fixnum (funcall peek-fn queue)))) 51 | (assert (= i (the fixnum (funcall pop-fn queue)))))))))) 52 | 53 | (defun make-test-vectors () 54 | (declare (optimize speed)) 55 | (let ((zero (make-array +capacity+ 56 | :element-type `(integer 0 ,(1- +capacity+)) 57 | :initial-element 0)) 58 | (increasing (make-array +capacity+ 59 | :element-type `(integer 0 ,(1- +capacity+))))) 60 | (loop for i from 0 below +capacity+ do (setf (aref increasing i) i)) 61 | (let ((decreasing (nreverse (copy-seq increasing))) 62 | (shuffled (a:shuffle (copy-seq increasing)))) 63 | `(,(when (member :increasing *test-vectors*) `(:increasing ,increasing)) 64 | ,(when (member :decreasing *test-vectors*) `(:decreasing ,decreasing)) 65 | ,(when (member :shuffled *test-vectors*) `(:shuffled ,shuffled)) 66 | ,(when (member :zero *test-vectors*) `(:zero ,zero)))))) 67 | 68 | (defun run () 69 | (declare (optimize speed)) 70 | (format t "~&;;; Starting a priority queue performance test.") 71 | (format t "~&;;; Testing with ~D elements and ~D repeats." 72 | +capacity+ +repeat-count+) 73 | (format t "~&;;; ~:[Not p~;P~]assing capacity to constructors.~%~%" 74 | +pass-capacity-p+) 75 | (dolist (data (make-test-vectors)) 76 | (dolist (function *test-functions*) 77 | (apply (the function function) data))) 78 | (format t "~&;;; Performance test complete.~%")) 79 | 80 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 81 | ;;;; Implementations 82 | 83 | (defun test-pettomato-indexed-priority-queue (vector-name vector) 84 | (declare (optimize speed)) 85 | (perform-test 86 | :pettomato-indexed-priority-queue 87 | vector-name vector 88 | :make-fn (lambda () 89 | (if +pass-capacity-p+ 90 | (let* ((hash (make-hash-table :test 'eql))) 91 | (pettomato-indexed-priority-queue:make-empty-queue 92 | #'< 93 | (lambda (item index) (setf (gethash item hash) index)) 94 | (lambda (item) (gethash item hash -1)) 95 | :size +capacity+)) 96 | (let* ((hash (make-hash-table :test 'eql))) 97 | (pettomato-indexed-priority-queue:make-empty-queue 98 | #'< 99 | (lambda (item index) (setf (gethash item hash) index)) 100 | (lambda (item) (gethash item hash -1)))))) 101 | :push-fn (lambda (q i) (pettomato-indexed-priority-queue:queue-insert q i)) 102 | :peek-fn (lambda (q) (pettomato-indexed-priority-queue:queue-peek q)) 103 | :pop-fn (lambda (q) (pettomato-indexed-priority-queue:queue-pop q)))) 104 | 105 | (defun test-priority-queue (vector-name vector) 106 | (declare (optimize speed)) 107 | (perform-test 108 | :priority-queue 109 | vector-name vector 110 | ;; No way to pass the starting capacity. 111 | :make-fn (lambda () (priority-queue:make-pqueue #'<)) 112 | :push-fn (lambda (q i) (priority-queue:pqueue-push i i q)) 113 | :peek-fn (lambda (q) (priority-queue:pqueue-front q)) 114 | :pop-fn (lambda (q) (priority-queue:pqueue-pop q)))) 115 | 116 | (defun test-queues (vector-name vector) 117 | (declare (optimize speed)) 118 | (perform-test 119 | :queues 120 | vector-name vector 121 | ;; No way to pass the starting capacity. 122 | :make-fn (lambda () (queues:make-queue :priority-queue)) 123 | :push-fn (lambda (q i) (queues:qpush q i)) 124 | :peek-fn (lambda (q) (queues:qtop q)) 125 | :pop-fn (lambda (q) (queues:qpop q)))) 126 | 127 | (defun test-pileup (vector-name vector) 128 | (declare (optimize speed)) 129 | (perform-test 130 | :pileup 131 | vector-name vector 132 | :make-fn (lambda () (if +pass-capacity-p+ 133 | (pileup:make-heap #'< :size +capacity+) 134 | (pileup:make-heap #'<))) 135 | :push-fn (lambda (q i) (pileup:heap-insert i q)) 136 | :peek-fn (lambda (q) (pileup:heap-top q)) 137 | :pop-fn (lambda (q) (pileup:heap-pop q)))) 138 | 139 | (defun test-bodge-heap (vector-name vector) 140 | (declare (optimize speed)) 141 | (perform-test 142 | :bodge-heap 143 | vector-name vector 144 | :make-fn (lambda () (if +pass-capacity-p+ 145 | (bodge-heap:make-binary-heap 146 | :expansion-factor +capacity+) 147 | (bodge-heap:make-binary-heap))) 148 | :push-fn (lambda (q i) (bodge-heap:binary-heap-push q i)) 149 | :peek-fn (lambda (q) (bodge-heap:binary-heap-peek q)) 150 | :pop-fn (lambda (q) (bodge-heap:binary-heap-pop q)))) 151 | 152 | (defun test-cl-heap (vector-name vector) 153 | (declare (optimize speed)) 154 | (perform-test 155 | :cl-heap 156 | vector-name vector 157 | :make-fn (lambda () (make-instance 'cl-heap:priority-queue)) 158 | :push-fn (lambda (q i) (cl-heap:enqueue q i i)) 159 | :peek-fn (lambda (q) (cl-heap:peep-at-queue q)) 160 | :pop-fn (lambda (q) (cl-heap:dequeue q)))) 161 | 162 | (defun test-heap (vector-name vector) 163 | (declare (optimize speed)) 164 | (perform-test 165 | :heap 166 | vector-name vector 167 | ;; No way to pass the starting capacity. 168 | :make-fn (lambda () (heap:make-heap #'<)) 169 | :push-fn (lambda (q i) (heap:heap-push i q)) 170 | :peek-fn (lambda (q) (heap:heap-peek q)) 171 | :pop-fn (lambda (q) (heap:heap-pop q)))) 172 | 173 | (defun test-minheap (vector-name vector) 174 | (declare (optimize speed)) 175 | (perform-test 176 | :minheap 177 | vector-name vector 178 | ;; No way to pass the starting capacity. 179 | :make-fn (lambda () (make-instance 'binary-heap:binary-heap)) 180 | :push-fn (lambda (q i) (binary-heap:insert q i i)) 181 | :peek-fn (lambda (q) (binary-heap:peek-min q)) 182 | :pop-fn (lambda (q) (binary-heap:extract-min q)))) 183 | 184 | (defun test-damn-fast-priority-queue (vector-name vector) 185 | (declare (optimize speed)) 186 | (perform-test 187 | :damn-fast-priority-queue 188 | vector-name vector 189 | :make-fn (lambda () (if +pass-capacity-p+ 190 | (damn-fast-priority-queue:make-queue +capacity+) 191 | (damn-fast-priority-queue:make-queue))) 192 | :push-fn (lambda (q i) (damn-fast-priority-queue:enqueue q i i)) 193 | :peek-fn (lambda (q) (damn-fast-priority-queue:peek q)) 194 | :pop-fn (lambda (q) (damn-fast-priority-queue:dequeue q)))) 195 | 196 | (defun test-damn-fast-stable-priority-queue (vector-name vector) 197 | (declare (optimize speed)) 198 | (perform-test 199 | :damn-fast-stable-priority-queue 200 | vector-name vector 201 | :make-fn (lambda () 202 | (if +pass-capacity-p+ 203 | (damn-fast-stable-priority-queue:make-queue +capacity+) 204 | (damn-fast-stable-priority-queue:make-queue))) 205 | :push-fn (lambda (q i) (damn-fast-stable-priority-queue:enqueue q i i)) 206 | :peek-fn (lambda (q) (damn-fast-stable-priority-queue:peek q)) 207 | :pop-fn (lambda (q) (damn-fast-stable-priority-queue:dequeue q)))) 208 | -------------------------------------------------------------------------------- /priority-queue-benchmark/priority-queue-benchmark.asd: -------------------------------------------------------------------------------- 1 | ;;;; priority-queue-benchmark.asd 2 | 3 | (asdf:defsystem #:priority-queue-benchmark 4 | :description "Figure out the fastest priority queue implementation yourself." 5 | :author "Michał \"phoe\" Herda " 6 | :license "MIT" 7 | :version "0.0.1" 8 | :serial t 9 | :depends-on 10 | (;; Benchmark dependencies 11 | #:alexandria #:trivial-garbage 12 | ;; Contestants 13 | #:pettomato-indexed-priority-queue #:priority-queue #:queues.priority-queue 14 | #:pileup #:bodge-heap #:cl-heap #:heap #:minheap 15 | #:damn-fast-priority-queue #:damn-fast-stable-priority-queue) 16 | :components ((:file "benchmark")) 17 | :perform (test-op (o c) (symbol-call "PRIORITY-QUEUE-BENCHMARK" "RUN"))) 18 | --------------------------------------------------------------------------------