From 47e91bb70e648a3a2248c3a54ff5a30430581f4d Mon Sep 17 00:00:00 2001 From: Daniel Lin Date: Tue, 12 Dec 2023 06:35:59 -0500 Subject: [PATCH] Day 12: Hot Springs --- README.md | 1 + hs/aoc2023.cabal | 3 +- hs/app/Main.hs | 2 + hs/bench/Main.hs | 13 ++++-- hs/src/Day12.hs | 94 ++++++++++++++++++++++++++++++++++++++++++++ hs/test/Day12Spec.hs | 26 ++++++++++++ 6 files changed, 134 insertions(+), 5 deletions(-) create mode 100644 hs/src/Day12.hs create mode 100644 hs/test/Day12Spec.hs diff --git a/README.md b/README.md index e86d6a65..36efc9b2 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/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day9.kt)|[day9.py](py/aoc2023/day9.py)|[day9.rs](rs/src/day9.rs)| |[Day10.hs](hs/src/Day10.hs)|[Day10.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day10.kt)|[day10.py](py/aoc2023/day10.py)|[day10.rs](rs/src/day10.rs)| |[Day11.hs](hs/src/Day11.hs)|[Day11.kt](kt/aoc2023-lib/src/commonMain/kotlin/com/github/ephemient/aoc2023/Day11.kt)|[day11.py](py/aoc2023/day11.py)|[day11.rs](rs/src/day11.rs)| +|[Day12.hs](hs/src/Day12.hs)|||| diff --git a/hs/aoc2023.cabal b/hs/aoc2023.cabal index 7d388f18..b4211f13 100644 --- a/hs/aoc2023.cabal +++ b/hs/aoc2023.cabal @@ -31,7 +31,8 @@ library Day8, Day9, Day10, - Day11 + Day11, + Day12 -- Modules included in this library but not exported. other-modules: diff --git a/hs/app/Main.hs b/hs/app/Main.hs index 616229e6..ef43c811 100644 --- a/hs/app/Main.hs +++ b/hs/app/Main.hs @@ -12,6 +12,7 @@ import qualified Day8 (part1, part2) import qualified Day9 (part1, part2) import qualified Day10 (solve) import qualified Day11 (solve) +import qualified Day12 (part1, part2) import Control.Monad (ap, when) import Data.Foldable (find) @@ -53,3 +54,4 @@ main = do run 9 (either fail print) [Day9.part1, Day9.part2] run 10 (maybe (fail "error") $ uncurry ((>>) `on` print)) [Day10.solve] run 11 print [Day11.solve 2, Day11.solve 1000000] + run 12 print [Day12.part1, Day12.part2] diff --git a/hs/bench/Main.hs b/hs/bench/Main.hs index 7d2d36fd..3d7e8ff2 100644 --- a/hs/bench/Main.hs +++ b/hs/bench/Main.hs @@ -17,6 +17,7 @@ import qualified Day8 (part1, part2) import qualified Day9 (part1, part2) import qualified Day10 (solve) import qualified Day11 (solve) +import qualified Day12 (part1, part2) import System.Environment.Blank (getEnv, setEnv, unsetEnv) import System.FilePath (combine) @@ -69,13 +70,17 @@ main = defaultMain [ bench "part 1" $ nf Day9.part1 input , bench "part 2" $ nf Day9.part2 input ] - , envWithCleanup ((,) <$> getDayInput 10 <*> setTrace "0") - (unsetTrace . snd) $ fst >>> \input -> bgroup "Day 10" - [ bench "part 1" $ nf (fmap fst . Day10.solve) input - , bench "part 2" $ nf (fmap snd . Day10.solve) input + , env (getDayInput 10) $ \input -> bgroup "Day 10" + [ bench "part 1" $ nf (fmap fst . Day10.solve) input + , bench "part 2" $ nf (fmap snd . Day10.solve) input ] , env (getDayInput 11) $ \input -> bgroup "Day 11" [ bench "part 1" $ nf (Day11.solve 2) input , bench "part 2" $ nf (Day11.solve 1000000) input ] + , envWithCleanup ((,) <$> getDayInput 12 <*> setTrace "0") + (unsetTrace . snd) $ fst >>> \input -> bgroup "Day 10" + [ 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 00000000..38472168 --- /dev/null +++ b/hs/src/Day12.hs @@ -0,0 +1,94 @@ +{-| +Module: Day12 +Description: +-} +{-# LANGUAGE OverloadedStrings, TransformListComp, ViewPatterns #-} +module Day12 (part1, part2) where + +import Common (readEntire) +import Data.List (foldl', maximumBy, inits, tails, scanl') +import Data.Ord (comparing) +import Data.Text (Text) +import qualified Data.Text as T (all, any, breakOn, count, drop, dropAround, dropEnd, dropWhile, dropWhileEnd, head, index, intercalate, length, lines, null, split, splitOn, tail, take, unlines, unpack) +import qualified Data.Text.Read as T (decimal) +import Debug.Trace (trace) + +example :: Text +example = T.unlines + [ "???.### 1,1,3" + , ".??..??...?##. 1,1,3" + , "?#?#?#?#?#?#?#? 1,3,1,6" + , "????.#...#... 4,1,1" + , "????.######..#####. 1,6,5" + , "?###???????? 3,2,1" + ] + +choose :: Int -> Int -> Int +n `choose` r = foldl' f 1 $ zip [1..r] [n, n - 1..] where + f k (a, b) | (q, 0) <- (k * b) `divMod` a = q +infix 1 `choose` + +solutions :: Text -> [Int] -> Int +solutions (T.dropAround (== '.') -> s) xs + | T.count "#" s > m || + m > T.length s - T.count "." s || + m + length xs - 1 > T.length s + = 0 + | T.null s || null xs = 1 + | (leftS, rightS) <- T.breakOn "." s, not $ T.null rightS = sum + [ left * solutions rightS rightXs + | (leftXs, rightXs, acc) <- zip3 (inits xs) (tails xs) $ scanl' ((+) . succ) (-1) xs + , then takeWhile by acc <= T.length leftS + , let left = solutions leftS leftXs + , left /= 0 + ] + | T.all (/= '#') s = T.length s - m + 1 `choose` length xs + | T.length maxRun > maximum xs = 0 + | not $ T.null maxRun, (leftS, rightS) <- T.breakOn maxRun s = sum + [ left * solutions (T.drop (x' - dx + 1) rightS) rightXs + | (leftXs, x' : rightXs, acc) <- zip3 (inits xs) (tails xs) $ scanl' ((+) . succ) 0 xs + , dx <- [max 0 $ x' - T.length rightS..x' - T.length maxRun] + , then takeWhile by acc + dx <= T.length leftS + , dx + 1 > T.length leftS || leftS `T.index` (T.length leftS - dx - 1) /= '#' + , x' - dx >= T.length rightS || rightS `T.index` (x' - dx) /= '#' + , let left = solutions (T.dropEnd (dx + 1) leftS) leftXs + , left /= 0 + ] + | otherwise = + (if x < T.length s && s `T.index` x == '#' then 0 else solutions (T.drop (x + 1) s) xs') + + (if T.head s == '#' then 0 else solutions (T.tail s) xs) + where + m = sum xs + x:xs' = xs + maxRun = maximumBy (comparing T.length) $ T.split (/= '#') s + +solutions' = solutions'' . T.dropWhile (== '.') where + solutions'' s xs + | T.count "#" s > m || T.length s' < n = 0 + | T.all (== '?') s' + = T.length s' - m + 1 `choose` length xs + where + s' = T.dropWhileEnd (== '.') s + m = sum xs + n = m + length xs - 1 + solutions'' _ [] = 1 + solutions'' s xs@(x:xs') = + (if T.any (== '.') (T.take x s) || s `T.index` x == '#' then 0 else solutions' (T.drop (x + 1) s) xs') + + (if T.head s == '#' then 0 else solutions' (T.tail s) xs) + +part1 :: Text -> Int +part1 = sum . map part1' . T.lines where + part1' line + | [lhs, rhs] <- T.splitOn " " line + , Right nums <- mapM (readEntire T.decimal) $ T.splitOn "," rhs + = solutions lhs nums + | otherwise = 0 + +part2 :: Text -> Int +part2 = sum . map part2' . T.lines where + part2' line + | [lhs, rhs] <- T.splitOn " " line + , Right nums <- mapM (readEntire T.decimal) $ T.splitOn "," rhs + = ((++ ('\t' : T.unpack line)) . show >>= trace) . + solutions (T.intercalate "?" $ replicate 5 lhs) . concat $ replicate 5 nums + | otherwise = 0 diff --git a/hs/test/Day12Spec.hs b/hs/test/Day12Spec.hs new file mode 100644 index 00000000..c477cefc --- /dev/null +++ b/hs/test/Day12Spec.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE OverloadedStrings #-} +module Day12Spec (spec) where + +import Data.Text (Text) +import qualified Data.Text as T (unlines) +import Day12 (part1, part2) +import Test.Hspec (Spec, describe, it, shouldBe) + +example :: Text +example = T.unlines + [ "???.### 1,1,3" + , ".??..??...?##. 1,1,3" + , "?#?#?#?#?#?#?#? 1,3,1,6" + , "????.#...#... 4,1,1" + , "????.######..#####. 1,6,5" + , "?###???????? 3,2,1" + ] + +spec :: Spec +spec = do + describe "part 1" $ do + it "examples" $ do + part1 example `shouldBe` 21 + describe "part 2" $ do + it "examples" $ do + part2 example `shouldBe` 525152