haskell: 2023 12 a

2023/haskell/aoc2023.cabal

@@ -29,6 +29,7 @@ library
     Day09
     Day10
     Day11
+    Day12
     Day15
 
   other-modules:

2023/haskell/app/Main.hs

@@ -12,7 +12,8 @@ import Utils (readInput)
 --import qualified Day08
 --import qualified Day09
 --import qualified Day10
-import qualified Day11
+--import qualified Day11
+import qualified Day12
 --import qualified Day15
 
 
@@ -43,5 +44,6 @@ main = do
   --run 08 Day08.parse Day08.solveA Day08.solveB
   --run 09 Day09.parse Day09.solveA Day09.solveB
   --run 10 Day10.parse Day10.solveA Day10.solveB
-  run 11 Day11.parse Day11.solveA Day11.solveB
+  --run 11 Day11.parse Day11.solveA Day11.solveB
+  run 12 Day12.parse Day12.solveA Day12.solveB
   --run 15 Day15.parse Day15.solveA Day15.solveB

2023/haskell/solutions/Day12.hs

@@ -13,7 +13,7 @@ data Cell
   = U -- ? unknown
   | O -- . operational
   | D -- # damaged
-  deriving Show
+  deriving (Show, Eq)
 
 type Row = ([Cell], [Int])
 
@@ -43,11 +43,34 @@ parse = first errorBundlePretty . runParser rows ""
     rows = many row <* eof
 
 arrange :: [Cell] -> [Int] -> [[Cell]]
-arrange = _
+arrange [] [] = [[]]
+arrange [] _  = []
+arrange cs []
+  | D `notElem` cs = [map (const O) cs]
+  | otherwise      = []
+arrange cs@(c:cr) ns@(n:nr)
+  | canFill && canSkip = tryFill <> trySkip
+  | canFill            = tryFill
+  | canSkip            = trySkip
+  | otherwise          = []
+  where
+    (window, rest) = splitAt n cs
+    fill :: [Cell] -> [Cell]
+    fill = (replicate n D ++)
+    canSkip :: Bool
+    canSkip = c /= D
+    trySkip :: [[Cell]]
+    trySkip = map (O:) (arrange cr ns)
+    canFill :: Bool
+    canFill = O `notElem` window && n == length window && (null rest || head rest /= D)
+    tryFill :: [[Cell]]
+    tryFill
+      | null rest = map fill (arrange rest nr)
+      | otherwise = map (fill . (O:)) (arrange (tail rest) nr)
 
 solveA :: [Row] -> Int
 solveA = length . concatMap (uncurry arrange)
 
--- >>> parse input
--- Right [([U,U,U,O,D,D,D],[1,1,3]),([O,U,U,O,O,U,U,O,O,O,U,D,D,O],[1,1,3]),([U,D,U,D,U,D,U,D,U,D,U,D,U,D,U],[1,3,1,6]),([U,U,U,U,O,D,O,O,O,D,O,O,O],[4,1,1]),([U,U,U,U,O,D,D,D,D,D,D,O,O,D,D,D,D,D,O],[1,6,5]),([U,D,D,D,U,U,U,U,U,U,U,U],[3,2,1])]
+-- >>> solveA <$> parse input
+-- Right 21
 

2023/haskell/tests/Main.hs

@@ -14,6 +14,7 @@ import qualified Day08
 import qualified Day09
 import qualified Day10
 import qualified Day11
+import qualified Day12
 import qualified Day15
 
 
@@ -297,6 +298,21 @@ day11 =
       \.......#..\n\
       \#...#.....\n"
 
+day12 :: Test
+day12 =
+  let parsed = Day12.parse input
+  in TestList
+    [ TestCase $ assertEqual "A" (Right 21) (Day12.solveA <$> parsed)
+    ]
+  where
+    input =
+      "???.### 1,1,3\n\
+      \.??..??...?##. 1,1,3\n\
+      \?#?#?#?#?#?#?#? 1,3,1,6\n\
+      \????.#...#... 4,1,1\n\
+      \????.######..#####. 1,6,5\n\
+      \?###???????? 3,2,1\n"
+
 day15 :: Test
 day15 =
   let parsed = Day15.parse input
@@ -320,6 +336,7 @@ tests = TestList
   , TestLabel "09" day09
   , TestLabel "10" day10
   , TestLabel "11" day11
+  , TestLabel "12" day12
   , TestLabel "15" day15
   ]