1 files changed, 35 insertions, 0 deletions
diff --git a/2017/12.hs b/2017/12.hs
new file mode 100644
index 0000000..44ef729
--- /dev/null
+++ b/2017/12.hs
@@ -0,0 +1,35 @@
+import Control.Monad
+import Data.Char
+import qualified Data.Map.Strict as Map
+import Data.Map.Strict ((!))
+import qualified Data.Set as Set
+
+
+parseLine :: String -> (Int, [Int])
+parseLine s =
+    let from : "<->" : tos = words s
+    in (read from, read from : map (read . takeWhile isDigit) tos)
+
+fixpoint :: Eq a => (a -> a) -> a -> a
+fixpoint f x = let x' = f x in if x == x' then x else fixpoint f x'
+
+pipeGroup :: Int -> Map.Map Int [Int] -> Set.Set Int
+pipeGroup start pipemap = fixpoint (expand pipemap) (Set.singleton start)
+  where
+    expand pm gr = Set.fromList (concatMap (pm !) (Set.toList gr))
+
+pipeGroups :: Map.Map Int [Int] -> [Set.Set Int]
+pipeGroups pipemap = go pipemap (Set.fromList (Map.keys pipemap))
+  where
+    go pm set
+        | Set.null set = []
+        | otherwise =
+            let (i, set') = Set.deleteFindMin set
+                grp = pipeGroup i pipemap
+            in grp : go pm (set' Set.\\ grp)
+
+main :: IO ()
+main = do
+    pipemap <- liftM (Map.fromList . map parseLine . lines) (readFile "12.in")
+    print $ Set.size (pipeGroup 0 pipemap)
+    print $ length (pipeGroups pipemap)