From 2bea07a804dde0fe90a26b9dc725d9d289ec338a Mon Sep 17 00:00:00 2001 From: Oscar Najera Date: Tue, 24 Jan 2023 18:38:39 +0100 Subject: Day 24 --- AoC2022/24/eg-in | 6 +++ AoC2022/24/input | 27 +++++++++++ AoC2022/24/solver.lisp | 128 +++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 161 insertions(+) create mode 100644 AoC2022/24/eg-in create mode 100644 AoC2022/24/input create mode 100644 AoC2022/24/solver.lisp (limited to 'AoC2022/24') 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<^>^v<>v<<<.^<>^>v^>>>>.^>>>v<.^^^^^>.v.v<^.v>v<<<<<.<<# +#<>^^^v<.v<v<>.>vv>^>vv>^^><<>><>.v.v>><><<>>vv>^^v<^<.>^^^>^>^.<^.^<.>^v<<<# +#><<>.>^^^><<>^><>>>^v<>><>^>>v^v>.^v>.v<..>^^^>><^vv><>>>vvv^<<^v^>v.^v^<# +#<.^vv<^<.>>>>v>>^v<<.v<><>>^.<^<^v.v>>vv<>>vv^.^.>vv.v.># +#<><^>v.^vvv>>^v<>^>^v<>><^<^<^>v^^^><^<>v^.<>>.><^<^><>vv^vv>><<><.<# +#.^^^^^^v^v.<<><>vv<>.>^v^>.<>v.^^<><>^<>^v^^.>v<^<^>.^<^vvv<>^<^v^^.>.^.><<>v>v^>^^>vv^v>v.^vv>^^v><# +#<<^<^>>v><^.^<.<>^.>vv<<.>v<^^v>vv>>>^<<>^<<<<^>v^>vv>^vv^v<.>v^^vv^<>>^v^.<^v<# +#<<>.v^^<>>v><<><<<<>^<.<<>><^>^<<^.v<<.>>>>^><^v<>><^>>v>>>.^>>v^<^.vv..v^^vvv^vv<>^.># +#><.v.^>>>>><.>.vv^<<>v><^<<>.v<<.>>v>>v<^.^^^<^^^^<<>>><^>><^>^<.>^^^^<.^<>v># +#<<>v<^<.<<.>vv<.><>.vvvv<^.<<>><>^^>v>^v>v<^^v.<^v<>vv^<><<>vv^v<>.>>vv^.>.>v>v>^v>^.><^># +#>.>>vv>><<>^v^^v>^<<.^^>>>>><<^^^<^vv<>v.<^<^<>v<^><>v.v^.>>v^^^^>.v.>v^.^>v<>v.^^.^^v^v>.^><<.^<># +#<>v.^>>>>^^^>v<^<>v>^>v>vv^^>v.v<>>.>^><<>v^v.^..v.>vv.^>^^vvvvvv>>^<^v.<>><<.v^>vv>>>vv><^.><.<^^^v^>^v<>v# +#<^>.^<^^v^v.v^>.<.<<^><<^^v^v^vv^<>v^>v^vv<>v.^v.<>^>vv>.^<^.v.>v>v>>v>.<<>^^vvv>>v^^>^<^>.<<.v^>vv>>vv>>.>>.^<<^v>.vvv><<<>^.^v>vvv^^^^v<<<><^^<<^><<>><>v^>v^>^.<<^<>>v.vv>>>^^v^.vv^>><<<<.<<>^>^v>><>.>><>^>^>^^>>v>^>v.>^<<^><^v^<>v<>^^>>v.# +#..^>^v.>.<^>^>.v>>.<<..<<>v^vvv<v><.<^^>^<^^<^>><>^<.vv<<<>^^v^><><^<^vv<<.<^>v.v<^^<>>>.>^^v<^v># +#<.>vv<.<>^<<.>.v<<>><<.>.vv^^<>vv^v..^<>>.^<>^>^^<^^^>>><><>^^.vv<<>v>^.v.^^<<^v<>.^>>^^>v>v^^^>v^>^>>><# +#<>v>vv<<<><<v>>^.^<<^>>^^>^v.v^<>^^<>>^v.>.<.>>>.<<^><.<^^>^>>.><^>.^>v<^>^>v>.^^v>.v^>>>>>v>># +#<.<<^>><<^>.v>v^^.v^>v<^>>^.>>>^>^v<^v.>^^<<<>v.^.v^v.^>.<>^><<<<>v^^>..>v.><^^.<<<^.>^<>>>vv><># +#>^v.>vvv^^.^<>^>^>v^<>.^.v.^v<^v><^v<>^>>v.^<^><<>^>>>><^^<<>^^><<<^vvv>><.^>>v^^<^><>.>..^^v>v># +#.<^^><<<^^^v<>^.>v>v^>v^^.v^.^<<<^^v.v^<^>.<>><<><^v^v.^^<>^v^vvvv><<^^><<>vvv^># +#.<^..v^^^>>^v^^.><>v^.>v^^<<><^^<.<>>v^>.<>>.^>vv>v>^v.<^^^<<^.^>^.<<<.^^>.^^^.v<<>v<.vv^^<>v>>>><>^>^^.<<^^<>><<# +#<^<^^>>^.^^^>v><^><.v>>v^>vv>v.>^>^<^^^^v<<<^>.>v^v^..<<<<>^<<<>^^vv^v>.<^v<><>^<<>^<>>v>><<>^>vvvv<>># +#>>^.^^>^^<<>^^vv>>>^>vv.><><^^v<<<.v<^^>><^v>^<>^v<^.<<>^v<.^<.v.><.<^>^vvvvvv^v^^<^.<># +#<><<^<.<^>^^^.^v>>vv.vv.^vv^.^^vvvv..<.v^>^>>>vv<>^>.>>^^^<<^v<^.vv>>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) -- cgit v1.2.3