-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT] -- | Shortest path algorithms module Data.Graph.Inductive.Query.SP( spTree , sp , spLength , dijkstra , LRTree , H.Heap ) where import qualified Data.Graph.Inductive.Internal.Heap as H import Data.Graph.Inductive.Graph import Data.Graph.Inductive.Internal.RootPath expand :: (Real b) => b -> LPath b -> Context a b -> [H.Heap b (LPath b)] expand d (LP p) (_,_,_,s) = map (\(l,v)->H.unit (l+d) (LP ((v,l+d):p))) s -- | Dijkstra's shortest path algorithm. -- -- The edge labels of type @b@ are the edge weights; negative edge -- weights are not supported. dijkstra :: (Graph gr, Real b) => H.Heap b (LPath b) -- ^ Initial heap of known paths and their lengths. -> gr a b -> LRTree b dijkstra h g | H.isEmpty h || isEmpty g = [] dijkstra h g = case match v g of (Just c,g') -> p:dijkstra (H.mergeAll (h':expand d p c)) g' (Nothing,g') -> dijkstra h' g' where (_,p@(LP ((v,d):_)),h') = H.splitMin h -- | Tree of shortest paths from a certain node to the rest of the -- (reachable) nodes. -- -- Corresponds to 'dijkstra' applied to a heap in which the only known node is -- the starting node, with a path of length 0 leading to it. -- -- The edge labels of type @b@ are the edge weights; negative edge -- weights are not supported. spTree :: (Graph gr, Real b) => Node -> gr a b -> LRTree b spTree v = dijkstra (H.unit 0 (LP [(v,0)])) -- | Length of the shortest path between two nodes, if any. -- -- Returns 'Nothing' if there is no path, and @'Just' @ -- otherwise. -- -- The edge labels of type @b@ are the edge weights; negative edge -- weights are not supported. spLength :: (Graph gr, Real b) => Node -- ^ Start -> Node -- ^ Destination -> gr a b -> Maybe b spLength s t = getDistance t . spTree s -- | Shortest path between two nodes, if any. -- -- Returns 'Nothing' if the destination is not reachable from the -- start node, and @'Just' @ otherwise. -- -- The edge labels of type @b@ are the edge weights; negative edge -- weights are not supported. sp :: (Graph gr, Real b) => Node -- ^ Start -> Node -- ^ Destination -> gr a b -> Maybe Path sp s t g = case getLPathNodes t (spTree s g) of [] -> Nothing p -> Just p