54 lines
1.6 KiB
Haskell
54 lines
1.6 KiB
Haskell
import qualified Data.Array as A
|
|
import qualified Data.Map as M
|
|
import Data.Char (ord)
|
|
import Data.List (findIndex, find)
|
|
import Data.Maybe (isJust, mapMaybe, listToMaybe, fromJust)
|
|
|
|
import qualified Bfs as B
|
|
|
|
type Height = Int -- bool identifies if this is our final square
|
|
type Coord = (Int, Int)
|
|
type HeightMap = A.Array Coord Height
|
|
|
|
|
|
bfs :: HeightMap -> [(Coord, Int)] -> M.Map Coord Int -> M.Map Coord Int
|
|
bfs heightmap = B.bfs f where
|
|
f q@(x,y) = neighs where
|
|
height = heightmap A.! q
|
|
inRange (x,y) = let (bx, by) = snd (A.bounds heightmap) in x >= 0 && x <= bx && y >= 0 && y <= by
|
|
reachable coord = inRange coord && (heightmap A.! coord) >= height - 1
|
|
neighs = filter reachable [(x+1, y), (x-1, y), (x, y+1), (x, y-1)]
|
|
|
|
|
|
|
|
|
|
toHeight :: Char -> Int
|
|
toHeight 'S' = toHeight 'a'
|
|
toHeight 'E' = toHeight 'z'
|
|
toHeight x = ord x
|
|
|
|
findIndex2 :: (a -> Bool) -> [[a]] -> Maybe (Int, Int)
|
|
findIndex2 f xss = listToMaybe xs2 where
|
|
xs = zip [0..] $ map (findIndex f) xss
|
|
xs2 = mapMaybe (uncurry augment) xs
|
|
augment a (Just b) = Just (a,b)
|
|
augment a Nothing = Nothing
|
|
|
|
main = do
|
|
m <- lines <$> getContents
|
|
|
|
let start = fromJust $ findIndex2 (=='S') m
|
|
let target = fromJust $ findIndex2 (=='E') m
|
|
|
|
let heightmap = A.listArray ((0,0), (length m - 1, length (head m) - 1)) (concatMap (map toHeight) m)
|
|
|
|
let final = bfs heightmap [(target, 0)] M.empty
|
|
|
|
putStr "part 1: "
|
|
print $ final M.! start
|
|
|
|
putStr "part 2: "
|
|
let starts = map fst $ filter (\x -> snd x == toHeight 'a') (A.assocs heightmap)
|
|
let dists = mapMaybe (`M.lookup` final) starts
|
|
print $ minimum dists
|