Clarify transitive closure function

And add other related functions.

Author: ivan-m

Data/Graph/Inductive/Query/TransClos.hs

@@ -1,21 +1,40 @@
 module Data.Graph.Inductive.Query.TransClos(
-    trc
+    trc, rc, tc
 ) where
 
 import Data.Graph.Inductive.Graph
-import Data.Graph.Inductive.Query.DFS (reachable)
-
-
-getNewEdges :: (DynGraph gr) => [LNode a] -> gr a b -> [LEdge ()]
-getNewEdges vs g = map (`toLEdge` ())
-                   . concatMap (\u -> map ((,) u) (reachable u g))
-                   $ map fst vs
+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 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
+
+{-|
+Finds the transitive, reflexive 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 either i = j or there is a path from i to j in G}
+-}
 trc :: (DynGraph gr) => gr a b -> gr a ()
-trc g = insEdges (getNewEdges ln g) (insNodes ln empty)
-        where ln = labNodes g
+trc g = newEdges `insEdges` insNodes ln empty
+  where
+    ln       = labNodes g
+    newEdges = [ (u, v, ()) | (u, _) <- ln, (_, v) <- bfen [(u, u)] g ]
+
+{-|
+Finds the reflexive closure of a directed graph.
+Given a graph G=(V,E), its transitive 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 g = newEdges `insEdges` insNodes ln empty
+  where
+    ln       = labNodes g
+    newEdges = [ (u, u, ()) | (u, _) <- ln ]

test/Data/Graph/Inductive/Query/Properties.hs

@@ -26,7 +26,7 @@ import Test.Hspec      (Spec, describe, it, shouldBe, shouldMatchList,
 import Test.QuickCheck
 
 import           Control.Arrow (second)
-import           Data.List     (delete, sort, unfoldr)
+import           Data.List     (delete, sort, unfoldr, group, (\\))
 import qualified Data.Set      as S
 
 #if __GLASGOW_HASKELL__ < 710
@@ -327,18 +327,41 @@ test_sp _ cg = all test_p (map unLPath (msTree g))
 -- -----------------------------------------------------------------------------
 -- TransClos
 
-test_trc :: (ArbGraph gr, Eq (BaseGraph gr a ())) => Proxy (gr a b)
-                                                  -> UConnected (SimpleGraph gr) a ()
-                                                  -> Bool
-test_trc _ cg = gReach == trc g
+-- | The transitive, reflexive closure of a graph means that every
+-- node is a successor of itself, and also that if (a, b) is an edge,
+-- and (b, c) is an edge, then (a, c) must also be an edge.
+test_trc :: DynGraph gr => Proxy (gr a b) -> (NoMultipleEdges gr) a b -> Bool
+test_trc _ nme = all valid $ nodes gTrans
   where
-    g = connGraph cg
-
-    lns = labNodes g
-
-    gReach = (`asTypeOf` g)
-             . insEdges [(v,w,()) | (v,_) <- lns, (w,_) <- lns]
-             $ mkGraph lns []
+    g       = emap (const ()) (nmeGraph nme)
+    gTrans  = trc g
+    valid n =
+      -- For each node n, check that:
+      --   the successors for n in gTrans are a superset of the successors for n in g.
+      null (suc g n \\ suc gTrans n) &&
+      --   the successors for n in gTrans are exactly equal to the reachable nodes for n in g, plus n.
+      sort (suc gTrans n) == map head (group (sort (n:[ v | u <- suc g n, v <- reachable u g ])))
+
+-- | The transitive closure of a graph means that if (a, b) is an
+-- edge, and (b, c) is an edge, then (a, c) must also be an edge.
+test_tc :: DynGraph gr => Proxy (gr a b) -> (NoMultipleEdges gr) a b -> Bool
+test_tc _ nme = all valid $ nodes gTrans
+  where
+    g       = nmeGraph nme
+    gTrans  = tc g
+    valid n =
+      -- For each node n, check that:
+      --   the successors for n in gTrans are a superset of the successors for n in g.
+      null (suc g n \\ suc gTrans n) &&
+      --   the successors for n in gTrans are exactly equal to the reachable nodes for n in g.
+      sort (suc gTrans n) == map head (group (sort [ v | u <- suc g n, v <- reachable u g ]))
+
+-- | The reflexive closure of a graph means that all nodes are a
+-- successor of themselves.
+test_rc :: DynGraph gr => Proxy (gr a b) -> gr a b -> Bool
+test_rc _ g = and [ n `elem` suc gRefl n | n <- nodes gRefl ]
+  where
+    gRefl = rc g
 
 -- -----------------------------------------------------------------------------
 -- Utility functions

test/TestSuite.hs

@@ -117,9 +117,11 @@ queryTests = describe "Queries" $ do
   test_maxFlow
   propP "msTree"       test_msTree
   propP "sp"           test_sp
-  keepSmall $
+  keepSmall $ do
     -- Just producing the sample graph to compare against is O(|V|^2)
     propP "trc"        test_trc
+    propP "tc"         test_tc
+    propP "rc"         test_rc
   where
     propP str = prop str . ($p)