create BFS library

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

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'