diff --git a/src/Algebra/Graph/Undirected.hs b/src/Algebra/Graph/Undirected.hs index 2d129c23c..49cd15106 100644 --- a/src/Algebra/Graph/Undirected.hs +++ b/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,25 @@ 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(n^2*m)/ time, /O(n^2)/ memory where +-- +-- @ +-- complement 'empty' == 'empty' +-- complement ('vertex' x) == ('vertex' x) +-- complement ('edge' 1 2) == ('vertices' [1, 2]) +-- complement ('edge' 0 0) == ('edge' 0 0) +-- complement ('star' 1 [2, 3]) == ('overlay' ('vertex' 1) ('edge' 2 3)) +-- 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. diff --git a/test/Algebra/Graph/Test/Undirected.hs b/test/Algebra/Graph/Test/Undirected.hs index ebe83acc9..5cd6bab6b 100644 --- a/test/Algebra/Graph/Test/Undirected.hs +++ b/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,28 @@ 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 x) == (vertex x)" $ \(x :: Int) -> + complement (vertex x) == (vertex x :: UGI) + + test "complement (edge 1 2) == (vertices [1, 2])" $ + complement (edge 1 2) == (vertices [1, 2] :: UGI) + + test "complement (edge 0 0) == (edge 0 0)" $ + complement (edge 0 0) == edge 0 0 + + 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 -