Day 12

data/caves.txt

+VJ-nx
+start-sv
+nx-UL
+FN-nx
+FN-zl
+end-VJ
+sv-hi
+em-VJ
+start-hi
+sv-em
+end-zl
+zl-em
+hi-VJ
+FN-em
+start-VJ
+jx-FN
+zl-sv
+FN-sv
+FN-hi
+nx-end
\ No newline at end of file

src/AOC-11b.hs

@@ -57,5 +57,5 @@ allDischarged = all (==0) . elems
 main :: IO ()
 main = do
   arr <- loadArray <$> readFile "data/energy.txt"
-  let sync = length . takeWhile (not . allDischarged . fst). iterate step $ (arr,0)
+  let sync = length . takeWhile (not . allDischarged . fst) . iterate step $ (arr,0)
   print sync
\ No newline at end of file

src/AOC-12a.hs

+{-# LANGUAGE TypeApplications #-}
+
 module Main where
 
+import Control.Monad ( void, guard )
+import Data.Char ( isUpper, isAlpha )
+import qualified Data.Map as M
+import Data.Map (Map,(!))
+import qualified Data.Set as S
+import Data.Set (Set)
+import Text.ParserCombinators.ReadP
+    ( char, munch1, readP_to_S, ReadP )
+
+data Cave
+  = Small { name :: String }
+  | Big { name :: String }
+  deriving (Eq,Ord,Show)
+
+data Edge = Edge Cave Cave
+
+instance Read Edge where
+  readsPrec _ = readP_to_S parseEdge
+
+type CaveMap = Map Cave [Cave]
+
+parseCave :: ReadP Cave
+parseCave = do
+  nm <- munch1 isAlpha
+  pure $
+    if isUpper (head nm) then Big nm else Small nm
+
+parseEdge :: ReadP Edge
+parseEdge = do
+  c1 <- parseCave
+  void $ char '-'
+  c2 <- parseCave
+  pure $ Edge c1 c2
+
+makeCaveMap :: [Edge] -> CaveMap
+makeCaveMap es = 
+  M.unionsWith (++) . map (\(Edge c1 c2) -> M.fromList [(c1,[c2]),(c2,[c1])]) $ es
+
+paths :: CaveMap -> [[Cave]]
+paths cm = iter (Small "start") (S.singleton (Small "start")) [Small "start"] where
+  iter :: Cave -> Set Cave -> [Cave] -> [[Cave]]
+  iter (Small "end") _ path = [reverse path]
+  iter cave visited path = do
+    next <- filter (`notElem` visited) . (cm !) $ cave
+    guard $ next `notElem` visited
+    case next of
+      Big _ -> iter next visited (next : path)
+      Small _ -> iter next (S.insert next visited) (next : path)
+
+processCaveFile :: FilePath -> IO ()
+processCaveFile file = do
+  caves <- makeCaveMap . map (read @Edge) . lines <$> readFile file
+  putStrLn file
+  print . length . paths $ caves
+  putStrLn ""
+
 main :: IO ()
-main = pure ()
+main = do
+  processCaveFile "data/caves.txt"
+

src/AOC-12b.hs

+{-# LANGUAGE TypeApplications #-}
+
 module Main where
 
+import Control.Monad ( guard, void )
+import Data.Char ( isUpper, isAlpha )
+import qualified Data.Map as M
+import Data.Map (Map,(!))
+import qualified Data.Set as S
+import Data.Set (Set)
+import Text.ParserCombinators.ReadP
+    ( char, munch1, readP_to_S, ReadP )
+
+data Cave
+  = Small { name :: String }
+  | Big { name :: String }
+  deriving (Eq,Ord,Show)
+
+data Edge = Edge Cave Cave
+
+instance Read Edge where
+  readsPrec _ = readP_to_S parseEdge
+
+type CaveMap = Map Cave [Cave]
+
+parseCave :: ReadP Cave
+parseCave = do
+  nm <- munch1 isAlpha
+  pure $
+    if isUpper (head nm) then Big nm else Small nm
+
+parseEdge :: ReadP Edge
+parseEdge = do
+  c1 <- parseCave
+  void $ char '-'
+  c2 <- parseCave
+  pure $ Edge c1 c2
+
+makeCaveMap :: [Edge] -> CaveMap
+makeCaveMap es =
+  M.unionsWith (++) . map (\(Edge c1 c2) -> M.fromList [(c1,[c2]),(c2,[c1])]) $ es
+
+paths :: CaveMap -> [[Cave]]
+paths cm = iter (Small "start") (S.singleton (Small "start")) False [Small "start"] where
+  iter :: Cave -> Set Cave -> Bool -> [Cave] -> [[Cave]]
+  iter (Small "end") _ _ path = [reverse path] -- end at end
+  iter cave visited revisited path = do
+    next <- cm ! cave
+    guard $ next /= Small "start" -- don't revist start
+    if next `elem` visited
+    then do
+      guard $ not revisited
+      iter next visited True (next : path)
+    else case next of
+      Big   _ -> iter next visited revisited (next : path)
+      Small _ -> iter next (S.insert next visited) revisited (next : path)
+
+processCaveFile :: FilePath -> IO ()
+processCaveFile file = do
+  caves <- makeCaveMap . map (read @Edge) . lines <$> readFile file
+  putStrLn file
+  print . length . paths $ caves
+  putStrLn ""
+
 main :: IO ()
-main = pure ()
+main = do
+  processCaveFile "data/caves.txt"
+

test/caves1.txt

+start-A
+start-b
+A-c
+A-b
+b-d
+A-end
+b-end
\ No newline at end of file

test/caves2.txt

+dc-end
+HN-start
+start-kj
+dc-start
+dc-HN
+LN-dc
+HN-end
+kj-sa
+kj-HN
+kj-dc
\ No newline at end of file

test/caves3.txt

+fs-end
+he-DX
+fs-he
+start-DX
+pj-DX
+end-zg
+zg-sl
+zg-pj
+pj-he
+RW-he
+fs-DX
+pj-RW
+zg-RW
+start-pj
+he-WI
+zg-he
+pj-fs
+start-RW
\ No newline at end of file