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