diff --git a/2022/Bfs.hs b/2022/Bfs.hs new file mode 100644 index 0000000..c8b99e5 --- /dev/null +++ b/2022/Bfs.hs @@ -0,0 +1,16 @@ +module Bfs where + +import qualified Data.Map as M + +type Neighs a = a -> [a] + +bfs :: Ord k => Neighs k -> [(k, Int)] -> M.Map k Int -> M.Map k Int +bfs f [] visited = visited +bfs f ((q, dist):qs) visited = if new + then bfs f queue' visited' + else bfs f qs visited + where + new = M.notMember q visited + neighs = f q + visited' = M.insert q dist visited + queue' = qs ++ map(,dist+1) neighs \ No newline at end of file diff --git a/2022/day12.hs b/2022/day12.hs index 574d65d..d0d3ecd 100644 --- a/2022/day12.hs +++ b/2022/day12.hs @@ -4,26 +4,23 @@ 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 [] visited = visited -bfs heightmap ((q@(x,y), dist):queue) visited = if usable - then bfs heightmap queue' visited' - else bfs heightmap queue visited - where - current = 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) >= current - 1 - neighs = filter reachable [(x+1, y), (x-1, y), (x, y+1), (x, y-1)] - usable = case M.lookup q visited of - Nothing -> True - (Just d) -> d > dist - visited' = M.insert q dist visited - queue' = queue ++ map (,dist+1) neighs +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'