Day 12 in the worst way possible

advent-of-code-2023.cabal

@@ -92,3 +92,11 @@ executable day11
     build-depends:    base ^>=4.15.1.0, array, Unique
     hs-source-dirs:   day11
     default-language: Haskell2010
+
+executable day12
+    main-is:          Main.hs
+    other-modules:    Commons Part1 Part2
+
+    build-depends:    base ^>=4.15.1.0, MissingH
+    hs-source-dirs:   day12
+    default-language: Haskell2010

day12/Commons.hs

@@ -0,0 +1,110 @@
+module Commons where
+
+import GHC.IO.Handle (isEOF)
+import Data.List.Utils (split)
+
+
+data Spring = Operational | Damaged | Unknown deriving (Eq, Show)
+data Row = Row { springs :: [Spring], groups :: [Int] }
+
+
+parseSprings :: String -> [Spring]
+parseSprings [] = []
+parseSprings ('.': t) = Operational: parseSprings t
+parseSprings ('#': t) = Damaged: parseSprings t
+parseSprings ('?': t) = Unknown: parseSprings t
+
+parse :: IO [Row]
+parse = do done <- isEOF
+           if done
+              then return []
+              else do line <- getLine
+                      let rawSprings: rawGroups: _ = split " " line
+                          springs = parseSprings rawSprings
+                          groups = map read $ split "," rawGroups
+                      otherRows <- parse
+                      return $ Row {springs = springs, groups = groups}: otherRows
+
+
+isPossiblyDamaged :: [Spring] -> Bool
+isPossiblyDamaged [] = True
+isPossiblyDamaged (Operational: t) = False
+isPossiblyDamaged (_: t) = isPossiblyDamaged t
+
+getNPossibleArrangements :: [Int] -> [Spring] -> Int
+getNPossibleArrangements [] (Damaged: t) = 0
+getNPossibleArrangements [] (_: t) = getNPossibleArrangements [] t
+getNPossibleArrangements (1: h: t) (Unknown: Unknown: Unknown: Unknown: Damaged: tsprings)
+  | h == 1 = 3 * getNPossibleArrangements (h: t) (Damaged: tsprings)
+             + getNPossibleArrangements t (Damaged: tsprings)
+             + getNPossibleArrangements (1: h: t) (Damaged: tsprings)
+  | h == 2 = 2 * getNPossibleArrangements (h: t) (Unknown: Damaged: tsprings)
+             + getNPossibleArrangements (h: t) (Damaged: tsprings)
+             + getNPossibleArrangements (1: h: t) (Damaged: tsprings)
+  | h > 2  = getNPossibleArrangements (h: t) (Damaged: tsprings)
+             + getNPossibleArrangements (h: t) (Unknown: Damaged: tsprings)
+             + getNPossibleArrangements (h: t) (Unknown: Unknown: Damaged: tsprings)
+             + getNPossibleArrangements (1: h: t) (Damaged: tsprings)
+getNPossibleArrangements (1: h: t) (Unknown: Unknown: Unknown: Damaged: tsprings)
+  | h == 1 = 2 * getNPossibleArrangements (h: t) (Damaged: tsprings)
+             + getNPossibleArrangements (1: h: t) (Damaged: tsprings)
+  | h > 1  = getNPossibleArrangements (h: t) (Damaged: tsprings)
+             + getNPossibleArrangements (h: t) (Unknown: Damaged: tsprings)
+             + getNPossibleArrangements (1: h: t) (Damaged: tsprings)
+getNPossibleArrangements (1: t) (Unknown: Unknown: Damaged: tsprings)
+  = getNPossibleArrangements t (Damaged: tsprings)
+    + getNPossibleArrangements (1: t) (Damaged: tsprings)
+getNPossibleArrangements (1: h: t) (Unknown: Unknown: Unknown: Unknown: Operational: tsprings)
+  | h == 1 = 4 * getNPossibleArrangements (h: t) tsprings + 3 * getNPossibleArrangements t tsprings
+             + getNPossibleArrangements (1: h: t) tsprings
+  | h == 2 = 4 * getNPossibleArrangements (h: t) tsprings + getNPossibleArrangements t tsprings
+             + getNPossibleArrangements (1: h: t) tsprings
+  | h > 2  = 4 * getNPossibleArrangements (h: t) tsprings + getNPossibleArrangements (1: h: t) tsprings
+getNPossibleArrangements (1: h: t) (Unknown: Unknown: Unknown: Operational: tsprings)
+  | h == 1 = 3 * getNPossibleArrangements (h: t) tsprings + getNPossibleArrangements t tsprings
+             + getNPossibleArrangements (1: h: t) tsprings
+  | h > 1  = 3 * getNPossibleArrangements (h: t) tsprings + getNPossibleArrangements (1: h: t) tsprings
+getNPossibleArrangements (1: t) (Unknown: Unknown: Operational: tsprings)
+  = (2 * getNPossibleArrangements t tsprings) + getNPossibleArrangements (1: t) tsprings
+getNPossibleArrangements (2: t) (Unknown: Unknown: Unknown: Operational: tsprings)
+  = (2 * getNPossibleArrangements t tsprings) + getNPossibleArrangements (2: t) tsprings
+getNPossibleArrangements (1: 1: 1: t) (Unknown: Unknown: Unknown: Unknown: Unknown: Unknown: tsprings)
+  = getNPossibleArrangements t tsprings
+    + 3 * getNPossibleArrangements (1: t) (Unknown: tsprings)
+    + 3 * getNPossibleArrangements (1: t) tsprings
+    + 4 * getNPossibleArrangements (1: 1: t) (Unknown: tsprings)
+    + getNPossibleArrangements (1: 1: t) tsprings
+    + getNPossibleArrangements (1: 1: 1: t) (Unknown: tsprings)
+getNPossibleArrangements (1: 1: t) (Unknown: Unknown: Unknown: Unknown: Unknown: tsprings)
+  = 2 * getNPossibleArrangements t tsprings
+    + getNPossibleArrangements t (Unknown: tsprings)
+    + getNPossibleArrangements (1: t) tsprings
+    + 3 * getNPossibleArrangements (1: t) (Unknown: tsprings)
+    + getNPossibleArrangements (1: 1: t) (Unknown: tsprings)
+getNPossibleArrangements (1: 1: t) (Unknown: Unknown: Unknown: Unknown: tsprings)
+  = getNPossibleArrangements t tsprings
+    + 2 * getNPossibleArrangements (1: t) (Unknown: tsprings)
+    + getNPossibleArrangements (1: t) tsprings
+    + getNPossibleArrangements (1: 1: t) (Unknown: tsprings)
+getNPossibleArrangements (1: t) (Unknown: Unknown: Unknown: tsprings)
+  = getNPossibleArrangements t (Unknown: tsprings)
+    + getNPossibleArrangements t tsprings
+    + getNPossibleArrangements (1: t) (Unknown: tsprings)
+getNPossibleArrangements (h: t) (hsprings: tsprings)
+  | hsprings == Operational = getNPossibleArrangements (h: t) tsprings
+  | hsprings == Unknown     = getNPossibleArrangements (h: t) (Operational: tsprings)
+                              + getNPossibleArrangements (h: t) (Damaged: tsprings)
+  | hsprings == Damaged     = let (hs, ts) = splitAt (h - 1) tsprings
+                                  nGroups = length t + sum t - 1
+                              in if length hs == h - 1 && isPossiblyDamaged hs && length ts >= nGroups
+                                    then case (ts, t) of
+                                              ([], _) -> getNPossibleArrangements t []
+                                              (Unknown: Unknown: Operational: tts, hh: _)
+                                                -> if hh > 1 then getNPossibleArrangements t tts
+                                                             else getNPossibleArrangements t (tail ts)
+                                              (Unknown: tts, _) -> getNPossibleArrangements t tts
+                                              (Operational: tts, _) -> getNPossibleArrangements t tts
+                                              (Damaged: _, _) -> 0
+                                    else 0
+getNPossibleArrangements [] [] = 1
+getNPossibleArrangements _ [] = 0

day12/Main.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import Commons
+import qualified Part1
+import qualified Part2
+
+
+main = do rows <- parse
+          let part1Res = sum $ Part1.getAll rows
+          print part1Res
+          let part2Res = sum $ Part2.getAll rows
+          print part2Res

day12/Part1.hs

@@ -0,0 +1,7 @@
+module Part1 where
+
+import Commons
+
+
+getAll :: [Row] -> [Int]
+getAll = map (\ row -> getNPossibleArrangements (groups row) (springs row))

day12/Part2.hs

@@ -0,0 +1,14 @@
+module Part2 where
+
+import Commons
+
+
+combineSprings :: [Spring] -> [Spring]
+combineSprings springs = springs ++ (Unknown: springs) ++ (Unknown: springs) ++ (Unknown: springs)
+                                 ++ (Unknown: springs)
+
+combineGroups :: [Int] -> [Int]
+combineGroups groups = groups ++ groups ++ groups ++ groups ++ groups
+
+getAll :: [Row] -> [Int]
+getAll = map (\ row -> getNPossibleArrangements (combineGroups (groups row)) (combineSprings (springs row)))