aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2023-01-24 18:38:39 +0100
committerOscar Najera <hi@oscarnajera.com>2023-01-24 18:38:39 +0100
commit2bea07a804dde0fe90a26b9dc725d9d289ec338a (patch)
tree1df8f63d10ebf06ffed4b207d353bbe7cfb4363a
parentae050f4d81d01af2401c09db8a9a6db251c20a37 (diff)
downloadscratch-2bea07a804dde0fe90a26b9dc725d9d289ec338a.tar.gz
scratch-2bea07a804dde0fe90a26b9dc725d9d289ec338a.tar.bz2
scratch-2bea07a804dde0fe90a26b9dc725d9d289ec338a.zip
Day 24
-rw-r--r--AoC2022/24/eg-in6
-rw-r--r--AoC2022/24/input27
-rw-r--r--AoC2022/24/solver.lisp128
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)