summaryrefslogtreecommitdiff
path: root/2017/12.hs
blob: 44ef7295bc29c24117e71750da63147a29297601 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
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)