27 lines
947 B
Haskell
27 lines
947 B
Haskell
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"]
|
|
-}
|