diff --git a/README.md b/README.md index 5ffbf1d7..75ba7976 100644 --- a/README.md +++ b/README.md @@ -28,3 +28,4 @@ Development occurs in language-specific directories: |[Day21.hs](hs/src/Day21.hs)|[Day21.kt](kt/aoc2024-lib/src/jvmCodegen/kotlin/com/github/ephemient/aoc2024/codegen/Day21.kt)|[day21.py](py/aoc2024/day21.py)|[day21.rs](rs/src/day21.rs)| |[Day22.hs](hs/src/Day22.hs)|[Day22.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day22.kt)|[day22.py](py/aoc2024/day22.py)|[day22.rs](rs/src/day22.rs)| |[Day23.hs](hs/src/Day23.hs)|[Day23.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day23.kt)|[day23.py](py/aoc2024/day23.py)|[day23.rs](rs/src/day23.rs)| +|[Day24.hs](hs/src/Day24.hs) ½|||| diff --git a/hs/aoc2024.cabal b/hs/aoc2024.cabal index 534b57b5..17ea3de3 100644 --- a/hs/aoc2024.cabal +++ b/hs/aoc2024.cabal @@ -37,6 +37,7 @@ library Day21 Day22 Day23 + Day24 Day3 Day4 Day5 @@ -100,6 +101,7 @@ test-suite aoc2024-test Day21Spec Day22Spec Day23Spec + Day24Spec Day2Spec Day3Spec Day4Spec diff --git a/hs/app/Main.hs b/hs/app/Main.hs index be77367a..f2caabf8 100644 --- a/hs/app/Main.hs +++ b/hs/app/Main.hs @@ -26,6 +26,7 @@ import Day20 qualified (solve) import Day21 qualified (solve) import Day22 qualified (part1, part2) import Day23 qualified (part1, part2) +import Day24 qualified (part1) import Day3 qualified (part1, part2) import Day4 qualified (part1, part2) import Day5 qualified (part1, part2) @@ -79,3 +80,4 @@ main = do run 21 print [Day21.solve 2, Day21.solve 25] run 22 (either fail print) [Day22.part1, Day22.part2] run 23 putStrLn [show . Day23.part1, T.unpack . Day23.part2] + run 24 (either (fail . errorBundlePretty) (maybe (fail "error") print)) [Day24.part1] diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs index 4a7b5bee..74f24155 100644 --- a/hs/bench/Main.hs +++ b/hs/bench/Main.hs @@ -22,6 +22,7 @@ import Day20 qualified (solve) import Day21 qualified (solve) import Day22 qualified (part1, part2) import Day23 qualified (part1, part2) +import Day24 qualified (part1) import Day3 qualified (part1, part2) import Day4 qualified (part1, part2) import Day5 qualified (part1, part2) @@ -182,5 +183,10 @@ main = "Day 23" [ bench "part 1" $ nf Day23.part1 input, bench "part 2" $ nf Day23.part2 input + ], + env (getDayInput 24) $ \input -> + bgroup + "Day 24" + [ bench "part 1" $ nf Day24.part1 input ] ] diff --git a/hs/src/Day24.hs b/hs/src/Day24.hs new file mode 100644 index 00000000..7f9f8017 --- /dev/null +++ b/hs/src/Day24.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Day24 +-- Description: +module Day24 (part1) where + +import Control.Applicative ((<|>)) +import Control.Monad (join, liftM2) +import Data.Bifunctor (bimap) +import Data.Bits ((.&.), (.^.), (.|.)) +import Data.Char (isAlphaNum) +import Data.Functor (($>)) +import Data.Map qualified as Map (dropWhileAntitone, fromList, takeWhileAntitone, (!?)) +import Data.String (IsString) +import Data.Text (Text) +import Data.Text qualified as T (singleton) +import Data.Void (Void) +import Text.Megaparsec (MonadParsec, ParseErrorBundle, Token, Tokens, choice, parse, sepEndBy, takeWhile1P) +import Text.Megaparsec.Char (newline, string) +import Text.Megaparsec.Char.Lexer qualified as L (decimal) + +data Expr a = Expr a :&: Expr a | Expr a :|: Expr a | Expr a :^: Expr a | Literal a + +parser :: (MonadParsec e s m, IsString (Tokens s), Token s ~ Char, Num a) => m ([(Tokens s, a)], [(Tokens s, Expr (Tokens s))]) +parser = (,) <$> (initial `sepEndBy` newline) <* newline <*> (wire `sepEndBy` newline) + where + initial = (,) <$> takeWhile1P Nothing isAlphaNum <* string ": " <*> L.decimal + wire = + flip (,) + <$> ( (flip ($) . Literal <$> takeWhile1P Nothing isAlphaNum) + <*> choice [string " AND " $> (:&:), string " OR " $> (:|:), string " XOR " $> (:^:)] + <*> (Literal <$> takeWhile1P Nothing isAlphaNum) + ) + <* string " -> " + <*> takeWhile1P Nothing isAlphaNum + +part1 :: Text -> Either (ParseErrorBundle Text Void) (Maybe Int) +part1 input = do + (givens, wires) <- bimap Map.fromList Map.fromList <$> parse parser "" input + let values = fmap eval wires + eval (a :&: b) = (.&.) <$> eval a <*> eval b + eval (a :|: b) = (.|.) <$> eval a <*> eval b + eval (a :^: b) = (.^.) <$> eval a <*> eval b + eval (Literal a) = givens Map.!? a <|> join (values Map.!? a) + pure $ + foldr (liftM2 . flip $ (+) . (*) 2) (Just 0) $ + Map.takeWhileAntitone (< T.singleton (succ 'z')) $ + Map.dropWhileAntitone (< "z") values diff --git a/hs/test/Day24Spec.hs b/hs/test/Day24Spec.hs new file mode 100644 index 00000000..4a3bfba5 --- /dev/null +++ b/hs/test/Day24Spec.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Day24Spec (spec) where + +import Data.Text (Text) +import Data.Text qualified as T (unlines) +import Day24 (part1) +import Test.Hspec (Spec, describe, it, shouldBe) + +example1, example2 :: Text +example1 = + T.unlines + [ "x00: 1", + "x01: 1", + "x02: 1", + "y00: 0", + "y01: 1", + "y02: 0", + "", + "x00 AND y00 -> z00", + "x01 XOR y01 -> z01", + "x02 OR y02 -> z02" + ] +example2 = + T.unlines + [ "x00: 1", + "x01: 0", + "x02: 1", + "x03: 1", + "x04: 0", + "y00: 1", + "y01: 1", + "y02: 1", + "y03: 1", + "y04: 1", + "", + "ntg XOR fgs -> mjb", + "y02 OR x01 -> tnw", + "kwq OR kpj -> z05", + "x00 OR x03 -> fst", + "tgd XOR rvg -> z01", + "vdt OR tnw -> bfw", + "bfw AND frj -> z10", + "ffh OR nrd -> bqk", + "y00 AND y03 -> djm", + "y03 OR y00 -> psh", + "bqk OR frj -> z08", + "tnw OR fst -> frj", + "gnj AND tgd -> z11", + "bfw XOR mjb -> z00", + "x03 OR x00 -> vdt", + "gnj AND wpb -> z02", + "x04 AND y00 -> kjc", + "djm OR pbm -> qhw", + "nrd AND vdt -> hwm", + "kjc AND fst -> rvg", + "y04 OR y02 -> fgs", + "y01 AND x02 -> pbm", + "ntg OR kjc -> kwq", + "psh XOR fgs -> tgd", + "qhw XOR tgd -> z09", + "pbm OR djm -> kpj", + "x03 XOR y03 -> ffh", + "x00 XOR y04 -> ntg", + "bfw OR bqk -> z06", + "nrd XOR fgs -> wpb", + "frj XOR qhw -> z04", + "bqk OR frj -> z07", + "y03 OR x01 -> nrd", + "hwm AND bqk -> z03", + "tgd XOR rvg -> z12", + "tnw OR pbm -> gnj" + ] + +spec :: Spec +spec = do + describe "part 1" $ do + it "examples" $ do + part1 example1 `shouldBe` Right (Just 4) + part1 example2 `shouldBe` Right (Just 2024)