diff options
| -rw-r--r-- | AoC2022/24/eg-in | 6 | ||||
| -rw-r--r-- | AoC2022/24/input | 27 | ||||
| -rw-r--r-- | AoC2022/24/solver.lisp | 128 |
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) |