diff --git a/README.md b/README.md index b0662be1..2e5b1c21 100644 --- a/README.md +++ b/README.md @@ -19,3 +19,4 @@ Development occurs in language-specific directories: |[Day12.hs](hs/src/Day12.hs)|[Day12.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day12.kt)|[day12.py](py/aoc2024/day12.py)|| |[Day13.hs](hs/src/Day13.hs)|[Day13.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day13.kt)|[day13.py](py/aoc2024/day13.py)|| |[Day14.hs](hs/src/Day14.hs)|[Day14.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day14.kt)||| +|[Day15.hs](hs/src/Day15.hs)|||| diff --git a/hs/aoc2024.cabal b/hs/aoc2024.cabal index 20aaafa1..969e0a40 100644 --- a/hs/aoc2024.cabal +++ b/hs/aoc2024.cabal @@ -27,6 +27,7 @@ library Day12 Day13 Day14 + Day15 Day2 Day3 Day4 @@ -40,6 +41,7 @@ library Common build-depends: + array ^>=0.5.7.0, base ^>=4.20.0.0, containers ^>=0.7, megaparsec ^>=9.7.0, @@ -79,6 +81,7 @@ test-suite aoc2024-test Day12Spec Day13Spec Day14Spec + Day15Spec Day1Spec Day2Spec Day3Spec diff --git a/hs/app/Main.hs b/hs/app/Main.hs index 97e10d3c..48ba5a10 100644 --- a/hs/app/Main.hs +++ b/hs/app/Main.hs @@ -13,6 +13,7 @@ import Day11 qualified (part1, part2) import Day12 qualified (part1, part2) import Day13 qualified (part1, part2) import Day14 qualified (part1, part2) +import Day15 qualified (part1, part2) import Day2 qualified (part1, part2) import Day3 qualified (part1, part2) import Day4 qualified (part1, part2) @@ -58,3 +59,4 @@ main = do run 12 print [Day12.part1, Day12.part2] run 13 (either (fail . errorBundlePretty) print) [Day13.part1, Day13.part2] run 14 (either (fail . errorBundlePretty) print) [Day14.part1, Day14.part2] + run 15 (either fail print) [Day15.part1, Day15.part2] diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs index 54db69d2..cee98df5 100644 --- a/hs/bench/Main.hs +++ b/hs/bench/Main.hs @@ -12,6 +12,7 @@ import Day11 qualified (part1, part2) import Day12 qualified (part1, part2) import Day13 qualified (part1, part2) import Day14 qualified (part1, part2) +import Day15 qualified (part1, part2) import Day2 qualified (part1, part2) import Day3 qualified (part1, part2) import Day4 qualified (part1, part2) @@ -120,5 +121,11 @@ main = "Day 14" [ bench "part 1" $ nf Day14.part1 input, bench "part 2" $ nf Day14.part2 input + ], + env (getDayInput 15) $ \input -> + bgroup + "Day 15" + [ bench "part 1" $ nf Day15.part1 input, + bench "part 2" $ nf Day15.part2 input ] ] diff --git a/hs/src/Day14.hs b/hs/src/Day14.hs index 1037de22..b625d457 100644 --- a/hs/src/Day14.hs +++ b/hs/src/Day14.hs @@ -7,6 +7,7 @@ module Day14 (part1, part1', part2) where import Common (groupConsecutiveBy) import Control.Monad (join, liftM2) +import Data.Char (intToDigit) import Data.Map qualified as Map (findWithDefault) import Data.Map.Strict qualified as Map (fromListWith) import Data.Ord (Down (Down)) @@ -14,6 +15,7 @@ import Data.Set qualified as Set (fromList, toList) import Data.String (IsString) import Data.Text (Text) import Data.Void (Void) +import Debug.Trace (traceM) import Text.Megaparsec (MonadParsec, ParseErrorBundle, Stream (Token, Tokens), parse, sepEndBy1) import Text.Megaparsec.Char (char, newline, string) import Text.Megaparsec.Char.Lexer qualified as L (decimal, signed) @@ -22,7 +24,7 @@ parser :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m [ parser = line `sepEndBy1` newline where line = (,) <$> (string "p=" *> v2) <*> (string " v=" *> v2) - v2 = (,) <$> (L.signed (pure ()) L.decimal <* char ',') <*> (L.signed (pure ()) L.decimal) + v2 = (,) <$> (L.signed (pure ()) L.decimal <* char ',') <*> L.signed (pure ()) L.decimal part1 :: Text -> Either (ParseErrorBundle Text Void) Int part1 = part1' 101 103 @@ -44,16 +46,30 @@ part1' width height input = do part2 :: Text -> Either (ParseErrorBundle Text Void) Int part2 input = do robots <- parse parser "" input - pure . snd . minimum $ - [ (Down $ maximum $ map length verticalLines, t) - | t <- [0 .. lcm width height - 1], - let verticalLines = - groupConsecutiveBy isLine . Set.toList . Set.fromList $ - [ ((y0 + vy * t) `mod` height, (x0 + vx * t) `mod` width) - | ((x0, y0), (vx, vy)) <- robots - ] - isLine (y0, x0) (y1, x1) = y0 == y1 && x0 + 1 == x1 - ] + let (_, bestTime) = + minimum + [ (Down $ maximum $ map length verticalLines, t) + | t <- [0 .. lcm width height - 1], + let verticalLines = + groupConsecutiveBy isLine . Set.toList . Set.fromList $ + [ ((y0 + vy * t) `mod` height, (x0 + vx * t) `mod` width) + | ((x0, y0), (vx, vy)) <- robots + ] + isLine (y0, x0) (y1, x1) = y0 == y1 && x0 + 1 == x1 + ] + positions = + Map.fromListWith (+) $ + [ (((x0 + vx * bestTime) `mod` width, (y0 + vy * bestTime) `mod` height), 1) + | ((x0, y0), (vx, vy)) <- robots + ] + line y = + [ case Map.findWithDefault 0 (x, y) positions of + 0 -> '.' + n -> if n < 10 then intToDigit n else '+' + | x <- [0 .. width - 1] + ] + mapM_ (traceM . line) [0 .. height - 1] + pure bestTime where width = 101 height = 103 diff --git a/hs/src/Day15.hs b/hs/src/Day15.hs new file mode 100644 index 00000000..92a6e43e --- /dev/null +++ b/hs/src/Day15.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Day15 +-- Description: +module Day15 (part1, part2) where + +import Control.Arrow (Arrow (first, second)) +import Control.Exception (assert) +import Data.Array.Unboxed (IArray, UArray, assocs, listArray, (!), (//)) +import Data.List (sort) +import Data.Text (Text) +import Data.Text qualified as T (breakOn, concat, concatMap, foldl', justifyLeft, length, lines, singleton, unpack) +import Data.Text.Read (Reader) + +parse :: (IArray a Char) => Reader (a (Int, Int) Char) +parse input + | null grid = Left "empty warehouse" + | otherwise = + Right + ( listArray ((0, 0), (height - 1, width - 1)) . T.unpack . T.concat $ + T.justifyLeft width '.' <$> grid, + rest + ) + where + (grid, rest) = first T.lines $ T.breakOn "\n\n" input + height = length grid + width = maximum $ 0 : map T.length grid + +part1 :: Text -> Either String Int +part1 input = do + (grid0, moves) <- parse @UArray input + pos0 <- case filter ((== '@') . snd) $ assocs grid0 of + [(pos0, _)] -> Right pos0 + _ -> Left "can't find @" + pure . sum $ + [ 100 * y + x + | ((y, x), c) <- assocs . fst $ T.foldl' move (grid0, pos0) moves, + c == 'O' || c == '[' + ] + where + move state@(grid, pos) c + | '^' <- c = move' moveY (first pred pos) (-1) + | 'v' <- c = move' moveY (first succ pos) 1 + | '<' <- c = move' moveX (second pred pos) (-1) + | '>' <- c = move' moveX (second succ pos) 1 + where + move' mover pos' delta = + assert (grid ! pos == '@') . maybe state ((,pos') . (grid //) . sort) $ + mover delta pos' [(pos', '@'), (pos, '.')] + moveY, moveX :: Int -> (Int, Int) -> [((Int, Int), Char)] -> Maybe [((Int, Int), Char)] + moveY dy pos'@(y, x) k = case grid ! pos' of + '.' -> Just k + 'O' -> moveY dy (y + dy, x) $ ((y + dy, x), 'O') : (pos', '.') : k + '[' -> + assert (grid ! (y, x + 1) == ']') do + k' <- + moveY dy (y + dy, x) $ + ((y + dy, x), '[') : ((y + dy, x + 1), ']') : ((y, x), '.') : ((y, x + 1), '.') : k + moveY dy (y + dy, x + 1) k' + ']' -> assert (grid ! (y, x - 1) == '[') do + k' <- moveY dy (y + dy, x) $ ((y + dy, x - 1), '[') : ((y + dy, x), ']') : ((y, x - 1), '.') : ((y, x), '.') : k + moveY dy (y + dy, x - 1) k' + _ -> Nothing + moveX dx pos'@(y, x) k = case grid ! pos' of + '.' -> Just k + d | d == 'O' || d == '[' || d == ']' -> moveX dx (y, x + dx) $ ((y, x + dx), d) : (pos', '.') : k + _ -> Nothing + move state _ = state + +part2 :: Text -> Either String Int +part2 = + part1 . T.concatMap \case + '#' -> "##" + '.' -> ".." + '@' -> "@." + 'O' -> "[]" + c -> T.singleton c diff --git a/hs/test/Day15Spec.hs b/hs/test/Day15Spec.hs new file mode 100644 index 00000000..f9e1d78e --- /dev/null +++ b/hs/test/Day15Spec.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Day15Spec (spec) where + +import Data.Text (Text) +import Data.Text qualified as T (unlines) +import Day15 (part1, part2) +import Test.Hspec (Spec, describe, it, shouldBe) + +example1, example2, example3 :: Text +example1 = + T.unlines + [ "##########", + "#..O..O.O#", + "#......O.#", + "#.OO..O.O#", + "#..O@..O.#", + "#O#..O...#", + "#O..O..O.#", + "#.OO.O.OO#", + "#....O...#", + "##########", + "", + "^v>^vv^v>v<>v^v<<><>>v^v^>^<<<><^", + "vvv<<^>^v^^><<>>><>^<<><^vv^^<>vvv<>><^^v>^>vv<>v<<<^<^^>>>^<>vv>v^v^<>><>>>><^^>vv>v<^^^>>v^v^<^^>v^^>v^<^v>v<>>v^v^v^^<^^vv<", + "<>^^^^>>>v^<>vvv^>^^^vv^^>v<^^^^v<>^>vvvv><>>v^<<^^^^^", + "^><^><>>><>^^<<^^v>>><^^>v>>>^v><>^v><<<>vvvv>^<><<>^><", + "^>><>^v<><^vvv<^^<><^v<<<><<<^^<^>>^<<<^>>^v^>>^v>vv>^<<^v<>><<><<>v<^vv<<<>^^v^>^^>>><<^v>>v^v><^^>>^<>vv^", + "<><^^>^^^<>^vv<<^><<><<><<<^^<<<^<<>><<><^^^>^^<>^>v<>", + "^^>vv<^v^v^<>^^^>>>^^vvv^>vvv<>>>^<^>>>>>^<<^v>^vvv<>^<><", + "v^^>>><<^^<>>^v^v^<<>^<^v^v><^<<<><<^vv>>v>v^<<^" + ] +example2 = + T.unlines + [ "########", + "#..O.O.#", + "##@.O..#", + "#...O..#", + "#.#.O..#", + "#...O..#", + "#......#", + "########", + "", + "<^^>>>vv>v<<" + ] +example3 = + T.unlines + [ "#######", + "#...#.#", + "#.....#", + "#..OO@#", + "#..O..#", + "#.....#", + "#######", + "", + "