diff --git a/README.md b/README.md index 4665fcc..70e0c52 100644 --- a/README.md +++ b/README.md @@ -18,3 +18,4 @@ Development occurs in language-specific directories: |[Day11.hs](hs/src/Day11.hs)|[Day11.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day11.kt)|[day11.py](py/aoc2024/day11.py)|[day11.rs](rs/src/day11.rs)| |[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)|||| diff --git a/hs/aoc2024.cabal b/hs/aoc2024.cabal index dde2a0d..20aaafa 100644 --- a/hs/aoc2024.cabal +++ b/hs/aoc2024.cabal @@ -26,6 +26,7 @@ library Day11 Day12 Day13 + Day14 Day2 Day3 Day4 @@ -77,6 +78,7 @@ test-suite aoc2024-test Day11Spec Day12Spec Day13Spec + Day14Spec Day1Spec Day2Spec Day3Spec diff --git a/hs/app/Main.hs b/hs/app/Main.hs index fea325a..97e10d3 100644 --- a/hs/app/Main.hs +++ b/hs/app/Main.hs @@ -12,6 +12,7 @@ import Day10 qualified (part1, part2) import Day11 qualified (part1, part2) import Day12 qualified (part1, part2) import Day13 qualified (part1, part2) +import Day14 qualified (part1, part2) import Day2 qualified (part1, part2) import Day3 qualified (part1, part2) import Day4 qualified (part1, part2) @@ -56,3 +57,4 @@ main = do run 11 (either fail print) [Day11.part1, Day11.part2] 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] diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs index 2a735bd..54db69d 100644 --- a/hs/bench/Main.hs +++ b/hs/bench/Main.hs @@ -11,6 +11,7 @@ import Day10 qualified (part1, part2) import Day11 qualified (part1, part2) import Day12 qualified (part1, part2) import Day13 qualified (part1, part2) +import Day14 qualified (part1, part2) import Day2 qualified (part1, part2) import Day3 qualified (part1, part2) import Day4 qualified (part1, part2) @@ -113,5 +114,11 @@ main = "Day 13" [ bench "part 1" $ nf Day13.part1 input, bench "part 2" $ nf Day13.part2 input + ], + env (getDayInput 14) $ \input -> + bgroup + "Day 14" + [ bench "part 1" $ nf Day14.part1 input, + bench "part 2" $ nf Day14.part2 input ] ] diff --git a/hs/src/Common.hs b/hs/src/Common.hs index db1d650..e509134 100644 --- a/hs/src/Common.hs +++ b/hs/src/Common.hs @@ -1,4 +1,4 @@ -module Common (readEntire, readMany, readSome) where +module Common (groupConsecutiveBy, readEntire, readMany, readSome) where import Control.Arrow (first) import Data.Char (isSpace) @@ -7,6 +7,13 @@ import Data.Text (Text) import Data.Text qualified as T (dropWhile, null) import Data.Text.Read (Reader) +groupConsecutiveBy :: (a -> a -> Bool) -> [a] -> [[a]] +groupConsecutiveBy f xs = chunk id $ zip xs $ True : zipWith f xs (drop 1 xs) + where + chunk k [] = filter (not . null) [k []] + chunk k ((x, False) : rest) = k [] : chunk (x :) rest + chunk k ((x, True) : rest) = chunk (k . (x :)) rest + readEntire :: Reader a -> Text -> Either String a readEntire reader input = do (a, t) <- reader input diff --git a/hs/src/Day14.hs b/hs/src/Day14.hs new file mode 100644 index 0000000..1037de2 --- /dev/null +++ b/hs/src/Day14.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Day14 +-- Description: +module Day14 (part1, part1', part2) where + +import Common (groupConsecutiveBy) +import Control.Monad (join, liftM2) +import Data.Map qualified as Map (findWithDefault) +import Data.Map.Strict qualified as Map (fromListWith) +import Data.Ord (Down (Down)) +import Data.Set qualified as Set (fromList, toList) +import Data.String (IsString) +import Data.Text (Text) +import Data.Void (Void) +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) + +parser :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m [((a, a), (a, a))] +parser = line `sepEndBy1` newline + where + line = (,) <$> (string "p=" *> v2) <*> (string " v=" *> v2) + v2 = (,) <$> (L.signed (pure ()) L.decimal <* char ',') <*> (L.signed (pure ()) L.decimal) + +part1 :: Text -> Either (ParseErrorBundle Text Void) Int +part1 = part1' 101 103 + +part1' :: Int -> Int -> Text -> Either (ParseErrorBundle Text Void) Int +part1' width height input = do + robots <- parse parser "" input + let totals = + Map.fromListWith (+) $ + [ ((compare x $ width `div` 2, compare y $ height `div` 2), 1) + | ((x0, y0), (vx, vy)) <- robots, + let x = (x0 + vx * t) `mod` width + y = (y0 + vy * t) `mod` height + ] + pure $ product [Map.findWithDefault 0 k totals | k <- join (liftM2 (,)) [LT, GT]] + where + t = 100 + +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 + ] + where + width = 101 + height = 103 diff --git a/hs/test/Day14Spec.hs b/hs/test/Day14Spec.hs new file mode 100644 index 0000000..3d4d411 --- /dev/null +++ b/hs/test/Day14Spec.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Day14Spec (spec) where + +import Data.Text (Text) +import Data.Text qualified as T (unlines) +import Day14 (part1') +import Test.Hspec (Spec, describe, it, shouldBe) + +example :: Text +example = + T.unlines + [ "p=0,4 v=3,-3", + "p=6,3 v=-1,-3", + "p=10,3 v=-1,2", + "p=2,0 v=2,-1", + "p=0,0 v=1,3", + "p=3,0 v=-2,-2", + "p=7,6 v=-1,-3", + "p=3,0 v=-1,-2", + "p=9,3 v=2,3", + "p=7,3 v=-1,2", + "p=2,4 v=2,-3", + "p=9,5 v=-3,-3" + ] + +spec :: Spec +spec = do + describe "part 1" $ do + it "examples" $ do + part1' 11 7 example `shouldBe` Right 12