-- (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 :: [Node] -> gr a b -> Voronoi b
gvdIn [Node]
vs gr a b
g = [Node] -> gr a b -> Voronoi b
forall (gr :: * -> * -> *) b a.
(Graph gr, Real b) =>
[Node] -> gr a b -> Voronoi b
gvdOut [Node]
vs (gr a b -> gr a b
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 :: [Node] -> gr a b -> Voronoi b
gvdOut [Node]
vs = Heap b (LPath b) -> gr a b -> Voronoi 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. Ord a => [(a, b)] -> Heap a b
H.build ([b] -> Voronoi b -> [(b, LPath b)]
forall a b. [a] -> [b] -> [(a, b)]
zip (b -> [b]
forall a. a -> [a]
repeat b
0) ((Node -> LPath b) -> [Node] -> Voronoi b
forall a b. (a -> b) -> [a] -> [b]
map (\Node
v->[LNode b] -> LPath b
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 :: Node -> Voronoi b -> [Node]
voronoiSet Node
v = [Node] -> [Node]
forall a. Eq a => [a] -> [a]
nub ([Node] -> [Node]) -> (Voronoi b -> [Node]) -> Voronoi b -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Node]] -> [Node]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Node]] -> [Node])
-> (Voronoi b -> [[Node]]) -> Voronoi b -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Node] -> Bool) -> [[Node]] -> [[Node]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Node]
p->[Node] -> Node
forall a. [a] -> a
last [Node]
pNode -> Node -> Bool
forall a. Eq a => a -> a -> Bool
==Node
v) ([[Node]] -> [[Node]])
-> (Voronoi b -> [[Node]]) -> Voronoi b -> [[Node]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LPath b -> [Node]) -> Voronoi b -> [[Node]]
forall a b. (a -> b) -> [a] -> [b]
map (((Node, b) -> Node) -> [(Node, b)] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Node, b) -> Node
forall a b. (a, b) -> a
fst ([(Node, b)] -> [Node])
-> (LPath b -> [(Node, b)]) -> LPath b -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPath b -> [(Node, b)]
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 :: Node -> Voronoi b -> Maybe (LPath b)
maybePath Node
v = Voronoi b -> Maybe (LPath b)
forall a. [a] -> Maybe a
listToMaybe (Voronoi b -> Maybe (LPath b))
-> (Voronoi b -> Voronoi b) -> Voronoi b -> Maybe (LPath b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LPath b -> Bool) -> Voronoi b -> Voronoi b
forall a. (a -> Bool) -> [a] -> [a]
filter ((Node
vNode -> Node -> Bool
forall a. Eq a => a -> a -> Bool
==) (Node -> Bool) -> (LPath b -> Node) -> LPath b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node, b) -> Node
forall a b. (a, b) -> a
fst ((Node, b) -> Node) -> (LPath b -> (Node, b)) -> LPath b -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Node, b)] -> (Node, b)
forall a. [a] -> a
head ([(Node, b)] -> (Node, b))
-> (LPath b -> [(Node, b)]) -> LPath b -> (Node, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPath b -> [(Node, b)]
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 :: Node -> Voronoi b -> Maybe Node
nearestNode Node
v = (LPath b -> Node) -> Maybe (LPath b) -> Maybe Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Node, b) -> Node
forall a b. (a, b) -> a
fst ((Node, b) -> Node) -> (LPath b -> (Node, b)) -> LPath b -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Node, b)] -> (Node, b)
forall a. [a] -> a
last ([(Node, b)] -> (Node, b))
-> (LPath b -> [(Node, b)]) -> LPath b -> (Node, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPath b -> [(Node, b)]
forall a. LPath a -> [LNode a]
unLPath) (Maybe (LPath b) -> Maybe Node)
-> (Voronoi b -> Maybe (LPath b)) -> Voronoi b -> Maybe Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Voronoi b -> Maybe (LPath b)
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 :: Node -> Voronoi b -> Maybe b
nearestDist Node
v = (LPath b -> b) -> Maybe (LPath b) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Node, b) -> b
forall a b. (a, b) -> b
snd ((Node, b) -> b) -> (LPath b -> (Node, b)) -> LPath b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Node, b)] -> (Node, b)
forall a. [a] -> a
head ([(Node, b)] -> (Node, b))
-> (LPath b -> [(Node, b)]) -> LPath b -> (Node, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPath b -> [(Node, b)]
forall a. LPath a -> [LNode a]
unLPath) (Maybe (LPath b) -> Maybe b)
-> (Voronoi b -> Maybe (LPath b)) -> Voronoi b -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Voronoi b -> Maybe (LPath b)
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 :: Node -> Voronoi b -> Maybe [Node]
nearestPath Node
v = (LPath b -> [Node]) -> Maybe (LPath b) -> Maybe [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Node, b) -> Node) -> [(Node, b)] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Node, b) -> Node
forall a b. (a, b) -> a
fst ([(Node, b)] -> [Node])
-> (LPath b -> [(Node, b)]) -> LPath b -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPath b -> [(Node, b)]
forall a. LPath a -> [LNode a]
unLPath) (Maybe (LPath b) -> Maybe [Node])
-> (Voronoi b -> Maybe (LPath b)) -> Voronoi b -> Maybe [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Voronoi b -> Maybe (LPath b)
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]