diff --git a/README.md b/README.md index c13d08a..6084960 100644 --- a/README.md +++ b/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)|||| diff --git a/hs/aoc2024.cabal b/hs/aoc2024.cabal index 623493a..f30206f 100644 --- a/hs/aoc2024.cabal +++ b/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 diff --git a/hs/app/Main.hs b/hs/app/Main.hs index cc49f4f..70bf641 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 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] diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs index aa8385a..c08dc77 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 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 ] ] diff --git a/hs/src/Day12.hs b/hs/src/Day12.hs new file mode 100644 index 0000000..a31d49d --- /dev/null +++ b/hs/src/Day12.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module: Day12 +-- Description: +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 + ] diff --git a/hs/test/Day12Spec.hs b/hs/test/Day12Spec.hs new file mode 100644 index 0000000..36658ba --- /dev/null +++ b/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