From 41841ccbca3c3b6d6bd0c3f5fb06b58c93403db9 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Sun, 15 Dec 2024 19:05:51 +0000 Subject: [PATCH] Done day 15 --- advent15/Main.hs | 167 +++++++++++++++++++++++++++++++++++++++++++ adventofcode24.cabal | 6 +- 2 files changed, 172 insertions(+), 1 deletion(-) create mode 100644 advent15/Main.hs diff --git a/advent15/Main.hs b/advent15/Main.hs new file mode 100644 index 0000000..67dcadc --- /dev/null +++ b/advent15/Main.hs @@ -0,0 +1,167 @@ +-- Writeup at https://work.njae.me.uk/2024/12/12/advent-of-code-2024-day-12/ + +import AoC +import Linear +-- import qualified Data.Set as S +import qualified Data.Set as S +import Data.List (foldl', nub) +import Data.Maybe + +type Position = V2 Int -- r, c +type Items = S.Set Position +data World = World { walls :: Items, boxes :: Items, robot :: Position } + deriving (Show, Eq, Ord) +type Move = (Position, Position) -- move a box from here to there + + +pattern U, D, L, R :: Position +pattern U = V2 (-1) 0 +pattern D = V2 1 0 +pattern L = V2 0 (-1) +pattern R = V2 0 1 + + + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- readFile dataFileName + let world = mkWorld text + let commands = mkCommands text + -- print world + -- print commands + putStrLn $ showWorld world + let bigWorld = enlarge world + putStrLn $ showBigWorld bigWorld + let world' = foldl' doBigCommand bigWorld commands + putStrLn $ showBigWorld world' + print $ gps world' + -- print $ gps world' + print $ part1 world commands + print $ part2 world commands + +part1 :: World -> [Position] -> Int +part1 world commands = gps $ foldl' doCommand world commands +-- part1 regions = sum $ fmap fenceCost $ distinctSets regions +part2 world commands = gps $ foldl' doBigCommand bigWorld commands + where bigWorld = enlarge world + +doCommand :: World -> Position -> World +doCommand world dir + | there `S.member` world.walls = world + | there `S.member` world.boxes = fromMaybe world world' + | otherwise = world { robot = there } + where there = world.robot ^+^ dir + world' = do boxed <- moveBoxes world dir there + return boxed { robot = there } + +moveBoxes :: World -> Position -> Position -> Maybe World +moveBoxes world dir box + | there `S.member` world.walls = Nothing + | there `S.member` world.boxes = world' + | otherwise = Just $ world { boxes = shift world.boxes } + where there = box ^+^ dir + world' = do boxedWorld <- moveBoxes world dir there + let boxes' = shift boxedWorld.boxes + return boxedWorld { boxes = boxes'} + shift bs = S.insert there $ S.delete box bs + + +gps :: World -> Int +gps World { .. } = sum score + where rMax = S.findMax $ S.map (\(V2 r _) -> r) walls + cMax = S.findMax $ S.map (\(V2 _ c) -> c) walls + score = [ 100 * r + c + | c <- [0..cMax] + , r <- [0..rMax] + , V2 r c `elem` boxes + ] + +doBigCommand :: World -> Position -> World +doBigCommand world dir + | there `S.member` world.walls = world + | there `isBigBox` world.boxes = fromMaybe world rWorld + | otherwise = world { robot = there } + where there = world.robot ^+^ dir + movedBox = bigBoxActual world.boxes there + rWorld = do boxMoves <- moveBigBoxes world dir movedBox + let froms = fmap fst boxMoves + let tos = fmap snd boxMoves + let boxes' = (S.fromList tos) `S.union` (world.boxes `S.difference` (S.fromList froms)) + let world' = world { boxes = boxes' } + return world' { robot = there } + + +moveBigBoxes :: World -> Position -> Position -> Maybe [Move] +moveBigBoxes world dir box + | any (\t -> t `S.member` world.walls) there = Nothing + | any (\t -> t `isBigBox` world.boxes) there = allMoves + | otherwise = Just $ [ thisMove ] + where there = case dir of + U -> [box ^+^ U, box ^+^ R ^+^ U] + D -> [box ^+^ D, box ^+^ R ^+^ D] + L -> [box ^+^ L] + R -> [box ^+^ R ^+^ R] + _ -> [] + thisMove = (box, box ^+^ dir) + allMoves = do let there' = nub $ fmap (bigBoxActual world.boxes) $ filter (\t -> t `isBigBox` world.boxes) there + moves <- traverse (moveBigBoxes world dir) there' + let moves' = concat moves + return $ thisMove : moves' + +isBigBox :: Position -> Items -> Bool +isBigBox here bs = S.member here bs || S.member (here ^+^ L) bs + +bigBoxActual :: Items -> Position -> Position +bigBoxActual bs here + | here `S.member` bs = here + | otherwise = here ^+^ L + +showWorld :: World -> String +showWorld World { .. } = unlines rows + where rMax = S.findMax $ S.map (\(V2 r _) -> r) walls + cMax = S.findMax $ S.map (\(V2 _ c) -> c) walls + rows = [ [ if | V2 r c `elem` walls -> '#' + | V2 r c `elem` boxes -> 'O' + | V2 r c == robot -> '@' + | otherwise -> '.' + | c <- [0..cMax] ] + | r <- [0..rMax] ] + +showBigWorld :: World -> String +showBigWorld World { .. } = unlines rows + where rMax = S.findMax $ S.map (\(V2 r _) -> r) walls + cMax = S.findMax $ S.map (\(V2 _ c) -> c) walls + rows = [ [ if | V2 r c `elem` walls -> '#' + | V2 r c `elem` boxes -> '[' + | (V2 r c ^+^ L) `elem` boxes -> ']' + | V2 r c == robot -> '@' + | otherwise -> '.' + | c <- [0..cMax] ] + | r <- [0..rMax] ] + +mkWorld :: String -> World +mkWorld text = World { walls = walls, boxes = boxes, robot = robot } + where rows = takeWhile (not . null) $ lines text + rMax = length rows - 1 + cMax = (length $ head rows) - 1 + walls = S.fromList [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == '#' ] + boxes = S.fromList [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == 'O' ] + robot = head [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == '@' ] + +mkCommands :: String -> [Position] +mkCommands text = fmap readDirection $ concat rows + where rows = tail $ dropWhile (not . null) $ lines text + readDirection '^' = U + readDirection 'v' = D + readDirection '<' = L + readDirection '>' = R + +enlarge :: World -> World +enlarge World { .. } = World { walls = walls', boxes = boxes', robot = robot' } + where rMax = S.findMax $ S.map (\(V2 r _) -> r) walls + cMax = S.findMax $ S.map (\(V2 _ c) -> c) walls + walls' = S.unions $ S.map (\(V2 r c) -> S.fromList [V2 r (2 * c), V2 r (2 * c + 1)]) walls + boxes' = S.map (\(V2 r c) -> V2 r (2 * c)) boxes + V2 rr rc = robot + robot' = V2 rr (2 * rc) \ No newline at end of file diff --git a/adventofcode24.cabal b/adventofcode24.cabal index 75d093e..5519773 100644 --- a/adventofcode24.cabal +++ b/adventofcode24.cabal @@ -153,4 +153,8 @@ executable advent14 import: warnings, common-extensions, build-directives, common-modules main-is: advent14/Main.hs build-depends: attoparsec, text, linear, lens - \ No newline at end of file + +executable advent15 + import: warnings, common-extensions, build-directives, common-modules + main-is: advent15/Main.hs + build-depends: linear, containers -- 2.34.1