module Day12 where -- import Data.HashSet (HashSet, member, insert, fromList) -- import Data.Map ( Map, fromList, unionWith, empty, (!), insert, elems) qualified (map) import qualified Data.Map as M import Data.Bits ( Bits(shiftL, (.|.), (.&.)) ) import Data.HashSet (HashSet) import qualified Data.HashSet as S import Data.List.Split (splitOn) import qualified Data.Char 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])]) isUpper :: Cave -> Bool isUpper x = x < 0 pathFinder :: System -> Cave -> Int -> Int pathFinder sys (-1) _ = 1 pathFinder sys x visited = sum $ map (\next -> pathFinder sys next (nextmap next)) elig where nextmap next = if not (isUpper next) then next .|. visited else visited elig = filter (\cave -> isUpper cave || (cave .&. visited) == 0) (sys M.! x) pathFinder2 :: System -> Cave -> Int -> Int pathFinder2 sys (-1) _ = 1 pathFinder2 sys x visited = sum $ map (\next -> f next sys next (nextmap next)) elig where nextmap next = if not (isUpper next) then next .|. visited else visited f cave = if isUpper cave || (cave .&. visited) == 0 then pathFinder2 else pathFinder 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 print conversion let integralSystem = M.mapKeys (conversion M.!) $ M.map (map (conversion M.!)) system putStrLn "part 1: " print $ pathFinder integralSystem 1 1 putStrLn "part 2: " print $ pathFinder2 integralSystem 1 1