X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent12%2FMain.hs;fp=advent12%2FMain.hs;h=78af0a1657468e17b47be9506d0fb650fa7d27bd;hb=eec28208f9b74e65a360b374fcd90b5406fdf527;hp=0000000000000000000000000000000000000000;hpb=f34155953a50dbc3196c1148ebc52dfadf9f5841;p=advent-of-code-23.git

diff --git a/advent12/Main.hs b/advent12/Main.hs
new file mode 100644
index 0000000..78af0a1
--- /dev/null
+++ b/advent12/Main.hs
@@ -0,0 +1,111 @@
+-- Writeup at https://work.njae.me.uk/2023/12/08/advent-of-code-2023-day-8/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text -- hiding (take)
+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)
+
+type Cache = M.Map Record Int
+-- type CacheState = State Cache
+
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      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)
+
+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
+
+-- Parse the input file
+
+recordsP :: Parser [Record]
+recordP :: Parser Record
+springP :: Parser Spring
+
+recordsP = recordP `sepBy` endOfLine
+recordP = Record <$> (many1 springP <* " ") <*> (decimal `sepBy` ",")
+springP = (Unknown <$ "?") <|> (Damaged <$ "#") <|> (Operational <$ ".")
+
+successfulParse :: Text -> [Record]
+successfulParse input = 
+  case parseOnly recordsP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right matches -> matches