day24.lisp (6927B)
1 (defpackage #:adventofcode2022/day24 2 (:use #:cl #:adventofcode2022) 3 (:import-from #:queues 4 #:make-queue 5 #:qpush 6 #:qpop)) 7 (in-package #:adventofcode2022/day24) 8 9 (defparameter *neighbor-deltas* (list '(-1 0) 10 '(0 -1) 11 '(1 0) 12 '(0 1))) 13 14 (defun coord+ (a b) 15 (list (+ (car a) (car b)) 16 (+ (cadr a) (cadr b)))) 17 18 (defun analyze-inputs (inputs) 19 (loop with blizzards = (make-hash-table :test 'equal) 20 with min-pos = (list 1 1) 21 with max-pos = (list 0 0) 22 with start-pos = (list 1 0) 23 with end-pos = (list 0 0) 24 for row in inputs 25 for y from 0 26 when (= y 0) 27 do (setf (car max-pos) (- (length row) 2) 28 (car end-pos) (- (length row) 2)) 29 30 do (loop for column across row 31 for x from 0 32 for blizzard-direction = (case column 33 (#\^ :up) 34 (#\< :left) 35 (#\> :right) 36 (#\v :down)) 37 when blizzard-direction 38 do (setf (gethash (list x y) blizzards) 39 (append (gethash (list x y) blizzards) 40 (list blizzard-direction)))) 41 finally (progn 42 (setf (cadr max-pos) (1- y) 43 (cadr end-pos) y) 44 (return (values 45 blizzards 46 min-pos 47 max-pos 48 start-pos 49 end-pos))))) 50 51 (defun get-next-blizzard-state (blizzards min-pos max-pos) 52 (loop with next-blizzards = (make-hash-table :test 'equal) 53 with width = (1+ (- (car max-pos) (car min-pos))) 54 with height = (1+ (- (cadr max-pos) (cadr min-pos))) 55 for pos being the hash-key of blizzards using (hash-value dirs) 56 do (loop for dir in dirs 57 for next-pos = (copy-seq pos) 58 do (case dir 59 (:up (decf (cadr next-pos))) 60 (:left (decf (car next-pos))) 61 (:right (incf (car next-pos))) 62 (:down (incf (cadr next-pos)))) 63 do (setf next-pos (list 64 (+ (mod (- (car next-pos) (car min-pos)) 65 width) 66 (car min-pos)) 67 (+ (mod (- (cadr next-pos) (cadr min-pos)) 68 height) 69 (cadr min-pos)))) 70 do (setf (gethash next-pos next-blizzards) 71 (append (gethash next-pos next-blizzards) 72 (list dir)))) 73 finally (return next-blizzards))) 74 75 (defun print-map (min-pos max-pos current-pos blizzards) 76 (loop for y from (cadr min-pos) to (cadr max-pos) 77 do (loop for x from (car min-pos) to (car max-pos) 78 for pos = (list x y) 79 for bs = (gethash pos blizzards) 80 do (format t "~A" (cond 81 ((equal pos current-pos) "E") 82 ((> (length bs) 9) "*") 83 ((> (length bs) 1) (length bs)) 84 (bs (case (car bs) 85 (:up "^") 86 (:left "<") 87 (:right ">") 88 (:down "v"))) 89 (t ".")))) 90 do (format t "~%")) 91 (format t "~%")) 92 93 (defun test-blizzards (inputs rounds) 94 (multiple-value-bind (blizzards min-pos max-pos start-pos end-pos) 95 (analyze-inputs inputs) 96 (declare (ignore start-pos end-pos)) 97 (loop with current-blizzards = blizzards 98 initially (print-map min-pos max-pos (list 0 0) current-blizzards) 99 repeat rounds 100 do (setf current-blizzards (get-next-blizzard-state current-blizzards min-pos max-pos)) 101 do (print-map min-pos max-pos (list 0 0) current-blizzards)))) 102 103 (defun walk-through-storm (blizzards min-pos max-pos start-pos end-pos &optional (start-minute 0)) 104 (loop named outer 105 with visited = (make-hash-table :test 'equal) 106 with blizzard-states = (make-hash-table) 107 with queue = (make-queue :simple-queue) 108 initially (qpush queue (list start-minute start-pos)) 109 (setf (gethash start-minute blizzard-states) blizzards) 110 for (minute current-pos) = (qpop queue) 111 while current-pos 112 for next-minute = (1+ minute) 113 for current-blizzards = (gethash minute blizzard-states) 114 for next-blizzards = (or (gethash next-minute blizzard-states) 115 (setf (gethash next-minute blizzard-states) 116 (get-next-blizzard-state current-blizzards min-pos max-pos))) 117 do (loop for neighbor-delta in *neighbor-deltas* 118 for next-pos = (coord+ current-pos neighbor-delta) 119 when (equal next-pos end-pos) 120 do (return-from outer (values next-minute next-blizzards)) 121 when (and (>= (car next-pos) (car min-pos)) 122 (>= (cadr next-pos) (cadr min-pos)) 123 (<= (car next-pos) (car max-pos)) 124 (<= (cadr next-pos) (cadr max-pos)) 125 (null (gethash next-pos next-blizzards)) 126 (null (gethash (list next-pos next-minute) visited))) 127 do (qpush queue (list next-minute next-pos)) 128 and do (setf (gethash (list next-pos next-minute) visited) t)) 129 when (not (gethash current-pos next-blizzards)) 130 do (qpush queue (list next-minute current-pos)))) 131 132 (defun task1 (inputs) 133 (multiple-value-bind (blizzards min-pos max-pos start-pos end-pos) 134 (analyze-inputs inputs) 135 (nth-value 0 (walk-through-storm blizzards min-pos max-pos start-pos end-pos)))) 136 137 (defun task2 (inputs) 138 (multiple-value-bind (blizzards min-pos max-pos start-pos end-pos) 139 (analyze-inputs inputs) 140 (let ((current-minute)) 141 (multiple-value-setq (current-minute blizzards) 142 (walk-through-storm blizzards min-pos max-pos start-pos end-pos)) 143 (multiple-value-setq (current-minute blizzards) 144 (walk-through-storm blizzards min-pos max-pos end-pos start-pos current-minute)) 145 (nth-value 0 (walk-through-storm blizzards min-pos max-pos start-pos end-pos current-minute))))) 146 147 (define-day 24 148 () 149 #'task1 150 #'task2)