-- (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 :: forall b a.
Real b =>
b -> LPath b -> Context a b -> [Heap b (LPath b)]
expand b
d (LP [LNode b]
p) (Adj b
_,Node
_,a
_,Adj b
s) = forall a b. (a -> b) -> [a] -> [b]
map (\(b
l,Node
v)->forall a b. a -> b -> Heap a b
H.unit (b
lforall a. Num a => a -> a -> a
+b
d) (forall a. [LNode a] -> LPath a
LP ((Node
v,b
lforall a. Num a => a -> a -> a
+b
d)forall a. a -> [a] -> [a]
:[LNode b]
p))) Adj b
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 :: forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
dijkstra Heap b (LPath b)
h gr a b
g | forall a b. Heap a b -> Bool
H.isEmpty Heap b (LPath b)
h Bool -> Bool -> Bool
|| forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> Bool
isEmpty gr a b
g = []
dijkstra Heap b (LPath b)
h gr a b
g =
    case forall (gr :: * -> * -> *) a b.
Graph gr =>
Node -> gr a b -> Decomp gr a b
match Node
v gr a b
g of
         (Just Context a b
c,gr a b
g')  -> LPath b
pforall a. a -> [a] -> [a]
:forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
dijkstra (forall a b. Ord a => [Heap a b] -> Heap a b
H.mergeAll (Heap b (LPath b)
h'forall a. a -> [a] -> [a]
:forall b a.
Real b =>
b -> LPath b -> Context a b -> [Heap b (LPath b)]
expand b
d LPath b
p Context a b
c)) gr a b
g'
         (MContext a b
Nothing,gr a b
g') -> forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
dijkstra Heap b (LPath b)
h' gr a b
g'
    where (b
_,p :: LPath b
p@(LP ((Node
v,b
d):[LNode b]
_)),Heap b (LPath b)
h') = forall a b. Ord a => Heap a b -> (a, b, Heap a b)
H.splitMin Heap b (LPath b)
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 :: forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> gr a b -> LRTree b
spTree Node
v = forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
dijkstra (forall a b. a -> b -> Heap a b
H.unit b
0 (forall a. [LNode a] -> LPath a
LP [(Node
v,b
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 :: forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> Node -> gr a b -> Maybe b
spLength Node
s Node
t = forall a. Node -> LRTree a -> Maybe a
getDistance Node
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> gr a b -> LRTree b
spTree Node
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 :: forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> Node -> gr a b -> Maybe Path
sp Node
s Node
t gr a b
g = case forall a. Node -> LRTree a -> Path
getLPathNodes Node
t (forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Node -> gr a b -> LRTree b
spTree Node
s gr a b
g) of
  [] -> forall a. Maybe a
Nothing
  Path
p  -> forall a. a -> Maybe a
Just Path
p