Add jankass priority queues
author |
Steve Losh <steve@stevelosh.com> |
date |
Wed, 01 Mar 2017 19:32:57 +0000 |
parents |
4d881c990060
|
children |
1a0146c5e62d
|
branches/tags |
(none) |
files |
DOCUMENTATION.markdown losh.lisp make-docs.lisp package.lisp |
Changes
--- a/DOCUMENTATION.markdown Wed Mar 01 19:14:51 2017 +0000
+++ b/DOCUMENTATION.markdown Wed Mar 01 19:32:57 2017 +0000
@@ -1355,6 +1355,63 @@
+## Package `LOSH.PRIORITY-QUEUES`
+
+Jankass priority queue implementation.
+
+### `MAKE-PRIORITY-QUEUE` (function)
+
+ (MAKE-PRIORITY-QUEUE &KEY (PRIORITY-PREDICATE #'<) (ELEMENT-TEST #'EQL))
+
+Create and return a fresh priority queue.
+
+ `priority-predicate` is the comparison function used to compare priorities,
+ and should be a `<`-like predicate.
+
+ `element-test` should be the equality predicate for elements.
+
+
+
+### `PQ-DEQUEUE` (function)
+
+ (PQ-DEQUEUE PQ)
+
+Remove and return the element in `pq` with the lowest-numbered priority.
+
+ If `pq` is empty `nil` will be returned.
+
+ A second value is also returned, which will be `t` if an element was present
+ or `nil` if the priority queue was empty.
+
+
+
+### `PQ-ENSURE` (function)
+
+ (PQ-ENSURE PQ ELEMENT PRIORITY)
+
+Ensure `element` is in `pq` with `priority`.
+
+ If `element` is already in `pq` its priority will be set to `priority`.
+ Otherwise it will be inserted as if by calling `pq-insert`.
+
+ Returns `pq` (which may have been modified).
+
+
+
+### `PQ-INSERT` (function)
+
+ (PQ-INSERT PQ ELEMENT PRIORITY)
+
+Insert `element` into `pq` with `priority`.
+
+ Returns `pq` (which has been modified).
+
+
+
+### `PRIORITY-QUEUE` (struct)
+
+Slots: `CONTENTS`, `PREDICATE`, `TEST`
+
## Package `LOSH.QUEUES`
A simple queue implementation.
--- a/losh.lisp Wed Mar 01 19:14:51 2017 +0000
+++ b/losh.lisp Wed Mar 01 19:32:57 2017 +0000
@@ -616,13 +616,14 @@
;;;; Mutation -----------------------------------------------------------------
-(defun build-zap (place expr env)
- (multiple-value-bind (temps exprs stores store-expr access-expr)
- (get-setf-expansion place env)
- `(let* (,@(mapcar #'list temps exprs)
- (,(car stores) (symbol-macrolet ((% ,access-expr))
- ,expr)))
- ,store-expr)))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun build-zap (place expr env)
+ (multiple-value-bind (temps exprs stores store-expr access-expr)
+ (get-setf-expansion place env)
+ `(let* (,@(mapcar #'list temps exprs)
+ (,(car stores) (symbol-macrolet ((% ,access-expr))
+ ,expr)))
+ ,store-expr))))
(defmacro zapf (&rest place-expr-pairs &environment env)
"Update each `place` by evaluating `expr` with `%` bound to the current value.
@@ -2135,6 +2136,90 @@
(finding item :such-that (< n weight))))
+;;;; Priority Queues ----------------------------------------------------------
+;;; Jankass priority queue implementation.
+(defstruct (priority-queue (:conc-name pq-)
+ (:constructor make-priority-queue%))
+ (contents nil)
+ (predicate #'<)
+ (test #'eql))
+
+
+(defun make-priority-queue (&key (priority-predicate #'<) (element-test #'eql))
+ "Create and return a fresh priority queue.
+
+ `priority-predicate` is the comparison function used to compare priorities,
+ and should be a `<`-like predicate.
+
+ `element-test` should be the equality predicate for elements.
+
+ "
+ (make-priority-queue% :predicate priority-predicate :test element-test))
+
+
+(defmethod print-object ((object priority-queue) stream)
+ (print-unreadable-object (object stream :type t :identity t)
+ (prin1 (pq-contents object) stream)))
+
+
+(defun pqn-priority (node)
+ (first node))
+
+(defun pqn-element (node)
+ (second node))
+
+(defun pq-resort (pq)
+ (zapf (pq-contents pq)
+ (sort % (pq-predicate pq) :key #'pqn-priority))
+ pq)
+
+(defun pq-lookup (pq element)
+ (find element (pq-contents pq)
+ :key #'pqn-element
+ :test (pq-test pq)))
+
+
+(defun pq-insert (pq element priority)
+ "Insert `element` into `pq` with `priority`.
+
+ Returns `pq` (which has been modified).
+
+ "
+ (zapf (pq-contents pq)
+ (merge 'list `((,priority ,element)) % (pq-predicate pq)
+ :key #'pqn-priority))
+ pq)
+
+(defun pq-ensure (pq element priority)
+ "Ensure `element` is in `pq` with `priority`.
+
+ If `element` is already in `pq` its priority will be set to `priority`.
+ Otherwise it will be inserted as if by calling `pq-insert`.
+
+ Returns `pq` (which may have been modified).
+
+ "
+ (let ((existing (pq-lookup pq element)))
+ (if existing
+ (progn (setf (car existing) priority)
+ (pq-resort pq))
+ (pq-insert pq element priority)))
+ pq)
+
+(defun pq-dequeue (pq)
+ "Remove and return the element in `pq` with the lowest-numbered priority.
+
+ If `pq` is empty `nil` will be returned.
+
+ A second value is also returned, which will be `t` if an element was present
+ or `nil` if the priority queue was empty.
+
+ "
+ (if (pq-contents pq)
+ (values (pqn-element (pop (pq-contents pq))) t)
+ (values nil nil)))
+
+
;;;; Hash Sets ----------------------------------------------------------------
(defstruct (hash-set (:constructor make-hash-set%))
(storage (error "Required") :type hash-table :read-only t))
@@ -2352,7 +2437,6 @@
(hash-table-keys storage))
-
;;;; Bit Sets -----------------------------------------------------------------
;;; Implementation of the sets-as-integers idea in the Common Lisp Recipes book.
(deftype bset () '(integer 0))
--- a/make-docs.lisp Wed Mar 01 19:14:51 2017 +0000
+++ b/make-docs.lisp Wed Mar 01 19:32:57 2017 +0000
@@ -19,6 +19,7 @@
"LOSH.LICENSING"
"LOSH.MATH"
"LOSH.MUTATION"
+ "LOSH.PRIORITY-QUEUES"
"LOSH.QUEUES"
"LOSH.RANDOM"
"LOSH.SEQUENCES"
--- a/package.lisp Wed Mar 01 19:14:51 2017 +0000
+++ b/package.lisp Wed Mar 01 19:32:57 2017 +0000
@@ -233,6 +233,16 @@
:notf
:callf))
+(defpackage :losh.priority-queues
+ (:documentation "Jankass priority queue implementation.")
+ (:export
+ :priority-queue
+ :make-priority-queue
+
+ :pq-insert
+ :pq-ensure
+ :pq-dequeue))
+
(defpackage :losh.queues
(:documentation "A simple queue implementation.")
(:export
@@ -302,6 +312,7 @@
:losh.licensing
:losh.math
:losh.mutation
+ :losh.priority-queues
:losh.queues
:losh.random
:losh.sequences