From 35ef96cc8add97f3dc6617e742d9ab04e82cb65a Mon Sep 17 00:00:00 2001
From: Daniel Lin <ephemient@gmail.com>
Date: Wed, 4 Dec 2024 00:59:58 -0500
Subject: [PATCH] Day 4: Ceres Search

---
 README.md           |  1 +
 hs/aoc2024.cabal    |  2 ++
 hs/app/Main.hs      |  2 ++
 hs/bench/Main.hs    |  7 +++++++
 hs/src/Day4.hs      | 29 +++++++++++++++++++++++++++++
 hs/test/Day4Spec.hs | 32 ++++++++++++++++++++++++++++++++
 6 files changed, 73 insertions(+)
 create mode 100644 hs/src/Day4.hs
 create mode 100644 hs/test/Day4Spec.hs

diff --git a/README.md b/README.md
index 7f80b016..fc48442b 100644
--- a/README.md
+++ b/README.md
@@ -8,3 +8,4 @@ Development occurs in language-specific directories:
 |[Day1.hs](hs/src/Day1.hs)|[Day1.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day1.kt)|[day1.py](py/aoc2024/day1.py)|[day1.rs](rs/src/day1.rs)|
 |[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)||||
diff --git a/hs/aoc2024.cabal b/hs/aoc2024.cabal
index c28694ea..6b55c0f2 100644
--- a/hs/aoc2024.cabal
+++ b/hs/aoc2024.cabal
@@ -24,6 +24,7 @@ library
     Day1
     Day2
     Day3
+    Day4
 
   other-modules:
     Common
@@ -62,6 +63,7 @@ test-suite aoc2024-test
     Day1Spec
     Day2Spec
     Day3Spec
+    Day4Spec
 
   build-depends:
     aoc2024,
diff --git a/hs/app/Main.hs b/hs/app/Main.hs
index a53999cf..bd6d00f6 100644
--- a/hs/app/Main.hs
+++ b/hs/app/Main.hs
@@ -10,6 +10,7 @@ import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
+import Day4 qualified (part1, part2)
 import System.Environment (getArgs, lookupEnv)
 import System.FilePath (combine)
 
@@ -35,3 +36,4 @@ main = do
   run 1 (either fail print) [Day1.part1, Day1.part2]
   run 2 (either fail print) [Day2.part1, Day2.part2]
   run 3 print [Day3.part1, Day3.part2]
+  run 4 print [Day4.part1, Day4.part2]
diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs
index 830dd4d1..bedd3e25 100644
--- a/hs/bench/Main.hs
+++ b/hs/bench/Main.hs
@@ -9,6 +9,7 @@ import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
+import Day4 qualified (part1, part2)
 import System.Environment.Blank (getEnv, setEnv, unsetEnv)
 import System.FilePath (combine)
 
@@ -43,5 +44,11 @@ main =
           "Day 3"
           [ bench "part 1" $ nf Day3.part1 input,
             bench "part 2" $ nf Day3.part2 input
+          ],
+      env (getDayInput 4) $ \input ->
+        bgroup
+          "Day 4"
+          [ bench "part 1" $ nf Day4.part1 input,
+            bench "part 2" $ nf Day4.part2 input
           ]
     ]
diff --git a/hs/src/Day4.hs b/hs/src/Day4.hs
new file mode 100644
index 00000000..b0ae7ff9
--- /dev/null
+++ b/hs/src/Day4.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module:         Day4
+-- Description:    <https://adventofcode.com/2024/day/4 Day 4: Ceres Search>
+module Day4 (part1, part2) where
+
+import Control.Monad (guard)
+import Data.List (tails)
+import Data.Text (Text)
+import Data.Text qualified as T (drop, index, length, lines, reverse, splitOn, takeEnd, transpose, unpack)
+
+part1 :: Text -> Int
+part1 input = sum $ pred . length . T.splitOn "XMAS" <$> gs
+  where
+    g = T.lines input
+    d1 = T.transpose (zipWith T.drop [0 ..] g) ++ T.transpose (zipWith T.takeEnd [0 ..] $ T.reverse <$> g)
+    d2 = T.transpose (zipWith T.drop [0 ..] $ T.reverse <$> g) ++ T.transpose (zipWith T.takeEnd [0 ..] g)
+    gs = concat [g, T.reverse <$> g, T.transpose g, T.transpose $ reverse g, d1, T.reverse <$> d1, d2, T.reverse <$> d2]
+
+part2 :: Text -> Int
+part2 input = length $ do
+  prev : line : next : _ <- tails $ T.lines input
+  (i, 'A') <- zip [0 ..] $ T.unpack line
+  guard $ [prev !? pred i, prev !? succ i, next !? pred i, next !? succ i] `elem` ["MMSS", "MSMS", "SMSM", "SSMM"]
+  where
+    t !? i
+      | 0 <= i, i < T.length t = t `T.index` i
+      | otherwise = '\0'
diff --git a/hs/test/Day4Spec.hs b/hs/test/Day4Spec.hs
new file mode 100644
index 00000000..101630e8
--- /dev/null
+++ b/hs/test/Day4Spec.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day4Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day4 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example :: Text
+example =
+  T.unlines
+    [ "MMMSXXMASM",
+      "MSAMXMSMSA",
+      "AMXSXMAAMM",
+      "MSAMASMSMX",
+      "XMASAMXAMM",
+      "XXAMMXXAMA",
+      "SMSMSASXSS",
+      "SAXAMASAAA",
+      "MAMMMXMMMM",
+      "MXMXAXMASX"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1 example `shouldBe` 18
+  describe "part 2" $ do
+    it "examples" $ do
+      part2 example `shouldBe` 9