adventofcode/2021/day12.hs

49 lines
1.6 KiB
Haskell

module Day12 where
import qualified Data.HashSet
import Data.Map ( Map, fromList, unionWith, empty, toList, (!) )
import Data.List.Split (splitOn)
import qualified Data.Char
import Data.Maybe (mapMaybe)
type Path = (String,String)
type System = Map String [String]
readPath :: String -> Path
readPath s = (from,to) where [from,to] = splitOn "-" s
addPath :: Path -> System -> System
addPath (from,to) = unionWith (++) (Data.Map.fromList [(from,[to]), (to,[from])])
isLower :: String -> Bool
isLower = Data.Char.isLower . head
isUpper :: String -> Bool
isUpper = Data.Char.isUpper . head
pathFinder :: System -> [String] -> [[String]]
pathFinder sys p@("end":xs) = [p]
pathFinder sys p@(x:xs) = concatMap (\next -> pathFinder sys (next:p)) elig
where elig = filter (\cave -> isUpper cave || cave `notElem` p) (sys ! x)
pathFinder2 :: System -> [String] -> Bool -> [[String]]
pathFinder2 sys p@("end":xs) _ = [p]
pathFinder2 sys p@(x:xs) True = concatMap (\next -> pathFinder2 sys (next:p) True) elig
where elig = filter (\cave -> isUpper cave || cave `notElem` p) (sys ! x)
pathFinder2 sys p@(x:xs) False = concatMap (\next -> pathFinder2 sys (next:p) (dup next)) elig
where
elig = filter (/= "start") (sys ! x)
dup cave = isLower cave && cave `elem` p
main :: IO ()
main = do
input <- map readPath . lines <$> getContents
let system = foldr addPath Data.Map.empty input
putStrLn "part 1: "
let paths = map reverse $ pathFinder system ["start"]
print $ length paths
putStrLn "part 2: "
let paths = map reverse $ pathFinder2 system ["start"] False
print $ length paths