module Days.Day12 where import AOCUtil import Data.Bool import Data.Char import Data.List import Data.Maybe import Debug.Trace import GHC.Arr import GHC.Utils.Misc runA :: IO () runA = interactF "data/day12.txt" solve runB :: IO () runB = interactF "data/day12.txt" solveB solve :: String -> String solve s = show . bfs [findStart m] $ m where m = readMap s solveB :: String -> String solveB s = show . bfs (getStarts m) $ m where m = setupStarts $ readMap s data Node = Node {level :: Int, dist :: Maybe Int, isTarget :: Bool} deriving (Show) type Map = Array (Int, Int) Node readNode :: Char -> Node readNode 'S' = Node {level = 0, dist = Just 0, isTarget = False} readNode 'E' = Node {level = 25, dist = Nothing, isTarget = True} readNode c = Node {level = fromEnum c - fromEnum 'a', dist = Nothing, isTarget = False} readMap :: String -> Map readMap s = listArray ((0, 0), (length (head ls) - 1, length ls - 1)) . map readNode . concat . transpose $ ls where ls = lines s findStart :: Map -> (Int, Int) findStart = fst . head . filter (isJust . dist . snd) . assocs setupStarts :: Map -> Map setupStarts = amap (\m -> if level m == 0 then m {dist = Just 0} else m) getStarts :: Map -> [(Int, Int)] getStarts = map fst . filter (any (== 0) . dist . snd) . assocs bfs :: [(Int, Int)] -> Map -> Int bfs (p@(x, y) : ns) m | isTarget n = fromJust $ dist n | otherwise = bfs (ns ++ new) $ m // [((x2, y2), (m ! (x2, y2)) {dist = fmap (+ 1) d}) | (x2, y2) <- new] where n = m ! p d = dist n new = filter (isNothing . dist . (m !)) . filter ((<= level n + 1) . level . (m !)) . filter (inRange (bounds m)) $ [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)] bfs [] _ = error "dfs could not reach target"