module Data.Graph.Inductive.Query.TransClos(
    trc, rc, tc
) where

import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Query.BFS (bfen)

{-|
Finds the transitive closure of a directed graph.
Given a graph G=(V,E), its transitive closure is the graph:
G* = (V,E*) where E*={(i,j): i,j in V and there is a path from i to j in G}
-}
tc :: (DynGraph gr) => gr a b -> gr a ()
tc :: forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a ()
tc gr a b
g = [(Int, Int, ())]
newEdges [(Int, Int, ())] -> gr a () -> gr a ()
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
`insEdges` [LNode a] -> gr a () -> gr a ()
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[LNode a] -> gr a b -> gr a b
insNodes [LNode a]
ln gr a ()
forall a b. gr a b
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
  where
    ln :: [LNode a]
ln       = gr a b -> [LNode a]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
g
    newEdges :: [(Int, Int, ())]
newEdges = [ (Int
u, Int
v, ()) | (Int
u, a
_) <- [LNode a]
ln, (Int
_, Int
v) <- [(Int, Int)] -> gr a b -> [(Int, Int)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[(Int, Int)] -> gr a b -> [(Int, Int)]
bfen (gr a b -> Int -> [(Int, Int)]
forall {gr :: * -> * -> *} {a} {b}.
Graph gr =>
gr a b -> Int -> [(Int, Int)]
outU gr a b
g Int
u) gr a b
g ]
    outU :: gr a b -> Int -> [(Int, Int)]
outU gr a b
gr  = ((Int, Int, b) -> (Int, Int)) -> [(Int, Int, b)] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, b) -> (Int, Int)
forall b. LEdge b -> (Int, Int)
toEdge ([(Int, Int, b)] -> [(Int, Int)])
-> (Int -> [(Int, Int, b)]) -> Int -> [(Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. gr a b -> Int -> [(Int, Int, b)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
gr a b -> Int -> [LEdge b]
out gr a b
gr

{-|
Finds the reflexive-transitive closure of a directed graph.
Given a graph G=(V,E), its reflexive-transitive closure is the graph:
G* = (V,E*) where E*={(i,j): i,j in V and either i = j or there is a path from i to j in G}
-}
trc :: (DynGraph gr) => gr a b -> gr a ()
trc :: forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a ()
trc gr a b
g = [(Int, Int, ())]
newEdges [(Int, Int, ())] -> gr a () -> gr a ()
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
`insEdges` [LNode a] -> gr a () -> gr a ()
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[LNode a] -> gr a b -> gr a b
insNodes [LNode a]
ln gr a ()
forall a b. gr a b
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
  where
    ln :: [LNode a]
ln       = gr a b -> [LNode a]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
g
    newEdges :: [(Int, Int, ())]
newEdges = [ (Int
u, Int
v, ()) | (Int
u, a
_) <- [LNode a]
ln, (Int
_, Int
v) <- [(Int, Int)] -> gr a b -> [(Int, Int)]
forall (gr :: * -> * -> *) a b.
Graph gr =>
[(Int, Int)] -> gr a b -> [(Int, Int)]
bfen [(Int
u, Int
u)] gr a b
g ]

{-|
Finds the reflexive closure of a directed graph.
Given a graph G=(V,E), its reflexive closure is the graph:
G* = (V,Er union E) where Er = {(i,i): i in V}
-}
rc :: (DynGraph gr) => gr a b -> gr a ()
rc :: forall (gr :: * -> * -> *) a b. DynGraph gr => gr a b -> gr a ()
rc gr a b
g = ([(Int, Int, ())]
newEdges [(Int, Int, ())] -> [(Int, Int, ())] -> [(Int, Int, ())]
forall a. [a] -> [a] -> [a]
++ [(Int, Int, ())]
oldEdges) [(Int, Int, ())] -> gr a () -> gr a ()
forall (gr :: * -> * -> *) b a.
DynGraph gr =>
[LEdge b] -> gr a b -> gr a b
`insEdges` [LNode a] -> gr a () -> gr a ()
forall (gr :: * -> * -> *) a b.
DynGraph gr =>
[LNode a] -> gr a b -> gr a b
insNodes [LNode a]
ln gr a ()
forall a b. gr a b
forall (gr :: * -> * -> *) a b. Graph gr => gr a b
empty
  where
    ln :: [LNode a]
ln       = gr a b -> [LNode a]
forall a b. gr a b -> [LNode a]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LNode a]
labNodes gr a b
g
    newEdges :: [(Int, Int, ())]
newEdges = [ (Int
u, Int
u, ()) | (Int
u, a
_) <- [LNode a]
ln ]
    oldEdges :: [(Int, Int, ())]
oldEdges = [ (Int
u, Int
v, ()) | (Int
u, Int
v, b
_) <- gr a b -> [(Int, Int, b)]
forall a b. gr a b -> [LEdge b]
forall (gr :: * -> * -> *) a b. Graph gr => gr a b -> [LEdge b]
labEdges gr a b
g ]