-- (c) 2000-2005 by Martin Erwig [see file COPYRIGHT]
-- | Graph Voronoi Diagram
--
--   These functions can be used to create a /shortest path forest/
--   where the roots are specified.
module Data.Graph.Inductive.Query.GVD (
    Voronoi,LRTree,
    gvdIn,gvdOut,
    voronoiSet,nearestNode,nearestDist,nearestPath,
--    vd,nn,ns,
--    vdO,nnO,nsO
) where

import Data.List  (nub)
import Data.Maybe (listToMaybe)

import qualified Data.Graph.Inductive.Internal.Heap as H

import Data.Graph.Inductive.Basic
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Internal.RootPath
import Data.Graph.Inductive.Query.SP          (dijkstra)

-- | Representation of a shortest path forest.
type Voronoi a = LRTree a

-- | Produce a shortest path forest (the roots of which are those
--   nodes specified) from nodes in the graph /to/ one of the root
--   nodes (if possible).
gvdIn :: (DynGraph gr, Real b) => [Node] -> gr a b -> Voronoi b
gvdIn :: forall (gr :: * -> * -> *) b a.
(DynGraph gr, Real b) =>
[Node] -> gr a b -> Voronoi b
gvdIn [Node]
vs gr a b
g = forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
[Node] -> gr a b -> Voronoi b
gvdOut [Node]
vs (forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a b
grev gr a b
g)

-- | Produce a shortest path forest (the roots of which are those
--   nodes specified) from nodes in the graph /from/ one of the root
--   nodes (if possible).
gvdOut :: (Graph gr, Real b) => [Node] -> gr a b -> Voronoi b
gvdOut :: forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
[Node] -> gr a b -> Voronoi b
gvdOut [Node]
vs = forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
Heap b (LPath b) -> gr a b -> LRTree b
dijkstra (forall a b. Ord a => [(a, b)] -> Heap a b
H.build (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat b
0) (forall a b. (a -> b) -> [a] -> [b]
map (\Node
v->forall a. [LNode a] -> LPath a
LP [(Node
v,b
0)]) [Node]
vs)))

-- | Return the nodes reachable to/from (depending on how the
--   'Voronoi' was constructed) from the specified root node (if the
--   specified node is not one of the root nodes of the shortest path
--   forest, an empty list will be returned).
voronoiSet :: Node -> Voronoi b -> [Node]
voronoiSet :: forall b. Node -> Voronoi b -> [Node]
voronoiSet Node
v = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (\[Node]
p->forall a. [a] -> a
last [Node]
pforall a. Eq a => a -> a -> Bool
==Node
v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LPath a -> [LNode a]
unLPath)

-- | Try to construct a path to/from a specified node to one of the
--   root nodes of the shortest path forest.
maybePath :: Node -> Voronoi b -> Maybe (LPath b)
maybePath :: forall b. Node -> Voronoi b -> Maybe (LPath b)
maybePath Node
v = forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((Node
vforall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LPath a -> [LNode a]
unLPath)

-- | Try to determine the nearest root node to the one specified in the
--   shortest path forest.
nearestNode :: Node -> Voronoi b -> Maybe Node
nearestNode :: forall b. Node -> Voronoi b -> Maybe Node
nearestNode Node
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LPath a -> [LNode a]
unLPath) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Node -> Voronoi b -> Maybe (LPath b)
maybePath Node
v

-- | The distance to the 'nearestNode' (if there is one) in the
--   shortest path forest.
nearestDist :: Node -> Voronoi b -> Maybe b
nearestDist :: forall b. Node -> Voronoi b -> Maybe b
nearestDist Node
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LPath a -> [LNode a]
unLPath) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Node -> Voronoi b -> Maybe (LPath b)
maybePath Node
v

-- | Try to construct a path to/from a specified node to one of the
--   root nodes of the shortest path forest.
nearestPath :: Node -> Voronoi b -> Maybe Path
nearestPath :: forall b. Node -> Voronoi b -> Maybe [Node]
nearestPath Node
v = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LPath a -> [LNode a]
unLPath) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Node -> Voronoi b -> Maybe (LPath b)
maybePath Node
v


-- vd = gvdIn [4,5] vor
-- vdO = gvdOut [4,5] vor
-- nn = map (flip nearestNode vd) [1..8]
-- nnO = map (flip nearestNode vdO) [1..8]
-- ns = map (flip voronoiSet vd) [1..8]
-- nsO = map (flip voronoiSet vdO) [1..8]