Merge pull request #130 from msakai/feature/graph-clique

Add isCliqueOf and complementGraph to ToySolver.Graph.Base

src/ToySolver/Graph/Base.hs

@@ -16,7 +16,11 @@ module ToySolver.Graph.Base
   , graphToUnorderedEdges
   , graphFromUnorderedEdges
   , graphFromUnorderedEdgesWith
+  , complementGraph
+  , complementSimpleGraph
   , isIndependentSet
+  , isIndependentSetOf
+  , isCliqueOf
   ) where
 
 import Control.Monad
@@ -51,9 +55,37 @@ graphFromUnorderedEdgesWith f n es = runSTArray $ do
     ins node2 node1 a
   return a
 
+-- | Complement of a graph
+--
+-- Note that applying it to a graph with no self-loops result in a graph with self-loops on all vertices.
+complementGraph :: EdgeLabeledGraph a -> EdgeLabeledGraph ()
+complementGraph g = array (bounds g) [(node, toAllNodes IntMap.\\ outEdges) | (node, outEdges) <- assocs g]
+  where
+    toAllNodes = IntMap.fromAscList [(node, ()) | node <- indices g]
+
+-- | Complement of a simple graph
+--
+-- It ignores self-loops in the input graph and also does not add self-loops to the output graph.
+complementSimpleGraph :: EdgeLabeledGraph a -> EdgeLabeledGraph ()
+complementSimpleGraph g = array (bounds g) [(node, IntMap.delete node toAllNodes IntMap.\\ outEdges) | (node, outEdges) <- assocs g]
+  where
+    toAllNodes = IntMap.fromAscList [(node, ()) | node <- indices g]
+
+-- | Alias of 'isIndependentSetOf'
+{-# DEPRECATED isIndependentSet "Use isIndependentSetOf instead" #-}
 isIndependentSet :: EdgeLabeledGraph a -> IntSet -> Bool
-isIndependentSet g s = null $ do
+isIndependentSet = flip isIndependentSetOf
+
+-- | An independent set of a graph is is a set of vertices such that no two vertices in the set are adjacent.
+--
+-- This function ignores self-loops in the input graph.
+isIndependentSetOf :: IntSet -> EdgeLabeledGraph a -> Bool
+isIndependentSetOf s g = null $ do
   (node1, node2, _) <- graphToUnorderedEdges g
   guard $ node1 `IntSet.member` s
   guard $ node2 `IntSet.member` s
   return ()
+
+-- | A clique of a graph is a subset of vertices such that every two distinct vertices in the clique are adjacent.
+isCliqueOf :: IntSet -> EdgeLabeledGraph a -> Bool
+isCliqueOf s g = all (\node -> IntSet.delete node s `IntSet.isSubsetOf` IntMap.keysSet (g ! node)) (IntSet.toList s)

test/Test/Converter.hs

@@ -232,7 +232,7 @@ prop_satToIS_forward =
     let r@((g,k), info) = satToIS cnf
      in counterexample (show r) $ conjoin
         [ counterexample (show m) $ counterexample (show set) $
-            not (evalCNF m cnf) || (isIndependentSet g set && IntSet.size set >= k)
+            not (evalCNF m cnf) || (set `isIndependentSetOf` g  && IntSet.size set >= k)
         | m <- allAssignments (CNF.cnfNumVars cnf)
         , let set = transformForward info m
         ]
@@ -263,7 +263,7 @@ prop_mis2MaxSAT_forward =
         [ counterexample (show set) $ counterexample (show m) $ o1 === o2
         | set <- map IntSet.fromList $ allSubsets $ range $ bounds g
         , let m = transformForward info set
-              o1 = if isIndependentSet g set
+              o1 = if set `isIndependentSetOf` g
                    then Just (transformObjValueForward info (IntSet.size set))
                    else Nothing
               o2 = evalWCNF m wcnf
@@ -280,7 +280,7 @@ prop_mis2MaxSAT_backward =
         [ counterexample (show m) $ counterexample (show set) $ o1 === o2
         | m <- allAssignments (CNF.wcnfNumVars wcnf)
         , let set = transformBackward info m
-              o1 = if isIndependentSet g set
+              o1 = if set `isIndependentSetOf` g
                    then Just (IntSet.size set)
                    else Nothing
               o2 = fmap (transformObjValueBackward info) $ evalWCNF m wcnf

test/Test/Graph.hs

@@ -0,0 +1,48 @@
+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
+module Test.Graph (graphTestGroup) where
+
+import Control.Monad
+import Data.Array
+import Data.IntSet (IntSet)
+import qualified Data.IntSet as IntSet
+import Test.Tasty
+import Test.Tasty.QuickCheck
+import Test.Tasty.TH
+
+import ToySolver.Graph.Base
+
+
+-- ------------------------------------------------------------------------
+
+arbitrarySimpleGraph :: Gen Graph
+arbitrarySimpleGraph = do
+  sized $ \n -> do
+    m <- choose (0, n*n-1)
+    fmap (graphFromUnorderedEdges n) $ replicateM m $ do
+      node1 <- choose (0, n-1)
+      node2 <- fmap (\i -> (node1 + i) `mod` n) $ choose (1, n-1)
+      return (node1, node2, ())
+
+vertexes :: EdgeLabeledGraph a -> IntSet
+vertexes = IntSet.fromAscList . uncurry enumFromTo . bounds
+
+arbitrarySubset :: IntSet -> Gen IntSet
+arbitrarySubset = fmap IntSet.fromAscList . sublistOf . IntSet.toAscList
+
+-- ------------------------------------------------------------------------
+
+prop_indepndent_set_and_clique :: Property
+prop_indepndent_set_and_clique =
+  forAll arbitrarySimpleGraph $ \g ->
+    forAll (arbitrarySubset (vertexes g)) $ \s -> do
+      counterexample (show (graphToUnorderedEdges g)) $ 
+        s `isIndependentSetOf` g === s `isCliqueOf` complementSimpleGraph g
+
+-- ------------------------------------------------------------------------
+-- Test harness
+
+graphTestGroup :: TestTree
+graphTestGroup = $(testGroupGenerator)

test/TestSuite.hs

@@ -13,6 +13,7 @@ import Test.Converter
 import Test.CNF
 import Test.Delta
 import Test.FiniteModelFinder
+import Test.Graph
 import Test.GraphShortestPath
 import Test.HittingSets
 import Test.Knapsack
@@ -49,6 +50,7 @@ main = defaultMain $ testGroup "ToySolver test suite"
   , ctTestGroup
   , deltaTestGroup
   , fmfTestGroup
+  , graphTestGroup
   , graphShortestPathTestGroup
   , hittingSetsTestGroup
   , knapsackTestGroup

toysolver.cabal

@@ -896,6 +896,7 @@ Test-suite TestSuite
     Test.Converter
     Test.Delta
     Test.FiniteModelFinder
+    Test.Graph
     Test.GraphShortestPath
     Test.HittingSets
     Test.Knapsack