Day 17: Clumsy Crucible
Megathread guidelines
- Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
- You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL
FAQ
- What is this?: Here is a post with a large amount of details: https://programming.dev/post/6637268
- Where do I participate?: https://adventofcode.com/
- Is there a leaderboard for the community?: We have a programming.dev leaderboard with the info on how to join in this post: https://programming.dev/post/6631465
Haskell
import Data.Array.Unboxed import qualified Data.ByteString.Char8 as BS import Data.Char (digitToInt) import Data.Heap hiding (filter) import qualified Data.Heap as H import Relude type Pos = (Int, Int) type Grid = UArray Pos Int data Dir = U | D | L | R deriving (Eq, Ord, Show, Enum, Bounded, Ix) parse :: ByteString -> Maybe Grid parse input = do let l = fmap (fmap digitToInt . BS.unpack) . BS.lines $ input h = length l w <- fmap length . viaNonEmpty head $ l pure . listArray ((0, 0), (w - 1, h - 1)) . concat $ l move :: Dir -> Pos -> Pos move U = first pred move D = first succ move L = second pred move R = second succ nextDir :: Dir -> [Dir] nextDir U = [L, R] nextDir D = [L, R] nextDir L = [U, D] nextDir R = [U, D] -- position, previous direction, accumulated loss type S = (Int, Pos, Dir) doMove :: Grid -> Dir -> S -> Maybe S doMove g d (c, p, _) = do let p' = move d p guard $ inRange (bounds g) p' pure (c + g ! p', p', d) doMoveN :: Grid -> Dir -> Int -> S -> Maybe S doMoveN g d n = foldl' (>=>) pure . replicate n $ doMove g d doMoves :: Grid -> [Int] -> S -> Dir -> [S] doMoves g r s d = mapMaybe (flip (doMoveN g d) s) r allMoves :: Grid -> [Int] -> S -> [S] allMoves g r s@(_, _, prev) = nextDir prev >>= doMoves g r s solve' :: Grid -> [Int] -> UArray (Pos, Dir) Int -> Pos -> MinHeap S -> Maybe Int solve' g r distances target h = do ((acc, pos, dir), h') <- H.view h if pos == target then pure acc else do let moves = allMoves g r (acc, pos, dir) moves' = filter (\(acc, p, d) -> acc < distances ! (p, d)) moves distances' = distances // fmap (\(acc, p, d) -> ((p, d), acc)) moves' h'' = foldl' (flip H.insert) h' moves' solve' g r distances' target h'' solve :: Grid -> [Int] -> Maybe Int solve g r = solve' g r (emptyGrid ((lo, minBound), (hi, maxBound))) hi (H.singleton (0, (0, 0), U)) where (lo, hi) = bounds g emptyGrid = flip listArray (repeat maxBound) part1, part2 :: Grid -> Maybe Int part1 = (`solve` [1 .. 3]) part2 = (`solve` [4 .. 10])