Gattix/AoC
3
0
Fork 0
Code Issues 1 Pull Requests Releases Wiki Activity

day12, simple recursive solution 

now to memoize it…
This commit is contained in:
Gattix 2023-12-25 18:10:50 +01:00
parent 5b31f9effb
commit 1a5e8a6e62
1 changed files with 13 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
2023/day12/day12.hs
View File

@ -1,5 +1,4 @@
import Control.Arrow import Control.Arrow
import Control.Monad
import Data.List import Data.List
main :: IO () main :: IO ()
@ -9,32 +8,20 @@ parse :: String -> (String, [Int])
parse = second (read . ('[' :) . (++ "]") . tail) . break (== ' ') parse = second (read . ('[' :) . (++ "]") . tail) . break (== ' ')
day12 :: [(String, [Int])] -> Int day12 :: [(String, [Int])] -> Int
day12 = sum . map (length . genArrangements) day12 = sum . map (uncurry (countArr 0))
part2ify :: (String, [Int]) -> (String, [Int]) part2ify :: (String, [Int]) -> (String, [Int])
part2ify (s, xs) = (intercalate "?" $ replicate 5 s, concat $ replicate 5 xs) part2ify (s, xs) = (intercalate "?" $ replicate 5 s, concat $ replicate 5 xs)
genMin :: [Int] -> [String] countArr :: Int -> String -> [Int] -> Int
genMin = foldr (\x -> (:) (replicate x '#' ++ ".")) [] countArr 0 [] [] = 1
countArr _ [] [] = 0
genDots :: Int -> Int -> [[Int]] countArr _ ss [] = fromEnum $ not $ any (=='#') ss
genDots n x = filter (\xs -> sum xs == x) $ replicateM n [0 .. x] countArr streak [] [i] = fromEnum $ streak==i
countArr streak (s:ss) (i:is)
buildMaxeds :: [String] -> [[Int]] -> [String] | s=='.' && streak == 0 = countArr 0 ss (i:is)
buildMaxeds ss = map (build ss) | s=='.' && streak == i = countArr 0 ss is
| s=='.' = 0
build :: [String] -> [Int] -> String | s=='#' = countArr (succ streak) ss (i:is)
build [] [x] = replicate x '.' | s=='?' = countArr streak ('.':ss) (i:is) + countArr streak ('#':ss) (i:is)
build (s:ss) (x:xs) = replicate x '.' ++ s ++ build ss xs countArr _ _ _ = 0
genArrangements :: (String, [Int]) -> [String]
genArrangements (s, xs) = filter f $ buildMaxeds (genMin xs) (genDots w l)
where
f x = and (zipWith wEq s x)
w = succ $ length xs
l = length s - sum xs - pred (length xs)
wEq :: Char -> Char -> Bool
wEq _ '?' = True
wEq '?' _ = True
wEq c1 c2 = c1 == c2