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
- 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
You are viewing a single thread.
View all comments 
2 points
Haskell
This was a fun one! I’m quite pleased with moveInto, which could be easily extended to support arbitrary box shapes.
Solution
import Control.Monad
import Data.Bifunctor
import Data.List
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
type C = (Int, Int)
readInput :: String -> (Map C Char, [C])
readInput s =
let (room, _ : moves) = break null $ lines s
in ( Map.fromList [((i, j), c) | (i, l) <- zip [0 ..] room, (j, c) <- zip [0 ..] l],
map dir $ concat moves
)
where
dir '^' = (-1, 0)
dir 'v' = (1, 0)
dir '<' = (0, -1)
dir '>' = (0, 1)
moveInto :: Int -> Set C -> C -> C -> Set C -> Maybe (Set C)
moveInto boxWidth walls (di, dj) = go
where
go (i, j) boxes
| (i, j) `Set.member` walls = Nothing
| Just j' <- find (\j' -> (i, j') `Set.member` boxes) $ map (j -) [0 .. boxWidth - 1] =
Set.insert (i + di, j' + dj)
<$> foldM
(flip go)
(Set.delete (i, j') boxes)
[(i + di, j' + z + dj) | z <- [0 .. boxWidth - 1]]
| otherwise = Just boxes
runMoves :: (Map C Char, [C]) -> Int -> Int
runMoves (room, moves) scale = score $ snd $ foldl' move (start, boxes) moves
where
room' = Map.mapKeysMonotonic (second (* scale)) room
Just start = fst <$> find ((== '@') . snd) (Map.assocs room')
walls =
let ps = Map.keysSet $ Map.filter (== '#') room'
in Set.unions [Set.mapMonotonic (second (+ z)) ps | z <- [0 .. scale - 1]]
boxes = Map.keysSet $ Map.filter (== 'O') room'
move (pos@(i, j), boxes) dir@(di, dj) =
let pos' = (i + di, j + dj)
in maybe (pos, boxes) (pos',) $ moveInto scale walls dir pos' boxes
score = sum . map (\(i, j) -> i * 100 + j) . Set.elems
main = do
input <- readInput <$> readFile "input15"
mapM_ (print . runMoves input) [1, 2]
