60 lines
1.7 KiB
Haskell
60 lines
1.7 KiB
Haskell
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"
|