Done day 19

diff --git a/advent19/Main.hs b/advent19/Main.hs
new file mode 100644 (file)
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 (file)
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 (file)
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 fabde5f4025259c5d11a94661fed17c2469bcbe0..fd60adf7a34396f493e09e516e94c1ba795cf458 100644 (file)
--- 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