From: Neil Smith Date: Thu, 19 Dec 2024 14:37:28 +0000 (+0000) Subject: Done day 19 X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=38a479c0c875eafcc6fddd34a3eca66ff1f424f9;p=advent-of-code-24.git Done day 19 --- diff --git a/advent19/Main.hs b/advent19/Main.hs new file mode 100644 index 0000000..d46851d --- /dev/null +++ b/advent19/Main.hs @@ -0,0 +1,76 @@ +-- Writeup at https://work.njae.me.uk/2024/12/19/advent-of-code-2024-day-19/ + +-- import Debug.Trace + +import AoC +import Data.List +-- import Data.Char +-- import Data.Maybe +import Data.Text (Text) +import qualified Data.Text.IO as TIO +import Data.Attoparsec.Text hiding (take) +-- import Control.Applicative +-- import Data.Either +-- import qualified Data.Set as S +import qualified Data.MultiSet as MS + + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- TIO.readFile dataFileName + -- print text + let (towels, designs) = successfulParse text + -- let possibleDesigns = filter (isPossibleDesign towels) designs + let countedDesigns = fmap (countDesigns towels) designs + print $ part1 countedDesigns + print $ part2 countedDesigns + +-- part1 _towels designs = length designs +-- part2 towels designs = sum $ fmap (countDesigns towels) designs +part1, part2 :: [Int] -> Int +part1 = length . filter (> 0) +part2 = sum + +-- isPossibleDesign :: [String] -> String -> Bool +-- isPossibleDesign towels design = design `S.member` (buildDesign towels design) + +-- buildDesign :: [String] -> String -> S.Set String +-- buildDesign towels design = foldl' (addTowel towels) (S.singleton "") $ inits design + +-- addTowel :: [String] -> S.Set String -> String -> S.Set String +-- addTowel towels acc design +-- | any (\p -> p `S.member` acc) prefixes = S.insert design acc +-- | otherwise = acc +-- where allPS = zip (inits design) (tails design) +-- prefixes = [p | (p, s) <- allPS, s `elem` towels] + +countDesigns :: [String] -> String -> Int +countDesigns towels design = MS.occur design $ buildDesignCount towels design + +buildDesignCount :: [String] -> String -> MS.MultiSet String +buildDesignCount towels design = foldl' (addTowelCount towels) (MS.singleton "") $ inits design + +addTowelCount :: [String] -> MS.MultiSet String -> String -> MS.MultiSet String +addTowelCount towels acc design = MS.insertMany design prefixWays acc + where allPS = zip (inits design) (tails design) + prefixWays = sum [ p `MS.occur` acc + | (p, s) <- allPS + , s `elem` towels ] + +-- parse the input file + +readAllP :: Parser ([String], [String]) +readTowelP :: Parser [String] +readDesignP :: Parser [String] + +readAllP = (,) <$> readTowelP <* endOfLine <* endOfLine <*> readDesignP + +readTowelP = (many1 letter) `sepBy` (string ", ") +readDesignP = (many1 letter) `sepBy` endOfLine + +successfulParse :: Text -> ([String], [String]) +successfulParse input = + case parseOnly readAllP input of + Left _err -> ([], []) -- TIO.putStr $ T.pack $ parseErrorPretty err + Right bytes -> bytes diff --git a/advent19/MainA.hs b/advent19/MainA.hs new file mode 100644 index 0000000..caf6849 --- /dev/null +++ b/advent19/MainA.hs @@ -0,0 +1,68 @@ +-- Writeup at https://work.njae.me.uk/2024/12/19/advent-of-code-2024-day-19/ + +-- import Debug.Trace + +import AoC +import Data.List +import Data.Char +import Data.Maybe +import Data.Text (Text, pack) +import qualified Data.Text.IO as TIO +import Data.Attoparsec.Text hiding (take) +import Control.Applicative +import Data.Either +-- import Text.ParserCombinators.ReadP + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- TIO.readFile dataFileName + -- print text + let (towels, designs) = successfulParse text + print towels + print designs + print $ length $ rights $ fmap (buildPattern towels) designs + -- let memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds) + -- let memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds) + -- print memory + -- print $ part1 bytes + -- putStrLn $ part2 bytes + +-- part1 :: [Position] -> Int +-- part1 bytes = fst $ fromJust path +-- where path = aStar (neighbours memory) +-- (transitionCost) +-- (estimateCost memory) +-- (isGoal memory) +-- (initial memory) +-- -- memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds) +-- memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds) + + +-- buildPattern :: [String] -> String -> [String] +buildPattern towels design = parseOnly ((designP towelsT) <* endOfInput) (pack design) + where towelsT = fmap pack (reverse $ sortOn length towels) + +designP :: [Text] -> Parser [Text] +designP towels = many1 (towelChoiceP towels) + +towelChoiceP :: [Text] -> Parser Text +towelChoiceP towels = (try . choice) $ ( string <$> towels ) + + +-- parse the input file + +readAllP :: Parser ([String], [String]) +readTowelP :: Parser [String] +readDesignP :: Parser [String] + +readAllP = (,) <$> readTowelP <* endOfLine <* endOfLine <*> readDesignP + +readTowelP = (many1 letter) `sepBy` (string ", ") +readDesignP = (many1 letter) `sepBy` endOfLine + +successfulParse :: Text -> ([String], [String]) +successfulParse input = + case parseOnly readAllP input of + Left _err -> ([], []) -- TIO.putStr $ T.pack $ parseErrorPretty err + Right bytes -> bytes diff --git a/advent19/MainP.hs b/advent19/MainP.hs new file mode 100644 index 0000000..014c5d5 --- /dev/null +++ b/advent19/MainP.hs @@ -0,0 +1,78 @@ +-- Writeup at https://work.njae.me.uk/2024/12/19/advent-of-code-2024-day-19/ + +-- import Debug.Trace + +import AoC +import Data.List +import Data.Char +import Data.Maybe +-- import Data.Text (Text, pack) +-- import qualified Data.Text.IO as TIO +-- import Data.Attoparsec.Text hiding (take) +-- import Control.Applicative +import Data.Either +import Text.ParserCombinators.ReadP + +main :: IO () +main = + do dataFileName <- getDataFileName + text <- readFile dataFileName + -- print text + let (towels, designs) = parseInput text + print towels + print designs + print $ length $ catMaybes $ fmap (buildPattern towels) designs + -- let memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds) + -- let memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds) + -- print memory + -- print $ part1 bytes + -- putStrLn $ part2 bytes + +-- part1 :: [Position] -> Int +-- part1 bytes = fst $ fromJust path +-- where path = aStar (neighbours memory) +-- (transitionCost) +-- (estimateCost memory) +-- (isGoal memory) +-- (initial memory) +-- -- memory = Memory (S.fromList $ take 12 bytes) (fst memoryBounds) (snd memoryBounds) +-- memory = Memory (S.fromList $ take 1024 bytes) (fst memoryBounds) (snd memoryBounds) + + +-- buildPattern :: [String] -> String -> [String] +buildPattern towels design = tryParse (designP towels) design + +designP :: [String] -> ReadP [String] +designP towels = many1 (towelChoiceP towels) + +towelChoiceP :: [String] -> ReadP String +towelChoiceP towels = choice $ ( string <$> towels ) + + +-- parse the input file + +readAllP :: ReadP ([String], [String]) +readTowelP :: ReadP [String] +readDesignP :: ReadP [String] + +readAllP = (,) <$> readTowelP <* endOfLine <* endOfLine <*> readDesignP + +readTowelP = (many1 letter) `sepBy` (string ", ") +readDesignP = (many1 letter) `sepBy` endOfLine + +letter = satisfy isLetter +endOfLine = char '\n' + +parseInput :: String -> ([String], [String]) +parseInput input = + case res of + Nothing -> ([], []) + Just res -> res + where res = tryParse readAllP input + +tryParse :: (ReadP a) -> String -> Maybe a +tryParse parser input + | null successes = Nothing + | otherwise = Just $ fst $ head successes + where parseResult = readP_to_S parser input + successes = filter (null . snd) parseResult diff --git a/adventofcode24.cabal b/adventofcode24.cabal index fabde5f..fd60adf 100644 --- a/adventofcode24.cabal +++ b/adventofcode24.cabal @@ -181,4 +181,16 @@ executable advent18e import: warnings, common-extensions, build-directives, common-modules main-is: advent18/MainExplorer.hs build-depends: containers, linear, attoparsec, text, search-algorithms - \ No newline at end of file + +executable advent19 + import: warnings, common-extensions, build-directives, common-modules + main-is: advent19/Main.hs + build-depends: attoparsec, text, containers, multiset +executable advent19p + import: warnings, common-extensions, build-directives, common-modules + main-is: advent19/MainP.hs + -- build-depends: attoparsec, text +executable advent19a + import: warnings, common-extensions, build-directives, common-modules + main-is: advent19/MainA.hs + build-depends: attoparsec, text \ No newline at end of file