37 lines
1.1 KiB
Haskell
37 lines
1.1 KiB
Haskell
module Logic.Graph where
|
|
|
|
import Data.Set (Set, insert)
|
|
|
|
type GetEdges vertex edge = vertex -> [(vertex, edge)]
|
|
type GetEdgesCosts vertex edge cost = vertex -> [((vertex, edge), cost)]
|
|
|
|
bfs
|
|
:: (Eq vertex, Ord vertex)
|
|
=> GetEdges vertex edge
|
|
-> vertex
|
|
-> vertex
|
|
-> Maybe [edge]
|
|
bfs getEdges goal start = reverse <$> aux [(start, [])] mempty
|
|
where
|
|
aux [] _ = Nothing
|
|
aux ((vertex, path):queue) visited
|
|
| vertex == goal = Just path
|
|
| otherwise =
|
|
let new = getUnvisitedAdjacent vertex visited
|
|
in
|
|
case filter (\(v, _) -> v == goal) new of
|
|
[] ->
|
|
let queue' = queue ++ map (\(next, edge) -> (next, edge:path)) new
|
|
in aux queue' $ insert vertex visited
|
|
((_, edge):_) -> Just (edge:path)
|
|
|
|
getUnvisitedAdjacent vertex visited =
|
|
filter (\(next, edge) -> 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"]
|
|
-}
|