1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
-- (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 H.splitMin h of
(_,p@(LP ((v,d):_)),h') ->
case match v g of
(Just c,g') -> p:dijkstra (H.mergeAll (h':expand d p c)) g'
(Nothing,g') -> dijkstra h' g'
_ -> []
-- | 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' <path length>@
-- 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' <path>@ 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
|
