breadth first search

edges are dynamically generated

Logic/Graph.hs

@@ -0,0 +1,27 @@
+module Logic.Graph where
+
+bfs :: Eq a => a -> a -> (a -> [(edge, a)]) -> Maybe [edge]
+bfs goal start getEdges = reverse <$> aux [([], start)] []
+  where
+    aux [] _ = Nothing
+    aux ((path, vertex):queue) visited
+      | vertex == goal = Just path
+      | otherwise =
+        let new = getUnvisitedAdjacent vertex visited
+        in
+          case filter (\(_, v) -> v == goal) new of
+            [] ->
+              let queue' = queue ++ map (\(edge, next) -> (edge:path, next)) new
+              in aux queue' (vertex:visited)
+            ((edge, _):_) -> Just (edge:path)
+
+    getUnvisitedAdjacent vertex visited =
+      filter (\(edge, next) -> not $ next `elem` visited) $
+      getEdges vertex
+
+{-
+ghci> bfs 10 0 (\x -> [("pred", x-1), ("succ", x+1)])
+Just ["succ","succ","succ","succ","succ","succ","succ","succ","succ","succ"]
+ghci> bfs 13 0 (\x -> [("double", x+x), ("add", x+1)])
+Just ["add","double","add","double","double","add"]
+-}