Done day 23 part 1

[advent-of-code-23.git] / advent12 / Main.hs

diff --git a/advent12/Main.hs b/advent12/Main.hs
index 78af0a1657468e17b47be9506d0fb650fa7d27bd..2c07b389c78b434da585a14d2c2bc5d40a3bf214 100644 (file)
--- a/advent12/Main.hs
+++ b/advent12/Main.hs
@@ -1,20 +1,17 @@
--- Writeup at https://work.njae.me.uk/2023/12/08/advent-of-code-2023-day-8/
+-- Writeup at https://work.njae.me.uk/2023/12/15/advent-of-code-2023-day-12/
 
 import AoC
 import Data.Text (Text)
 import qualified Data.Text.IO as TIO
-import Data.Attoparsec.Text -- hiding (take)
+import Data.Attoparsec.Text hiding (take, takeWhile)
 import Control.Applicative
 import Data.List
 import qualified Data.Map.Strict as M
-import Data.Maybe
-import Control.Monad.State.Strict
 
-data Spring = Unknown | Damaged | Operational deriving (Show, Eq)
-data Record = Record [Spring] [Int] deriving (Show)
+data Spring = Unknown | Damaged | Operational deriving (Show, Eq, Ord)
+data Record = Record [Spring] [Int] deriving (Show, Eq, Ord)
 
 type Cache = M.Map Record Int
--- type CacheState = State Cache
 
 
 main :: IO ()
@@ -23,77 +20,61 @@ main =
       text <- TIO.readFile dataFileName
       let records = successfulParse text
       -- print records
-      -- print $ fmap numDamagedToPlace records
-      -- print $ fmap candidates records
-      -- print $ possibleAssignments (records !! 1)
-      -- print $ fmap countViableAssignments records
       print $ part1 records
-      print $ unfoldRecord $ head records
       print $ part2 records
 
 part1, part2 :: [Record] -> Int
-part1 = sum . fmap countViableAssignments
-part2 = sum . fmap (countViableAssignments . unfoldRecord)
+part1 = sum . fmap countViable
+part2 = sum . fmap (countViable . unfoldRecord)
 
 unfoldRecord :: Record -> Record
 unfoldRecord (Record springs signature) = Record uSprings uSignature
   where uSprings = intercalate [Unknown] $ replicate 5 springs
         uSignature = concat $ replicate 5 signature
 
-
-countViable :: Record -> CacheState Int
-
-
-countViable previousSprings (Record (s:springs) (g:signature)) = 
-
-
--- if next few springs can match next group:
---   countViable (springs after group) (tail groups) + countViable (tail springs) groups
--- else
---   countViable (tail springs) groups
-
-
-
-countViableAssignments :: Record -> Int
-countViableAssignments = length . filter matchesSignature . possibleAssignments
-
-matchesSignature :: Record -> Bool
-matchesSignature (Record springs signature) = signSprings springs == signature
-
-signSprings :: [Spring] -> [Int]
-signSprings = fmap (length) . filter ((== Damaged) . head) . group
-
-choose :: Int -> [a] -> [[a]]
-choose 0 _ = [[]]
-choose n (x:xs) 
-  | length xs == n - 1 = [(x:xs)]
-  | otherwise = (fmap (x:) (choose (n-1) xs)) ++ (choose n xs)
-
--- unknownIndices :: [Spring] -> [Int]
--- unknownIndices = elemIndices Unknown
-
-numDamagedToPlace :: Record -> Int
-numDamagedToPlace (Record springs signature) = totalDamaged - knownDamaged
-  where knownDamaged = length $ filter (== Damaged) springs
-        totalDamaged = sum signature
-
-candidates :: Record -> [[Int]]
-candidates r@(Record springs _) = 
-  choose (numDamagedToPlace r) (elemIndices Unknown springs)
-
-replaceUnknowns :: [Spring] -> [Int] -> [Spring]
-replaceUnknowns springs indices = foldr go [] indexedSprings
-  where indexedSprings = zip [0..] springs
-        go (i, Unknown) acc = if (i `elem` indices) then Damaged:acc
-                                                    else Operational:acc
-        go (_, s) acc = s:acc
-
-possibleAssignments :: Record -> [Record]
-possibleAssignments r@(Record springs signature) = 
-  fmap (\p -> Record p signature) possibles
-  where cands = candidates r
-        possibles = fmap (replaceUnknowns springs) cands
-
+countViable :: Record -> Int
+countViable record = table M.! record
+  where table0 = initialCache record
+        table = fillTable table0 record
+
+initialCache :: Record -> Cache
+initialCache (Record springs signature) = M.union lastOperational cache0
+  where cache0 = M.union sprs sigs
+        sprs = M.fromList $ fmap (\s -> (Record s [], 0)) $ tails springs
+        sigs = M.fromList $ fmap (\g -> (Record [] g, 0)) $ tails signature
+        lastOperationalChunk = 
+          reverse $ takeWhile isPossOperational $ reverse springs
+        lastOperational = 
+          M.fromList $ fmap (\s -> (Record s [], 1)) $ tails lastOperationalChunk
+
+fillTableCell, fillTableSigs, fillTable :: Cache -> Record -> Cache
+fillTableCell table record
+  | record `M.member` table = table
+  | otherwise = M.insert record (opN + signN) table
+  where (Record springs@(s:ss) signatures@(g:gs)) = record
+        opN = if (isPossOperational s) then table M.! (Record ss signatures) else 0
+        signN = if (possibleDamagedChunk springs g) then table M.! (Record (drop (g + 1) springs) gs) else 0
+
+fillTableSigs table (Record springs signatures) = foldr (\gs t -> fillTableCell t (Record springs gs)) table $ tails signatures
+
+fillTable table (Record springs signatures) = foldr (\ss t -> fillTableSigs t (Record ss signatures)) table $ tails springs 
+
+isPossOperational :: Spring -> Bool
+isPossOperational Operational = True
+isPossOperational Unknown = True
+isPossOperational _ = False
+
+isPossDamaged :: Spring -> Bool
+isPossDamaged Damaged = True
+isPossDamaged Unknown = True
+isPossDamaged _ = False
+
+possibleDamagedChunk :: [Spring] -> Int -> Bool
+possibleDamagedChunk springs n = 
+  isDamagedChunk && ((null afterChunk) || (isPossOperational $ head afterChunk))
+  where isDamagedChunk = (length $ filter isPossDamaged $ take n springs) == n
+        afterChunk = drop n springs
+  
 -- Parse the input file
 
 recordsP :: Parser [Record]