Day 15: Warehouse Woes

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

  •  gentooer   ( @gentooer@programming.dev ) 
    link
    fedilink
    English
    2
    edit-2
    10 hours ago

    Haskell

    Runs in 12 ms. I was very happy with my code for part 1, but will sadly have to rewrite it completely for part 2.

    Code
    import Control.Monad.State.Lazy
    import qualified Data.Map.Strict as M
    
    type Coord = (Int, Int)
    data Block = Box | Wall
    type Grid = M.Map Coord Block
    
    parse :: String -> ((Coord, Grid), [Coord])
    parse s =
        let robot = head
                [ (r, c)
                | (r, row) <- zip [0 ..] $ lines s
                , (c, '@') <- zip [0 ..] row
                ]
            grid = M.fromAscList
                [ ((r, c), val)
                | (r, row) <- zip [0 ..] $ lines s
                , (c, Just val) <- zip [0 ..] $ map f row
                ]
        in  ((robot, grid), go s)
        where
            f 'O' = Just Box
            f '#' = Just Wall
            f _ = Nothing
            go ('^' : rest) = (-1,  0) : go rest
            go ('v' : rest) = ( 1,  0) : go rest
            go ('<' : rest) = ( 0, -1) : go rest
            go ('>' : rest) = ( 0,  1) : go rest
            go (_   : rest) =            go rest
            go [] = []
    
    add :: Coord -> Coord -> Coord
    add (r0, c0) (r1, c1) = (r0 + r1, c0 + c1)
    
    moveBoxes :: Coord -> Coord -> Grid -> Maybe Grid
    moveBoxes dr r grid = case grid M.!? r of
        Nothing   -> Just grid
        Just Wall -> Nothing
        Just Box  ->
            M.insert (add r dr) Box . M.delete r <$> moveBoxes dr (add r dr) grid
    
    move :: Coord -> State (Coord, Grid) Bool
    move dr = state $ \(r, g) -> case moveBoxes dr (add r dr) g of
        Just g' -> (True, (add r dr, g'))
        Nothing -> (False, (r, g))
    
    moves :: [Coord] -> State (Coord, Grid) ()
    moves = mapM_ move
    
    main :: IO ()
    main = do
        ((robot, grid), movements) <- parse <$> getContents
        let (_, grid') = execState (moves movements) (robot, grid)
        print $ sum [100 * r + c | ((r, c), Box) <- M.toList grid']