Day 24

3 files changed, 161 insertions, 0 deletions

diff --git a/AoC2022/24/eg-in b/AoC2022/24/eg-in
new file mode 100644
index 0000000..685dc4f
--- /dev/null
+++ b/AoC2022/24/eg-in
@@ -0,0 +1,6 @@
+#.######
+#>>.<^<#
+#.<..<<#
+#>v.><>#
+#<^v^^>#
+######.#
diff --git a/AoC2022/24/input b/AoC2022/24/input
new file mode 100644
index 0000000..c336f13
--- /dev/null
+++ b/AoC2022/24/input
@@ -0,0 +1,27 @@
+#.########################################################################################################################
+#<^>^<^^<v><vv^v^<^vv>^<^v>vv^v<<v<>^>^v<>v<<<.^<>^>v^><v<^...>>>>.^>>>v<.^^^^^>.v.v<v.><^<v<<v<>.<v.v<><vv.v>v>v<<<<<.<<#
+#<>^^^v<.v<<v.v.vv.v^v>v<>.>vv>^>vv>^^><<<v>><v>><>.v.v>><><<>>vv>^^v<v^v><^<.><vv<.v<v>^^<v>^>^>^<v<>.<^.^<.>^v<<<<v^^.>#
+#<v..^^>><<vvv><v^><>.>^^^><<>^><>>>^v<>><>^<v<<>>>v^v>.^v<v^>><vvv^<<.><v<.v<^>.v<..>^^^>><^v<v<v>v><>>>vvv^<<^v^>v.^v^<#
+#<.^vv<^<.>>>>v<v^vv^v.v.v>>>^v<<<v^^<v<^<>.v<><v.v^<<^><><v^<<v.>><v><vv>^.<^<^v.v>>vv<>>vv^.^.><vv<^^^^<v^v<v>vv.v.><v>#
+#<><^>v.^<v^<vv>vvv>>^v<v..vv.><>^>^v<<v.<v^...vv>>><^<^<^>v^^^><v<^<v<^.^<.^v><<v<.<>^<>v^.<>>.><^<^><><vv>vv^vv>><<><.<#
+#.^^^^^^v^v.<<><>vv<>.>^v<v>^>.<>v.^^<><>^<>^v^^.<v<vv>>v<^<^><v<>.<v>^<^vvv<>^<^v^^.>.^.><<>v>v^>^^>vv^v>v.^vv<v^>>^^v><#
+#<<^<<v>^<v^>>>v><^.^<.<>^.><v>vv<<.>v<^^v>vv>>>^<<>^<v<v<^<^.^^<><<<<^>v^>vv>^vv^v<.>v^^vv^<v^<v><>><v^<>^v<v><vv>^.<^v<#
+#<<>.v^<v>^<>>v><<><vvvvv^><<<<>^<.<<>><^<v>>^<<^.v<<.>>><v<^.v.v<<v>>^><^v<>><^>>v>>>.^>>v^<^.<v>vv..v^^vvv^vv<>^<v<<>.>#
+#><.v.^><vv.>>>>><.>.vv^<<>v><^<<v.<><>.v<v><<.>>v>>v<^.^^^<^^<v>^^<<>>><^>><^>^<.<v^v<v^><v<.<^^.>>^^<v.v<><v<>^^<.^<>v>#
+#<<>v<^<.<<.>vv<.><>.vvvv<^.<<>><<v>>^^>v>^v>v<^^v.<^v<>vv^<><<>vv<v<^^<<><v>^<vv.^<>v<>.><vv>>vv^.>.>v>v>^v>^.><v<.v><^>#
+#>.>>vv>><<>^v^^v>^<<.^^>>><v<v>>><<^^^<^vv<>v<v^>.<^<^<>v<^><>v.v^.>>v^^^^>.v.><v^^^vv<^>v^.^>v<>v.^^.^^v^v<v>>.^><<.^<>#
+#<>v.^>>>>^^^>v<^<>v>^>v>vv^^>v.v<>>.>^><<>v^v.<v>^..v.>vv.^>^^v<v^^v>vvvvv>>^<^v.<>><<.v^>vv>>>vv><^.><.<^^^v^>^v<>v<v^>#
+#<^<v^.>>.^<^^v^v.<v<<vv^.^.><vv^vv<>v^>.<.<<^<vv^>><<^^v^v^<v^vv.^^^>vv^<>v^>v^vv<>v.^v.<>^>vv>.^<^.v.>v>v>>v<v<^v>><v<<#
+#>.<<>^^vvv>>v^^>^<^>.<<.v^>vv>>v<vv<<^v.<.v^^^.^>v>>.>>.^<<^v>.vvv><<<>^.^v>vvv^^^^<vv.><v<>v<<<><^^<v<.><<^><<>><><v^<<#
+#<<<<..^v>v^>v^>^.<<^<>>v.vv>>>^^v^.vv^>><<<<.<<>^>^v>><>.>><>^><v^<v<^^v^>^>^^>>v>^>v.<v>>^<<^><<v>^v^<>v<>^^>>v<vv^vv>.#
+#..^>^v.>.<^>^>.v>>.<<..<<>v^vvv<<vvv<.<>v><.<^^>^<^^<^>><>^<.vv<<<>^^v^><><^<^vv<<.<<v^^v^<<vv^<.v>^>v.v<^^<>>>.>^^v<^v>#
+#<.>vv<.<>^<<.>.v<<><vvv^<<v>><<.>.vv^^<>vv^v..^<>>.^<>^>^^<^^^<v^>>>><><>^^.vv<<>v>^.v.^^<<^v<>.^>>^^>v>v^^^>v^>^>><v>><#
+#<>v>vv<<<><<v><<v>v>>^.<vvvv<^^<^<>^<<^>>^^>^v.<vv^vv<>v^<>^^<>>^v.>.<.>>>.<<^><.<^^>^>>.><^>.^>v<^>^>v>.^^v>.v^>>>>>v>>#
+#<.<<^>><<^>.v>v^^.v^>v<^<vv^>>>^.>>>^>^v<^v<v>.>^^<<<>v.^.v^v.^>.<v<<v^^^<<><>^><<<<>v^^><v^<>..>v.><^^.<<<^.>^<>>>vv><>#
+#>^v.>vvv^^.^<>^><vv>^>v^<>.^.v<v>.^v<<v^^>^v><^v<>^>>v.^<^><<>^>>>><^^<v<<><<>^^><<<^vvv>><.<v>^>>v^^<^><>.<v^>>..^^v>v>#
+#.<^^><<<^^^v<>^.>v>v^><v<>v^^.v^.^<<<^^<vvv^<^^v.<vvv<>v.v^<^>.<>><<><^v^v.^^<>^v^vvvv><<^^><<>vv<v^v^.^v<<<^v<<<^<v>v^>#
+#.<^..v^^^>>^v^^.><v><>v^.>v^^<<><^^<.<>>v^>.<>>.^>vv>v>^v.<^^^<<^<vv>.^>^.<<<.^^>.^^^.v<<>v<.vv^^<>v>>>><>^>^^.<<^^<>><<#
+#<^<^^>>^.<v>^^^>v><^><.v>>v^>vv>v.>^>^<^^^^v<<<^>.>v^<v.<v^^^^>v^..<<<<>^<<<>^<v^^>^vv^v>.<^v<><>^<<>^<>>v>><<>^>vvvv<>>#
+#>>^.^^<v<<vvv^^<<vv>>^^<<>^^vv>>><v>^>v<v>v.><><^^v<<<.<vv>v<^^>><^v>^<>^<v<vv<v^>v<^.<<>^v<.^<.v.><.<^>^vvvvvv^v^^<^.<>#
+#<><<^<.<^>^^^<v>.^v>>vv.vv<v..<^vv<>.^vv^.^<vv<>^vvv<v^>v.<v<v<.^>.<.v^>^>>>vv<>^>.>>^^^<<^v<^.vv>>v.v<v><<<^^^v^vvv..^>#
+########################################################################################################################.#
diff --git a/AoC2022/24/solver.lisp b/AoC2022/24/solver.lisp
new file mode 100644
index 0000000..0961b6f
--- /dev/null
+++ b/AoC2022/24/solver.lisp
@@ -0,0 +1,128 @@
+(ql:quickload '(fiveam uiop trivia arrows))
+
+
+(defun distance-1 (a b)
+  (apply #'+
+         (mapcar (lambda (e1 e2)
+                   (abs (- e1 e2))) a b)))
+
+(defun boundary-conditions (width height)
+  "The boundary is a wall meaning 0 & (N-1) are never occupied."
+  (lambda (x y dir)
+    (list
+     dir
+     (cond
+       ((zerop x) (- width 2))
+       ((= x (- width 1)) 1)
+       (x))
+     (cond
+       ((zerop y) (- height 2))
+       ((= y (- height 1)) 1)
+       (y)))))
+
+(defun wall-p (width height)
+  (lambda (point)
+    (destructuring-bind (x y) point
+      (cond
+        ;; not entry - exit
+        ((or (and (= x 1) (zerop y))
+             (and (= x (- width 2)) (= y (1- height))))
+         nil)
+        ;; yes wall or out of map
+        ((or (<= x 0) (<= y 0)
+             (>= x (1- width))
+             (>= y (1- height))))))))
+
+(fiveam:test boundaries
+  (let ((bc (boundary-conditions 6 9)))
+    (fiveam:is (equal (funcall bc 5 3 t) '(1 3 t)))
+    (fiveam:is (equal (funcall bc 5 8 t) '(1 1 t)))
+    (fiveam:is (equal (funcall bc 0 8 t) '(4 1 t)))))
+
+(defun data-input (filename)
+  (let ((lines (uiop:read-file-lines filename)))
+    (list
+     (loop for row in lines
+           and y from 0
+           nconc (loop for place across row
+                       and x from 0
+                       unless (or (eq #\# place) (eq #\. place))
+                         collect (list (ecase place
+                                         (#\> '>)
+                                         (#\< '<)
+                                         (#\v 'v)
+                                         (#\^ '^))
+                                       x y)))
+     (list (length (car lines))
+           (length lines)))))
+
+(defun evolve (blizzards boundary)
+  (mapcar
+   (lambda (blizzard)
+     (trivia:match blizzard
+       ((list '> x y) (funcall boundary (1+ x) y '>))
+       ((list '< x y) (funcall boundary (1- x) y '<))
+       ((list 'v x y) (funcall boundary x (1+ y) 'v))
+       ((list '^ x y) (funcall boundary x (1- y) '^))))
+   blizzards))
+
+
+(defun elf-moves (elf wallp blizzards)
+  (destructuring-bind (x y) elf
+    (arrows:-<>
+     (list (list (1+ x)    y)
+           (list x     (1+ y))
+           (list (1- x)    y)
+           (list x     (1- y))
+           (list x         y))
+     (delete-if wallp <>)
+     (set-difference <> (mapcar #'cdr blizzards) :test #'equal))))
+
+(defun cutoff-distance (positions goal)
+  (loop for p in positions
+        for dist = (distance-1 goal p)
+        maximize dist into ma
+        minimize dist into mi
+        finally (return (values (max (ceiling (+ ma mi) 2)
+                                     (* 1.2 mi)
+                                     (* 0.8 ma)
+                                     30)
+                                mi ma))))
+
+(defun discard-hopeless-positions (positions goal cutoff-distance)
+  (delete-if (lambda (p) (< cutoff-distance (distance-1 goal p))) positions))
+
+(defun time-step (time-left walkers goal blizzards bc wallp)
+  (if (or (zerop time-left) (member goal walkers :test #'equal))
+      (values time-left blizzards)
+      (let* ((new-blizzards (evolve blizzards bc))
+             (new-positions (reduce
+                             (lambda (options point)
+                               (union options (elf-moves point wallp new-blizzards)
+                                      :test #'equal))
+                             walkers
+                             :initial-value nil))
+             (shortened-positions (discard-hopeless-positions new-positions goal
+                                               (cutoff-distance new-positions goal))))
+        (time-step (1- time-left)
+                   shortened-positions
+                   goal new-blizzards bc wallp))))
+
+(destructuring-bind (blizzards (width height)) (data-input "input")
+  (let ((bc (boundary-conditions width height))
+        (wallp (wall-p width height))
+        (goal (list (- width 2) (1- height)))
+        (elf (list 1 0))
+        (max-time 400))
+    (multiple-value-bind (time-left-g blizzards) (time-step max-time (list elf) goal blizzards bc wallp)
+      (multiple-value-bind (time-left-b blizzards) (time-step max-time (list goal) elf blizzards bc wallp)
+        (multiple-value-bind (time-left-e blizzards) (time-step max-time (list elf) goal blizzards bc wallp)
+          (list (- max-time time-left-g)
+                (- max-time time-left-b)
+                (- max-time time-left-e)))))
+
+    )
+
+  )
+(+ 299 348 252)
+(+ 299 323 277)