Implement complement for undirected graphs

src/Algebra/Graph/Undirected.hs

@@ -43,7 +43,7 @@ module Algebra.Graph.Undirected (
 
     -- * Graph transformation
     removeVertex, removeEdge, replaceVertex, mergeVertices,
-    induce, induceJust, toSymmetricRelation,
+    induce, induceJust, toSymmetricRelation, complement,
 
     -- * Miscellaneous
     consistent
@@ -56,6 +56,7 @@ import           Control.Monad                    (MonadPlus (..))
 import           Data.Coerce
 import           GHC.Generics
 import           Algebra.Graph.ToGraph            (toGraph)
+import           Data.List                        ((\\))
 
 import qualified Algebra.Graph                    as G
 
@@ -65,6 +66,7 @@ import qualified Data.IntSet                      as IntSet
 import qualified Data.Set                         as Set
 import qualified Data.Tree                        as Tree
 
+
 {-| The Undirected 'Graph' data type is an abstraction over the 'Graph' data
    type and provides the same graph construction
 primitives 'empty', 'vertex', 'overlay' and 'connect'. We define the same 'Num'
@@ -405,7 +407,7 @@ vertices = coerce1 G.vertices
 
 -- TODO: Use a faster nubBy implementation with 'Data.Set'
 -- | Construct the graph from a list of edges.
--- Complexity: /O(L^2)/ time, /O(L)/ memory and size, where /L/ is the length of the
+-- Complexity: /O(L)/ time, /O(L)/ memory and size, where /L/ is the length of the
 -- given list.
 --
 -- @
@@ -698,6 +700,24 @@ toSymmetricRelation :: Ord a => Graph a -> SR.Relation a
 toSymmetricRelation = foldg SR.empty SR.vertex SR.overlay SR.connect
 {-# INLINE toSymmetricRelation #-}
 
+-- | Complement of a graph.
+-- Complexity: /O(m^2+n)/ time, /O(m+n)/ memory where
+--
+-- @
+-- complement 'empty'           == 'empty'
+-- complement ('vertex' x)      == ('vertex' x)
+-- complement ('edge' x y)      == ('vertices' [x, y])
+-- complement ('star' x [y, z]) == ('overlay' ('vertex' x) ('edge' y z))
+-- complement . complement    == id
+-- @
+complement :: Ord a => Graph a -> Graph a
+complement g@(UG _) = overlay (vertices allVertices) (edges complementEdges)
+ where cliqueG = clique . vertexList
+       allVertices = vertexList g
+       previousEdges = edgeList g
+       loops = filter (uncurry (==)) previousEdges
+       complementEdges = loops ++ (edgeList (cliqueG g) \\ previousEdges)
+
 -- | The /path/ on a list of vertices.
 -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the
 -- given list.

test/Algebra/Graph/Test/Undirected.hs

@@ -19,6 +19,7 @@ import Algebra.Graph.Test.API (toIntAPI, undirectedGraphAPI)
 import Algebra.Graph.Test.Generic
 
 import qualified Algebra.Graph as G
+import qualified Algebra.Graph.Undirected as U
 
 tPoly :: Testsuite Graph Ord
 tPoly = ("Graph.Undirected.", undirectedGraphAPI)
@@ -27,6 +28,7 @@ t :: TestsuiteInt Graph
 t = fmap toIntAPI tPoly
 
 type G = Graph Int
+type UGI = U.Graph Int
 type AGI = G.Graph Int
 
 testUndirected :: IO ()
@@ -64,9 +66,25 @@ testUndirected = do
     test "edgeCount   . fromUndirected <= (*2) . edgeCount" $ \(x :: G) ->
           (G.edgeCount . fromUndirected) x <= ((*2) . edgeCount) x
 
+    putStrLn $ "\n============ Graph.Undirected.complement ================"
+
+    test "complement empty              == empty" $
+          complement empty              == (empty :: UGI)
+
+    test "complement (vertex 1)         == (vertex 1)" $
+          complement (vertex 1)         == (vertex 1 :: UGI)
+
+    test "complement (edge 1 2)         == (vertices [1, 2])" $
+          complement (edge 1 2)         == (vertices [1, 2] :: UGI)
+
+    test "complement (star 1 [2, 3])    == (overlay (vertex 1) (edge 2 3))" $
+          complement (star 1 [2, 3])    == (overlay (vertex 1) (edge 2 3) :: UGI)
+
+    test "complement . complement       == id" $ \(x :: UGI) ->
+         (complement . complement $ x)  == x
+
     testSymmetricBasicPrimitives t
     testSymmetricIsSubgraphOf    t
     testSymmetricGraphFamilies   t
     testSymmetricTransformations t
     testInduceJust               tPoly
-