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 3 points
Haskell
solution
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Arrow
import Control.Monad.State
import Data.Char
import Data.List
import Data.Map qualified as M
import Data.Monoid
import Text.ParserCombinators.ReadP
parse = fst . last . readP_to_S ((,) <$> (patterns <* eol <* eol) <*> designs)
where
eol = char '\n'
patterns = sepBy word (string ", ")
designs = endBy word eol
word = munch1 isLetter
part1 patterns = length . filter (valid patterns)
part2 patterns = getSum . combinations patterns
dropPrefix = drop . length
valid :: [String] -> String -> Bool
valid patterns design = go design
where
go "" = True
go design = case filter (`isPrefixOf` design) patterns of
[] -> False
l -> any (go . (`dropPrefix` design)) l
combinations :: [String] -> [String] -> Sum Int
combinations patterns designs = evalState (fmap mconcat . mapM go $ designs) mempty
where
go "" = return $ Sum 1
go design =
gets (M.lookup design) >>= \case
Just c -> return c
Nothing -> case filter (`isPrefixOf` design) patterns of
[] -> return $ Sum 0
l -> do
res <- mconcat <$> mapM (go . (`dropPrefix` design)) l
modify (M.insert design res)
return res
main = getContents >>= print . (uncurry part1 &&& uncurry part2) . parse
