module Data.Graph.Inductive.Query.TransClos(
trc, rc, tc
) where
import Data.Graph.Inductive.Graph
import Data.Graph.Inductive.Query.BFS (bfen)
tc :: (DynGraph gr) => gr a b -> gr a ()
tc g = newEdges `insEdges` insNodes ln empty
where
ln = labNodes g
newEdges = [ (u, v, ()) | (u, _) <- ln, (_, v) <- bfen (outU g u) g ]
outU gr = map toEdge . out gr
trc :: (DynGraph gr) => gr a b -> gr a ()
trc g = newEdges `insEdges` insNodes ln empty
where
ln = labNodes g
newEdges = [ (u, v, ()) | (u, _) <- ln, (_, v) <- bfen [(u, u)] g ]
rc :: (DynGraph gr) => gr a b -> gr a ()
rc g = newEdges `insEdges` insNodes ln empty
where
ln = labNodes g
newEdges = [ (u, u, ()) | (u, _) <- ln ]