day-16.lisp (3474B)
1 (defpackage #:aoc/day-16 2 (:use #:cl #:aoc/utils) 3 (:export #:day-16)) 4 (in-package #:aoc/day-16) 5 6 (defparameter *directions-clockwise* '(#1=(1 . 0) (0 . 1) 7 (-1 . 0) (0 . -1) #1#)) 8 (defparameter *directions-counterclockwise* '(#2=(1 . 0) (0 . -1) 9 (-1 . 0) (0 . 1) #2#)) 10 11 (defstruct node 12 position 13 direction 14 (cost 0) 15 (parents nil)) 16 17 (defun node-compare (node-a node-b) 18 (< (node-cost node-a) (node-cost node-b))) 19 20 (defun process-next (open-list node-cache closed-list next-position next-direction next-cost parent) 21 (when (gethash (list next-position next-direction) closed-list) 22 (return-from process-next nil)) 23 (let* ((cache-key (list next-direction next-position)) 24 (existing (gethash cache-key node-cache))) 25 (if existing 26 (when (<= next-cost (node-cost existing)) 27 (setf (node-parents existing) (if (= next-cost (node-cost existing)) 28 (cons parent (node-parents existing)) 29 (list parent)) 30 (node-cost existing) next-cost)) 31 (qpush open-list (setf (gethash cache-key node-cache) 32 (make-node :position next-position 33 :direction next-direction 34 :cost next-cost 35 :parents (list parent))))))) 36 37 (defun path-length (end-node) 38 (loop with seen = (make-hash-table :test #'equal) 39 for nodes = (list end-node) then (mappend #'node-parents nodes) 40 until (null nodes) 41 do (loop for node in nodes 42 do (setf (gethash (node-position node) seen) t)) 43 finally (return (hash-table-count seen)))) 44 45 (defun dijkstra (map start end) 46 (loop with open-list = (make-queue :priority-queue :compare #'node-compare) 47 with node-cache = (make-hash-table :test #'equal) 48 with closed-list = (make-hash-table :test #'equal) 49 initially (qpush open-list (make-node :position start 50 :direction (first *directions-clockwise*))) 51 while (> (qsize open-list) 0) 52 for current = (qpop open-list) 53 for current-pos = (node-position current) 54 for current-dir = (node-direction current) 55 for current-cost = (node-cost current) 56 for next = (point+ current-pos current-dir) 57 when (equal current-pos end) 58 do (return (values current-cost 59 (path-length current))) 60 do (setf (gethash (list current-pos current-dir) closed-list) t) 61 when (char/= (map-cell map next) #\#) 62 do (process-next open-list node-cache closed-list next current-dir (1+ current-cost) current) 63 do (process-next open-list node-cache closed-list current-pos 64 (cadr (member current-dir *directions-clockwise* :test #'equal)) 65 (+ current-cost 1000) 66 current) 67 (process-next open-list node-cache closed-list current-pos 68 (cadr (member current-dir *directions-counterclockwise* :test #'equal)) 69 (+ current-cost 1000) 70 current))) 71 72 (defun day-16 (input) 73 (let* ((map (make-map input)) 74 (start (map-find map #\S)) 75 (end (map-find map #\E))) 76 (dijkstra map start end)))