Merge pull request #89 from ephemient/hs/day12

README.md

@@ -16,3 +16,4 @@ Development occurs in language-specific directories:
 |[Day9.hs](hs/src/Day9.hs)|[Day9.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day9.kt)|[day9.py](py/aoc2024/day9.py)|[day9.rs](rs/src/day9.rs)|
 |[Day10.hs](hs/src/Day10.hs)|[Day10.kt](kt/aoc2024-lib/src/commonMain/kotlin/com/github/ephemient/aoc2024/Day10.kt)|[day10.py](py/aoc2024/day10.py)|[day10.rs](rs/src/day10.rs)|
 |[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)||||

hs/aoc2024.cabal

@@ -24,6 +24,7 @@ library
     Day1
     Day10
     Day11
+    Day12
     Day2
     Day3
     Day4
@@ -73,6 +74,7 @@ test-suite aoc2024-test
   other-modules:
     Day10Spec
     Day11Spec
+    Day12Spec
     Day1Spec
     Day2Spec
     Day3Spec

hs/app/Main.hs

@@ -10,6 +10,7 @@ import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
 import Day10 qualified (part1, part2)
 import Day11 qualified (part1, part2)
+import Day12 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
@@ -52,3 +53,4 @@ main = do
   run 9 print [Day9.part1, Day9.part2]
   run 10 print [Day10.part1, Day10.part2]
   run 11 (either fail print) [Day11.part1, Day11.part2]
+  run 12 print [Day12.part1, Day12.part2]

hs/bench/Main.hs

@@ -9,6 +9,7 @@ import Data.Text.IO qualified as TIO (readFile)
 import Day1 qualified (part1, part2)
 import Day10 qualified (part1, part2)
 import Day11 qualified (part1, part2)
+import Day12 qualified (part1, part2)
 import Day2 qualified (part1, part2)
 import Day3 qualified (part1, part2)
 import Day4 qualified (part1, part2)
@@ -99,5 +100,11 @@ main =
           "Day 11"
           [ bench "part 1" $ nf Day11.part1 input,
             bench "part 2" $ nf Day11.part2 input
+          ],
+      env (getDayInput 12) $ \input ->
+        bgroup
+          "Day 12"
+          [ bench "part 1" $ nf Day12.part1 input,
+            bench "part 2" $ nf Day12.part2 input
           ]
     ]

hs/src/Day12.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE ViewPatterns #-}
+
+-- |
+-- Module:         Day12
+-- Description:    <https://adventofcode.com/2024/day/12 Day 12: Garden Groups>
+module Day12 (part1, part2) where
+
+import Control.Arrow (first)
+import Control.Monad (ap)
+import Data.Either (partitionEithers)
+import Data.Function (on)
+import Data.List (groupBy)
+import Data.Map qualified as Map (delete, filter, fromDistinctAscList, keys, minViewWithKey, size, (!?))
+import Data.Map.Strict qualified as Map (fromListWith)
+import Data.Semigroup (Arg (Arg))
+import Data.Text (Text)
+import Data.Text qualified as T (lines, unpack)
+
+solve :: ([(Int, Int)] -> Int) -> Text -> Int
+solve perimeter input =
+  go 0 . Map.fromDistinctAscList $
+    [ ((y, x), c)
+    | (y, line) <- zip [0 ..] $ T.lines input,
+      (x, c) <- zip [0 ..] $ T.unpack line
+    ]
+  where
+    go !cost plots@(Map.minViewWithKey -> Just ((pos, c), _)) =
+      let (points, plots') = dfs pos c plots
+       in go (cost + length points * perimeter points) plots'
+    go cost _ = cost
+    dfs pos@(y, x) c plots
+      | plots Map.!? pos /= Just c = ([], plots)
+      | otherwise = (pos : points1 ++ points2 ++ points3 ++ points4, plots4)
+      where
+        plots0 = Map.delete pos plots
+        (points1, plots1) = dfs (y - 1, x) c plots0
+        (points2, plots2) = dfs (y, x - 1) c plots1
+        (points3, plots3) = dfs (y, x + 1) c plots2
+        (points4, plots4) = dfs (y + 1, x) c plots3
+
+part1 :: Text -> Int
+part1 = solve $ \points ->
+  Map.size . Map.filter (== 1) . Map.fromListWith (+) . map (,1 :: Int) $ do
+    (y, x) <- points
+    [Left (y, x), Right (x, y), Right (x + 1, y), Left (y + 1, x)]
+
+part2 :: Text -> Int
+part2 = solve $ \points ->
+  let getArg (Arg (Left a) b) = Left (a, b)
+      getArg (Arg (Right a) b) = Right (a, b)
+      (horizontalEdges, verticalEdges) =
+        partitionEithers . map getArg . Map.keys . Map.filter (== 1) . Map.fromListWith (+) $ do
+          (y, x) <- points
+          (,1 :: Int)
+            <$> [ Arg (Left (y, x)) True,
+                  Arg (Right (x, y)) False,
+                  Arg (Right (x + 1, y)) True,
+                  Arg (Left (y + 1, x)) False
+                ]
+      countConsecutive = succ . length . filter not . (zipWith ok `ap` drop 1)
+      ok (a, b) (c, d) = abs (c - a) <= 1 && b == d
+   in sum
+        [ countConsecutive $ first snd <$> edges
+        | edges <-
+            groupBy ((==) `on` fst . fst) horizontalEdges
+              ++ groupBy ((==) `on` fst . fst) verticalEdges
+        ]

hs/test/Day12Spec.hs

@@ -0,0 +1,70 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Day12Spec (spec) where
+
+import Data.Text (Text)
+import Data.Text qualified as T (unlines)
+import Day12 (part1, part2)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+example1, example2, example3, example4, example5 :: Text
+example1 =
+  T.unlines
+    [ "AAAA",
+      "BBCD",
+      "BBCC",
+      "EEEC"
+    ]
+example2 =
+  T.unlines
+    [ "OOOOO",
+      "OXOXO",
+      "OOOOO",
+      "OXOXO",
+      "OOOOO"
+    ]
+example3 =
+  T.unlines
+    [ "RRRRIICCFF",
+      "RRRRIICCCF",
+      "VVRRRCCFFF",
+      "VVRCCCJFFF",
+      "VVVVCJJCFE",
+      "VVIVCCJJEE",
+      "VVIIICJJEE",
+      "MIIIIIJJEE",
+      "MIIISIJEEE",
+      "MMMISSJEEE"
+    ]
+example4 =
+  T.unlines
+    [ "EEEEE",
+      "EXXXX",
+      "EEEEE",
+      "EXXXX",
+      "EEEEE"
+    ]
+example5 =
+  T.unlines
+    [ "AAAAAA",
+      "AAABBA",
+      "AAABBA",
+      "ABBAAA",
+      "ABBAAA",
+      "AAAAAA"
+    ]
+
+spec :: Spec
+spec = do
+  describe "part 1" $ do
+    it "examples" $ do
+      part1 example1 `shouldBe` 140
+      part1 example2 `shouldBe` 772
+      part1 example3 `shouldBe` 1930
+  describe "part 2" $ do
+    it "examples" $ do
+      part2 example1 `shouldBe` 80
+      part2 example2 `shouldBe` 436
+      part2 example4 `shouldBe` 236
+      part2 example5 `shouldBe` 368
+      part2 example3 `shouldBe` 1206