Haskell
Phew! I struggled with this one. A lot of the code here is from my original approach, which cuts down the search space to plausible positions for each group. Unfortunately, that was still way too slow...
It took an embarrassingly long time to try memoizing the search (which made precomputing valid points far less important). Anyway, here it is!
Solution
{-# LANGUAGE LambdaCase #-}
import Control.Monad
import Control.Monad.State
import Data.List
import Data.List.Split
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
readInput :: String -> ([Maybe Bool], [Int])
readInput s =
let [a, b] = words s
in ( map (\case '#' -> Just True; '.' -> Just False; '?' -> Nothing) a,
map read $ splitOn "," b
)
arrangements :: ([Maybe Bool], [Int]) -> Int
arrangements (pat, gs) = evalState (searchMemo 0 groups) Map.empty
where
len = length pat
groups = zipWith startPoints gs $ zip minStarts maxStarts
where
minStarts = scanl (\a g -> a + g + 1) 0 $ init gs
maxStarts = map (len -) $ scanr1 (\g a -> a + g + 1) gs
startPoints g (a, b) =
let ps = do
(i, pat') <- zip [a .. b] $ tails $ drop a pat
guard $
all (\(p, x) -> maybe True (== x) p) $
zip pat' $
replicate g True ++ [False]
return i
in (g, ps)
clearableFrom i =
fmap snd $
listToMaybe $
takeWhile ((<= i) . fst) $
dropWhile ((< i) . snd) clearableRegions
where
clearableRegions =
let go i [] = []
go i pat =
let (a, a') = span (/= Just True) pat
(b, c) = span (== Just True) a'
in (i, i + length a - 1) : go (i + length a + length b) c
in go 0 pat
searchMemo :: Int -> [(Int, [Int])] -> State (Map (Int, Int) Int) Int
searchMemo i gs = do
let k = (i, length gs)
cached <- gets (Map.!? k)
case cached of
Just x -> return x
Nothing -> do
x <- search i gs
modify (Map.insert k x)
return x
search i gs | i >= len = return $ if null gs then 1 else 0
search i [] = return $
case clearableFrom i of
Just b | b == len - 1 -> 1
_ -> 0
search i ((g, ps) : gs) = do
let maxP = maybe i (1 +) $ clearableFrom i
ps' = takeWhile (<= maxP) $ dropWhile (< i) ps
sum <$> mapM (\p -> let i' = p + g + 1 in searchMemo i' gs) ps'
expand (pat, gs) =
(intercalate [Nothing] $ replicate 5 pat, concat $ replicate 5 gs)
main = do
input <- map readInput . lines <$> readFile "input12"
print $ sum $ map arrangements input
print $ sum $ map (arrangements . expand) input