summaryrefslogtreecommitdiff
path: root/2019/6.hs
blob: 5b4fbb6850fd273e17551c333d8fa1fccd3f00fb (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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
module Main where

import Control.Monad
import qualified Data.Array as A
import Data.Function (on)
import Data.List
import qualified Data.Map.Strict as Map
import Data.Maybe
import qualified Data.Set as Set

import Input


swap :: (a, b) -> (b, a)
swap (a, b) = (b, a)

uniq :: Eq a => [a] -> [a]
uniq (x:y:zs) | x == y = uniq (x:zs)
              | otherwise = x : uniq (y:zs)
uniq l = l

parse :: String -> (String, String)
parse s = let (pre, ')' : post) = break (== ')') s
          in (pre, post)

main :: IO ()
main = do
    input <- getInput 6
    let downedges = map parse input
        upedges = map swap downedges
        nodes = uniq $ sort $ map fst $ downedges ++ upedges

    when (any ((/= 1) . length) (groupBy ((==) `on` fst) upedges)) $
        error "Input graph is not a tree"

    let parentMap = Map.fromList upedges
        node2index = Map.fromList (zip nodes [0..])
        depthArray = A.listArray (0, length nodes - 1)
                         [case Map.lookup node parentMap of
                              Nothing -> 0
                              Just par -> depthArray A.! (node2index Map.! par) + 1
                         | node <- nodes]
        checksum = sum [d | d <- A.elems depthArray] :: Int

    print checksum

    let src = parentMap Map.! "YOU"
        dest = parentMap Map.! "SAN"
        childMap = Map.fromList (map ((,) <$> fst . head <*> map snd)
                                 $ groupBy ((==) `on` fst)
                                 $ sortOn fst downedges)
        envOf n = maybe [] pure (Map.lookup n parentMap) ++ fromMaybe [] (Map.lookup n childMap)

        expand d seen border mp
            | Set.null border = mp
            | otherwise = let newnodes = Set.fromList (concatMap envOf border) Set.\\ seen
                          in expand (d + 1)
                                    (seen <> newnodes)
                                    newnodes
                                    (foldr (\n -> Map.insert n (d + 1)) mp (Set.toList newnodes))

        distMap = expand (0 :: Int) (Set.singleton src) (Set.singleton src) (Map.singleton src 0)

    print (distMap Map.! dest)