Merge pull request #161 from ephemient/hs/day24

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) ½||||

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

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]

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
           ]
     ]

hs/src/Day24.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module:         Day24
+-- Description:    <https://adventofcode.com/2024/day/24 Day 24: Crossed Wires>
+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

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)