commit 4f33aa74e3fc0f489f1d20fe970de7370eb84f9f parent d2acc5d04156c20564f7a69ecb395d930c192279 Author: Lukas Henkel <lh@entf.net> Date: Mon, 16 Dec 2024 11:37:00 +0100 Cache expensive node lookup Diffstat:
| M | src/day-16.lisp | | | 24 | ++++++++++++------------ |
1 file changed, 12 insertions(+), 12 deletions(-)
diff --git a/src/day-16.lisp b/src/day-16.lisp @@ -17,23 +17,22 @@ (defun node-compare (node-a node-b) (< (node-cost node-a) (node-cost node-b))) -(defun process-next (open-list closed-list next-position next-direction next-cost parent) +(defun process-next (open-list node-cache closed-list next-position next-direction next-cost parent) (when (gethash (list next-position next-direction) closed-list) (return-from process-next nil)) - (let* ((existing (queue-find open-list (lambda (existing) - (and (equal (node-position existing) next-position) - (equal (node-direction existing) next-direction))))) - (existing (and existing (q::node-value existing)))) + (let* ((cache-key (list next-direction next-position)) + (existing (gethash cache-key node-cache))) (if existing (when (<= next-cost (node-cost existing)) (setf (node-parents existing) (if (= next-cost (node-cost existing)) (cons parent (node-parents existing)) (list parent)) (node-cost existing) next-cost)) - (qpush open-list (make-node :position next-position - :direction next-direction - :cost next-cost - :parents (list parent)))))) + (qpush open-list (setf (gethash cache-key node-cache) + (make-node :position next-position + :direction next-direction + :cost next-cost + :parents (list parent))))))) (defun path-length (end-node) (loop with seen = (make-hash-table :test #'equal) @@ -45,6 +44,7 @@ (defun dijkstra (map start end) (loop with open-list = (make-queue :priority-queue :compare #'node-compare) + with node-cache = (make-hash-table :test #'equal) with closed-list = (make-hash-table :test #'equal) initially (qpush open-list (make-node :position start :direction (first *directions-clockwise*))) @@ -59,12 +59,12 @@ (path-length current))) do (setf (gethash (list current-pos current-dir) closed-list) t) when (char/= (map-cell map next) #\#) - do (process-next open-list closed-list next current-dir (1+ current-cost) current) - do (process-next open-list closed-list current-pos + do (process-next open-list node-cache closed-list next current-dir (1+ current-cost) current) + do (process-next open-list node-cache closed-list current-pos (cadr (member current-dir *directions-clockwise* :test #'equal)) (+ current-cost 1000) current) - (process-next open-list closed-list current-pos + (process-next open-list node-cache closed-list current-pos (cadr (member current-dir *directions-counterclockwise* :test #'equal)) (+ current-cost 1000) current)))