--- a/package.lisp Mon Feb 06 14:32:50 2017 +0000
+++ b/package.lisp Wed Feb 15 10:23:50 2017 +0000
@@ -258,6 +258,16 @@
(:export
))
+(defpackage :sand.pq
+ (:use
+ :cl
+ :losh
+ :iterate
+ :sand.quickutils
+ :sand.utils)
+ (:export
+ ))
+
(defpackage :sand.easing
(:use
:cl--- a/sand.asd Mon Feb 06 14:32:50 2017 +0000
+++ b/sand.asd Wed Feb 15 10:23:50 2017 +0000
@@ -33,6 +33,7 @@
:sketch
:split-sequence
:trivia
+ :trivial-main-thread
:vex
:yason
@@ -49,6 +50,7 @@
:components ((:file "utils")
(:file "primes")
(:file "graphs")
+ (:file "pq")
(:file "graphviz")
(:file "hanoi")
(:file "urn")--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/src/pq.lisp Wed Feb 15 10:23:50 2017 +0000
@@ -0,0 +1,48 @@
+(in-package :sand.pq)
+
+;;;; Priority Queue -----------------------------------------------------------
+;;; Jankass priority queue implementation.
+(defstruct pq
+ (contents nil)
+ (predicate #'<)
+ (test #'eql))
+
+
+(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)
+ (zapf (pq-contents pq)
+ (merge 'list `((,priority ,element)) % (pq-predicate pq)
+ :key #'pqn-priority))
+ pq)
+
+(defun pq-ensure (pq element priority)
+ (let ((existing (pq-lookup pq element)))
+ (if existing
+ (progn (setf (car existing) priority)
+ (pq-resort pq)
+ t)
+ (progn (pq-insert pq element priority)
+ nil)))
+ pq)
+
+(defun pq-dequeue (pq)
+ (if (pq-contents pq)
+ (values (pqn-element (pop (pq-contents pq))) t)
+ (values nil nil)))
+