diff --git a/README.md b/README.md index eb86704..a9aa43b 100644 --- a/README.md +++ b/README.md @@ -9,3 +9,4 @@ Development occurs in language-specific directories: |[Day2.hs](hs/src/Day2.hs)|[Day2.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day2.kt)|[day2.py](py/aoc2024/day2.py)|[day2.rs](rs/src/day2.rs)| |[Day3.hs](hs/src/Day3.hs)|[Day3.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day3.kt)|[day3.py](py/aoc2024/day3.py)|[day3.rs](rs/src/day3.rs)| |[Day4.hs](hs/src/Day4.hs)|[Day4.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day4.kt)|[day4.py](py/aoc2024/day4.py)|[day4.rs](rs/src/day4.rs)| +|[Day5.hs](hs/src/Day5.hs)|||| diff --git a/hs/aoc2024.cabal b/hs/aoc2024.cabal index 6b55c0f..bb24d5b 100644 --- a/hs/aoc2024.cabal +++ b/hs/aoc2024.cabal @@ -25,6 +25,7 @@ library Day2 Day3 Day4 + Day5 other-modules: Common @@ -32,6 +33,7 @@ library build-depends: base ^>=4.20.0.0, containers ^>=0.7, + megaparsec ^>=9.7.0, text ^>=2.1.2, ghc-options: -Wall @@ -64,6 +66,7 @@ test-suite aoc2024-test Day2Spec Day3Spec Day4Spec + Day5Spec build-depends: aoc2024, diff --git a/hs/app/Main.hs b/hs/app/Main.hs index bd6d00f..79a36c8 100644 --- a/hs/app/Main.hs +++ b/hs/app/Main.hs @@ -11,8 +11,10 @@ import Day1 qualified (part1, part2) import Day2 qualified (part1, part2) import Day3 qualified (part1, part2) import Day4 qualified (part1, part2) +import Day5 qualified (part1, part2) import System.Environment (getArgs, lookupEnv) import System.FilePath (combine) +import Text.Megaparsec (errorBundlePretty) getDayInput :: Int -> IO Text getDayInput i = do @@ -37,3 +39,4 @@ main = do run 2 (either fail print) [Day2.part1, Day2.part2] run 3 print [Day3.part1, Day3.part2] run 4 print [Day4.part1, Day4.part2] + run 5 (either (fail . errorBundlePretty) print) [Day5.part1, Day5.part2] diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs index bedd3e2..55ee92b 100644 --- a/hs/bench/Main.hs +++ b/hs/bench/Main.hs @@ -10,6 +10,7 @@ import Day1 qualified (part1, part2) import Day2 qualified (part1, part2) import Day3 qualified (part1, part2) import Day4 qualified (part1, part2) +import Day5 qualified (part1, part2) import System.Environment.Blank (getEnv, setEnv, unsetEnv) import System.FilePath (combine) @@ -50,5 +51,11 @@ main = "Day 4" [ bench "part 1" $ nf Day4.part1 input, bench "part 2" $ nf Day4.part2 input + ], + env (getDayInput 5) $ \input -> + bgroup + "Day 5" + [ bench "part 1" $ nf Day5.part1 input, + bench "part 2" $ nf Day5.part2 input ] ] diff --git a/hs/src/Day5.hs b/hs/src/Day5.hs new file mode 100644 index 0000000..f3c11e3 --- /dev/null +++ b/hs/src/Day5.hs @@ -0,0 +1,58 @@ +-- | +-- Module: Day5 +-- Description: +module Day5 (part1, part2) where + +import Control.Arrow (second) +import Data.IntMap qualified as IntMap (findWithDefault, fromList, (!?)) +import Data.IntMap.Strict qualified as IntMap (fromListWith) +import Data.IntSet qualified as IntSet (empty, member, singleton, toList, union) +import Data.List (sortBy) +import Data.Maybe (fromJust, fromMaybe) +import Data.String (IsString) +import Data.Text (Text) +import Data.Void (Void) +import Text.Megaparsec (MonadParsec, ParseErrorBundle, Stream (Token, Tokens), parse, sepEndBy, sepEndBy1, skipMany) +import Text.Megaparsec.Char (char, newline) +import Text.Megaparsec.Char.Lexer (decimal) + +parser :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m ([(a, a)], [[a]]) +parser = + (,) + <$> ((,) <$> decimal <* char '|' <*> decimal) `sepEndBy` newline + <* skipMany newline + <*> (decimal `sepEndBy1` char ',') `sepEndBy` newline + +part1 :: Text -> Either (ParseErrorBundle Text Void) Int +part1 input = do + (deps, updates) <- parse parser "" input + pure $ + sum + [ update !! (length update `div` 2) + | update <- updates, + let order = IntMap.fromList @Int $ zip update [0 ..], + and + [ fromMaybe True $ (<) <$> order IntMap.!? a <*> order IntMap.!? b + | (a, b) <- deps + ] + ] + +part2 :: Text -> Either (ParseErrorBundle Text Void) Int +part2 input = do + (deps, updates) <- parse parser "" input + let deps' = IntMap.fromListWith IntSet.union $ second IntSet.singleton <$> deps + tryCompare a b + | a == b = Just EQ + | b `IntSet.member` (IntMap.findWithDefault IntSet.empty a deps') = Just LT + | a `IntSet.member` (IntMap.findWithDefault IntSet.empty b deps') = Just GT + | otherwise = + mconcat (tryCompare a <$> maybe [] IntSet.toList (deps' IntMap.!? b)) + <> fmap (compare EQ) (mconcat (tryCompare b <$> maybe [] IntSet.toList (deps' IntMap.!? a))) + compare' a b = fromJust $ tryCompare a b + pure $ + sum + [ update' !! (length update `div` 2) + | update <- updates, + let update' = sortBy compare' update, + update /= update' + ] diff --git a/hs/test/Day5Spec.hs b/hs/test/Day5Spec.hs new file mode 100644 index 0000000..9a9cb48 --- /dev/null +++ b/hs/test/Day5Spec.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Day5Spec (spec) where + +import Data.Text (Text) +import Data.Text qualified as T (unlines) +import Day5 (part1, part2) +import Test.Hspec (Spec, describe, it, shouldBe) + +example :: Text +example = + T.unlines + [ "47|53", + "97|13", + "97|61", + "97|47", + "75|29", + "61|13", + "75|53", + "29|13", + "97|29", + "53|29", + "61|53", + "97|53", + "61|29", + "47|13", + "75|47", + "97|75", + "47|61", + "75|61", + "47|29", + "75|13", + "53|13", + "", + "75,47,61,53,29", + "97,61,53,29,13", + "75,29,13", + "75,97,47,61,53", + "61,13,29", + "97,13,75,29,47" + ] + +spec :: Spec +spec = do + describe "part 1" $ do + it "examples" $ do + part1 example `shouldBe` Right 143 + describe "part 2" $ do + it "examples" $ do + part2 example `shouldBe` Right 123