Day 19 - Linen Layout
Megathread guidelines
- Keep top level comments as only solutions, if you want to say something other than a solution put it in a new post. (replies to comments can be whatever)
- You can send code in code blocks by using three backticks, the code, and then three backticks or use something such as https://topaz.github.io/paste/ if you prefer sending it through a URL
FAQ
- What is this?: Here is a post with a large amount of details: https://programming.dev/post/6637268
- Where do I participate?: https://adventofcode.com/
- Is there a leaderboard for the community?: We have a programming.dev leaderboard with the info on how to join in this post: https://programming.dev/post/6631465
You are viewing a single thread.
View all comments 2 points
Haskell
Runs in 115 ms. Today’s pretty straight forward. Memoization feels like magic sometimes!
Code
import Control.Monad.Memo
import Data.List
splitX :: Eq a => [a] -> [a] -> [[a]]
splitX xs = go
where
go [] = [[]]
go ys@(y : ys') = case stripPrefix xs ys of
Just ys'' -> [] : go ys''
Nothing -> let (zs : zss) = go ys' in (y : zs) : zss
parse :: String -> ([String], [String])
parse s =
let (patterns : _ : designs) = lines s
in (splitX ", " patterns, takeWhile (not . null) designs)
countPatterns :: (Eq a, Ord a) => [[a]] -> [a] -> Memo [a] Int Int
countPatterns yss = go
where
go [] = return 1
go xs = sum <$> sequence
[memo go xs' | Just xs' <- map (\ys -> stripPrefix ys xs) yss]
main :: IO ()
main = do
(patterns, designs) <- parse <$> getContents
let ns = startEvalMemo $ mapM (countPatterns patterns) designs
print $ length $ filter (> 0) ns
print $ sum ns
