72 lines
2.6 KiB
Haskell
72 lines
2.6 KiB
Haskell
module Day12 where
|
|
import Data.Bits ( Bits(shiftL, (.|.), (.&.)) )
|
|
import Data.Char ( isUpper )
|
|
import Data.List.Split (splitOn)
|
|
|
|
import qualified Data.Map as M
|
|
import qualified Data.Array as A
|
|
|
|
|
|
type Cave = Int
|
|
type Path = (Cave,Cave)
|
|
type System = M.Map Cave [Cave]
|
|
|
|
|
|
readPath :: String -> (String,String)
|
|
readPath s = (from,to) where [from,to] = splitOn "-" s
|
|
|
|
addPath :: (String,String) -> M.Map String [String] -> M.Map String [String]
|
|
addPath (from,to) = M.unionWith (++) (M.fromList [(from,[to]), (to,[from])])
|
|
|
|
isBig :: Cave -> Bool
|
|
isBig x = x < 0
|
|
|
|
solve :: System -> (Int, Int)
|
|
solve sys = (pf1a A.! (1,1), pf2a A.! (1, 1))
|
|
where
|
|
caves = concat $ M.elems sys
|
|
bounds = ((minimum caves, 0), (maximum caves, maximum caves * 2))
|
|
|
|
pf1a :: A.Array (Cave,Int) Int
|
|
pf1a = A.array bounds [((c,v), pf1 c v) | c <- [minimum caves..maximum caves], v <- [0..maximum caves * 2] ]
|
|
pf1 :: Cave -> Int -> Int
|
|
pf1 (-1) _ = 1
|
|
pf1 x visited = sum $ map (\next -> pf1a A.! (next,nextmap next)) elig
|
|
where
|
|
nextmap next = if not (isBig next) then next .|. visited else visited
|
|
elig = filter (\cave -> isBig cave || (cave .&. visited) == 0) (sys M.! x)
|
|
|
|
pf2a :: A.Array (Cave,Int) Int
|
|
pf2a = A.array bounds [((c,v), pf2 c v) | c <- [minimum caves..maximum caves], v <- [0..maximum caves * 2] ]
|
|
pf2 :: Cave -> Int -> Int
|
|
pf2 (-1) _ = 1
|
|
pf2 x visited = sum $ map (\next -> f next A.! (next,nextmap next)) elig
|
|
where
|
|
nextmap next = if not (isBig next) then next .|. visited else visited
|
|
f cave = if isBig cave || (cave .&. visited) == 0 then pf2a else pf1a
|
|
elig = filter (/= 1) (sys M.! x)
|
|
|
|
convert :: [String] -> M.Map String Int
|
|
convert caves = conversion
|
|
where
|
|
(conversion, numhi, numlo) = foldr go (M.fromList [("end", -1), ("start", 1)], 2, 1) caves
|
|
go cave (map,upper,lower)
|
|
| cave `M.member` map = (map,upper,lower)
|
|
| Data.Char.isUpper (head cave) = (M.insert cave (-upper) map, upper+1, lower)
|
|
| otherwise = (M.insert cave (1 `Data.Bits.shiftL` lower) map, upper, lower+1)
|
|
|
|
main :: IO ()
|
|
main = do
|
|
input <- map readPath . lines <$> getContents
|
|
let system = foldr addPath M.empty input
|
|
let conversion = convert $ concat $ M.elems system
|
|
let integralSystem = M.mapKeys (conversion M.!) $ M.map (map (conversion M.!)) system
|
|
|
|
let (p1,p2) = solve integralSystem
|
|
|
|
putStrLn "part 1: "
|
|
print p1
|
|
|
|
putStrLn "part 2: "
|
|
print p2
|