From: Neil Smith <neil.git@njae.me.uk>
Date: Mon, 13 Dec 2021 09:56:56 +0000 (+0000)
Subject: Done day 12 part 1
X-Git-Url: https://git.njae.me.uk/?a=commitdiff_plain;h=8761302ae0a2266a934a49138e4c01f3fa5e4af1;p=advent-of-code-21.git

Done day 12 part 1
---

diff --git a/advent-of-code21.cabal b/advent-of-code21.cabal
index 12cd8ab..ac846cf 100644
--- a/advent-of-code21.cabal
+++ b/advent-of-code21.cabal
@@ -139,3 +139,8 @@ executable advent11
   import: common-extensions, build-directives
   main-is: advent11/Main.hs
   build-depends: array, containers, linear
+
+executable advent12
+  import: common-extensions, build-directives
+  main-is: advent12/Main.hs
+  build-depends: text, attoparsec, containers
diff --git a/advent12/Main.hs b/advent12/Main.hs
new file mode 100644
index 0000000..59d73a3
--- /dev/null
+++ b/advent12/Main.hs
@@ -0,0 +1,82 @@
+-- Writeup at https://work.njae.me.uk/2021/12/09/advent-of-code-2021-day-8/
+
+
+import Data.Text ()
+import qualified Data.Text.IO as TIO
+
+import Data.Attoparsec.Text
+-- import Control.Applicative
+
+import Data.Tuple
+-- import Data.List
+import Data.Char
+import qualified Data.Map.Strict as M
+import Data.Map.Strict ((!))
+import qualified Data.Set as S
+import Data.Set ((\\))
+
+data Path = Path String [String] (S.Set String)
+  deriving (Eq, Ord, Show)
+
+type PathSet = S.Set Path
+type Graph = M.Map String (S.Set String)
+
+
+
+main :: IO ()
+main = 
+  do  text <- TIO.readFile "data/advent12.txt"
+      let edges = successfulParse text
+      print edges
+      let graph = mkGraph edges
+      print graph
+      print $ part1 graph
+      -- print $ part1 displays
+      -- print $ part2 displays
+
+mkGraph :: [(String, String)] -> Graph
+mkGraph edges = foldr mkEdge pass1 $ map swap edges
+  where pass1 = foldr mkEdge M.empty edges
+        mkEdge (here, there) g = M.insertWith (S.union) here (S.singleton there) g
+
+part1 graph = S.size $ allPaths graph (S.singleton (Path "start" [] S.empty)) S.empty
+
+allPaths :: Graph -> PathSet -> PathSet -> PathSet
+allPaths graph agenda results
+  | S.null agenda = results
+  | otherwise = allPaths graph agenda'' results'
+  where (current, agenda') = S.deleteFindMin agenda
+        newPaths = extendPath graph current
+        agenda'' = S.union agenda' newPaths
+        results' = S.union results $ recordResult current
+
+extendPath :: Graph -> Path -> PathSet
+extendPath graph (Path current trail visited) 
+  | current == "end" = S.empty
+  | otherwise = S.map newPath visitable
+  where neighbours = graph ! current
+        visited' = if isSmall current then S.insert current visited else visited
+        trail' = (current:trail)
+        visitable = neighbours \\ visited
+        newPath next = Path next trail' visited'
+
+recordResult :: Path -> PathSet
+recordResult path@(Path current _trail _visited)
+  | current == "end" = S.singleton path -- (Path current trail visited)
+  | otherwise = S.empty
+
+
+isSmall :: String -> Bool
+isSmall = all isLower
+isBig = not . isSmall
+
+-- Parse the input file
+
+graphP = edgeP `sepBy` endOfLine
+edgeP = (,) <$> (many1 letter <* "-") <*> many1 letter
+
+-- successfulParse :: Text -> (Integer, [Maybe Integer])
+successfulParse input = 
+  case parseOnly graphP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right graph -> graph
diff --git a/data/advent12.txt b/data/advent12.txt
new file mode 100644
index 0000000..e408c73
--- /dev/null
+++ b/data/advent12.txt
@@ -0,0 +1,24 @@
+by-TW
+start-TW
+fw-end
+QZ-end
+JH-by
+ka-start
+ka-by
+end-JH
+QZ-cv
+vg-TI
+by-fw
+QZ-by
+JH-ka
+JH-vg
+vg-fw
+TW-cv
+QZ-vg
+ka-TW
+ka-QZ
+JH-fw
+vg-hu
+cv-start
+by-cv
+ka-cv
diff --git a/data/advent12a.txt b/data/advent12a.txt
new file mode 100644
index 0000000..898cd56
--- /dev/null
+++ b/data/advent12a.txt
@@ -0,0 +1,7 @@
+start-A
+start-b
+A-c
+A-b
+b-d
+A-end
+b-end
\ No newline at end of file
diff --git a/data/advent12c.txt b/data/advent12c.txt
new file mode 100644
index 0000000..65f3833
--- /dev/null
+++ b/data/advent12c.txt
@@ -0,0 +1,18 @@
+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