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)