From eefb552024ca71f714b6095b447527fc329b1768 Mon Sep 17 00:00:00 2001 From: Adithya Kumar Date: Sun, 9 Jun 2019 23:02:10 +0000 Subject: [PATCH] Add a draft implementation of Acyclic.AdjacencyMap (#203) See #154. --- .gitignore | 3 + algebraic-graphs.cabal | 2 + src/Algebra/Graph/Acyclic/AdjacencyMap.hs | 506 ++++++++++++++++++ .../Graph/Test/Acyclic/AdjacencyMap.hs | 365 +++++++++++++ test/Algebra/Graph/Test/Arbitrary.hs | 15 + test/Main.hs | 2 + 6 files changed, 893 insertions(+) create mode 100644 src/Algebra/Graph/Acyclic/AdjacencyMap.hs create mode 100644 test/Algebra/Graph/Test/Acyclic/AdjacencyMap.hs diff --git a/.gitignore b/.gitignore index 1d103f60b..399466a8b 100644 --- a/.gitignore +++ b/.gitignore @@ -20,3 +20,6 @@ cabal.sandbox.config cabal.project.local ghcid.txt .vscode/ +*.swp +*.swo +.log diff --git a/algebraic-graphs.cabal b/algebraic-graphs.cabal index cf5179cd7..85815eba0 100644 --- a/algebraic-graphs.cabal +++ b/algebraic-graphs.cabal @@ -66,6 +66,7 @@ source-repository head library hs-source-dirs: src exposed-modules: Algebra.Graph, + Algebra.Graph.Acyclic.AdjacencyMap, Algebra.Graph.AdjacencyIntMap, Algebra.Graph.AdjacencyIntMap.Algorithm, Algebra.Graph.AdjacencyMap, @@ -122,6 +123,7 @@ test-suite test-alga main-is: Main.hs other-modules: Algebra.Graph.Test, Algebra.Graph.Test.API, + Algebra.Graph.Test.Acyclic.AdjacencyMap, Algebra.Graph.Test.AdjacencyIntMap, Algebra.Graph.Test.AdjacencyMap, Algebra.Graph.Test.Arbitrary, diff --git a/src/Algebra/Graph/Acyclic/AdjacencyMap.hs b/src/Algebra/Graph/Acyclic/AdjacencyMap.hs new file mode 100644 index 000000000..84a959a92 --- /dev/null +++ b/src/Algebra/Graph/Acyclic/AdjacencyMap.hs @@ -0,0 +1,506 @@ +----------------------------------------------------------------- +-- | +-- Module : Algebra.Graph.Acyclic.AdjacencyMap +-- License : MIT (see the file LICENSE) +-- Stability : experimental +-- +-- __Alga__ is a library for algebraic construction and manipulation +-- of graphs in Haskell. See +-- for the motivation behind the library, the underlying theory, +-- and implementation details. +-- +-- This module defines the 'AdjacencyMap' data type and for acyclic +-- graphs, as well as associated operations and algorithms. +----------------------------------------------------------------- +module Algebra.Graph.Acyclic.AdjacencyMap ( + -- * Data structure + AdjacencyMap, fromAcyclic, + + -- * Basic graph construction primitives + empty, vertex, vertices, disjointOverlay, disjointConnect, + + -- * Graph properties + isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, + edgeList, adjacencyList, vertexSet, edgeSet, + + -- * Graph transformation + removeVertex, removeEdge, transpose, induce, + + -- * Graph composition + box, + + -- * Relational operations + transitiveClosure, + + -- * Functions on acyclic graphs + topSort, + + -- * Acyclic graph construction methods + scc, fromGraph, PartialOrder, toAcyclic, + + -- * Miscellaneous + consistent, + ) where + +import Algebra.Graph (Graph, foldg) +import qualified Algebra.Graph.AdjacencyMap as AM +import qualified Algebra.Graph.AdjacencyMap.Algorithm as AM +import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NonEmpty +import qualified Data.Graph.Typed as Typed +import Data.Set (Set) +import Data.Coerce (coerce) + +{-| The 'AdjacencyMap' data type represents an acyclic graph. +All the methods provided in this module are safe and cannot be used +to produce a cyclic graph. + +We define a 'Num' instance as a convenient notation for working +with graphs: + + > vertexList 0 == [0] + > edgeList 0 == [] + > vertexList (1 + 2) == [1,2] + > edgeList (1 + 2) == [] + > vertexList (1 * 2) == [1,2] + > edgeList (1 * 2) == [(1,2)] + > vertexList (1 + 2 * 3) == [1,2,3] + > edgeList (1 + 2 * 3) == [(2,3)] + > vertexList (1 * 2 + 3) == [1,2,3] + > edgeList (1 * 2 + 3) == [(1,2)] + +In the `Num` operations, we only keep edges that align with the order +of integers. Ie. Edges can only be formed from vertex numbered /a/ +to a vertex numbered /b/ if and only if /a/ \< /b/: + + > edgeList (1 * 2) == [(1,2)] + > edgeList (2 * 1) == [] + > (2 * 1) == (2 + 1) + +__Note:__ the 'Num' instance does not satisfy several "customary laws" +of 'Num', which dictate that 'fromInteger' @0@ and 'fromInteger' @1@ +should act as additive and multiplicative identities, and 'negate' as +additive inverse. Nevertheless, overloading 'fromInteger', '+' and '*' +is very convenient when working with algebraic graphs; we hope that +in future Haskell's Prelude will provide a more fine-grained class +hierarchy for algebraic structures, which we would be able to utilise +without violating any laws. + +The 'Show' instance is defined using toAcyclic and the consutruction +primitives of 'AM.AdjacencyMap': + +@ +show empty == "fromMaybe empty . toAcyclic $ empty" +show 1 == "fromMaybe empty . toAcyclic $ vertex 1" +show (1 + 2) == "fromMaybe empty . toAcyclic $ vertices [1,2]" +show (1 * 2) == "fromMaybe empty . toAcyclic $ edge 1 2" +show (1 * 2 * 3) == "fromMaybe empty . toAcyclic $ edges [(1,2),(1,3),(2,3)]" +show (1 * 2 + 3) == "fromMaybe empty . toAcyclic $ overlay (vertex 3) (edge 1 2)" +@ +-} +-- TODO: Improve the Show instance. +newtype AdjacencyMap a = AAM { + -- | Extract the underlying acyclic "Algebra.Graph.AdjacencyMap". + -- Complexity: /O(1)/ time and memory. + -- + -- @ + -- fromAcyclic (1 * 2 + 3 * 4) == AdjacencyMap.'AM.edges' [(1,2), (3,4)] + -- 'AM.vertexCount' . fromAcyclic == 'vertexCount' + -- 'AM.edgeCount' . fromAcyclic == 'edgeCount' + -- @ + fromAcyclic :: AM.AdjacencyMap a + } deriving (Eq, Ord) + +instance (Ord a, Show a) => Show (AdjacencyMap a) where + show x = "fromMaybe empty . toAcyclic $ " ++ show (fromAcyclic x) + +-- | __Note:__ this does not satisfy the usual ring laws; see +-- 'AdjacencyMap' for more details. +instance (Ord a, Num a) => Num (AdjacencyMap a) where + fromInteger = AAM . fromInteger + (AAM x) + (AAM y) = AAM $ induceEAM (uncurry (<)) (x + y) + (AAM x) * (AAM y) = AAM $ induceEAM (uncurry (<)) (x * y) + signum = const empty + abs = id + negate = id + +-- | Check if the internal graph representation is consistent, +-- i.e. that all edges refer to existing vertices and the graph +-- is acyclic. It should be impossible to create an inconsistent +-- adjacency map. +-- +-- @ +-- consistent 'empty' == True +-- consistent ('vertex' x) == True +-- consistent ('disjointOverlay' x y) == True +-- consistent ('disjointConnect' x y) == True +-- consistent ('vertices' x) == True +-- consistent ('box' x y) == True +-- consistent ('transitiveClosure' x) == True +-- consistent ('transpose' x) == True +-- consistent ('fromGraph' (<) x) == True +-- consistent ('fromGraph' (>) x) == True +-- consistent (1 + 2) == True +-- consistent (1 * 2 + 2 * 3) == True +-- @ +consistent :: Ord a => AdjacencyMap a -> Bool +consistent (AAM m) = AM.consistent m && AM.isAcyclic m + +-- | Construct the /empty acyclic graph/. +-- Complexity: /O(1)/ time and memory. +-- +-- @ +-- isEmpty 'empty' == True +-- isEmpty ('disjointOverlay' 'empty' 'empty') == True +-- isEmpty ('vertex' x) == False +-- isEmpty ('removeVertex' x $ 'vertex' x) == True +-- isEmpty ('removeEdge' 1 2 $ 1 * 2) == False +-- @ +empty :: AdjacencyMap a +empty = coerce AM.empty + +-- | Construct the graph comprising /a single isolated vertex/. +-- Complexity: /O(1)/ time and memory. +-- +-- @ +-- 'isEmpty' (vertex x) == False +-- 'hasVertex' x (vertex x) == True +-- 'vertexCount' (vertex x) == 1 +-- 'edgeCount' (vertex x) == 0 +-- @ +vertex :: a -> AdjacencyMap a +vertex = coerce AM.vertex + +-- | Construct the graph comprising a given list of isolated vertices. +-- Complexity: /O(L * log(L))/ time and /O(L)/ memory, where /L/ is +-- the length of the given list. +-- +-- @ +-- vertices [] == 'empty' +-- vertices [x] == 'vertex' x +-- 'hasVertex' x . vertices == 'elem' x +-- 'vertexCount' . vertices == 'length' . 'Data.List.nub' +-- 'vertexSet' . vertices == Set.'Set.fromList' +-- @ +vertices :: (Ord a) => [a] -> AdjacencyMap a +vertices = coerce AM.vertices + +-- | Perform a disjoint overlay of two different acyclic graphs. +-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. +-- +-- @ +-- 'isEmpty' (disjointOverlay x y) == 'isEmpty' x && 'isEmpty' y +-- 'hasVertex' ('Left' z) (disjointOverlay x y) == 'hasVertex' z x +-- 'hasVertex' ('Right' z) (disjointOverlay x y) == 'hasVertex' z y +-- 'vertexCount' (disjointOverlay x y) >= 'vertexCount' x +-- 'vertexCount' (disjointOverlay x y) == 'vertexCount' x + 'vertexCount' y +-- 'edgeCount' (disjointOverlay x y) >= 'edgeCount' x +-- 'edgeCount' (disjointOverlay x y) == 'edgeCount' x + 'edgeCount' y +-- 'vertexCount' (disjointOverlay 1 2) == 2 +-- 'edgeCount' (disjointOverlay 1 2) == 0 +-- @ +disjointOverlay :: + (Ord a, Ord b) + => AdjacencyMap a + -> AdjacencyMap b + -> AdjacencyMap (Either a b) +disjointOverlay (AAM a) (AAM b) = AAM (AM.overlay (AM.gmap Left a) (AM.gmap Right b)) + +-- | Perform a disjoint connect of two different acyclic graphs. +-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. +-- +-- @ +-- 'isEmpty' (disjointConnect x y) == 'isEmpty' x && 'isEmpty' y +-- 'hasVertex' ('Left' z) (disjointConnect x y) == 'hasVertex' z x +-- 'hasVertex' ('Right' z) (disjointConnect x y) == 'hasVertex' z y +-- 'vertexCount' (disjointConnect x y) >= 'vertexCount' x +-- 'vertexCount' (disjointConnect x y) == 'vertexCount' x + 'vertexCount' y +-- 'edgeCount' (disjointConnect x y) >= 'edgeCount' x +-- 'edgeCount' (disjointConnect x y) >= 'edgeCount' y +-- 'edgeCount' (disjointConnect x y) >= 'vertexCount' x * 'vertexCount' y +-- 'edgeCount' (disjointConnect x y) == 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y +-- 'vertexCount' (disjointConnect 1 2) == 2 +-- 'edgeCount' (disjointConnect 1 2) == 1 +-- @ +disjointConnect :: + (Ord a, Ord b) + => AdjacencyMap a + -> AdjacencyMap b + -> AdjacencyMap (Either a b) +disjointConnect (AAM a) (AAM b) = AAM (AM.connect (AM.gmap Left a) (AM.gmap Right b)) + +-- | Compute the /transitive closure/ of a graph. +-- Complexity: /O(n * m * log(n)^2)/ time. +-- +-- @ +-- transitiveClosure 'empty' == 'empty' +-- transitiveClosure ('vertex' x) == 'vertex' x +-- transitiveClosure (1 * 2 + 2 * 3) == 1 * 2 + 2 * 3 + 1 * 3 +-- transitiveClosure . transitiveClosure == transitiveClosure +-- @ +transitiveClosure :: Ord a => AdjacencyMap a -> AdjacencyMap a +transitiveClosure = coerce AM.transitiveClosure + +-- | Compute the /condensation/ of a graph, where each vertex +-- corresponds to a /strongly-connected component/ of the original +-- graph. Note that component graphs are non-empty, and are therefore +-- of type "Algebra.Graph.NonEmpty.AdjacencyMap". +-- +-- @ +-- scc AdjacencyMap.'AM.empty' == 'empty' +-- scc (AdjacencyMap.'AM.vertex' x) == 'vertex' (NonEmpty.'NonEmpty.vertex' x) +-- scc (AdjacencyMap.'AM.edge' 1 1) == 'vertex' (NonEmpty.'NonEmpty.edge' 1 1) +-- 'vertexList' (scc (AdjacencyMap.'AM.edge' 1 2)) == [NonEmpty.'NonEmpty.vertex' 1,NonEmpty.'NonEmpty.vertex' 2] +-- 'edgeList' (scc (AdjacencyMap.'AM.edge' 1 2)) == [(NonEmpty.'NonEmpty.vertex' 1,NonEmpty.'NonEmpty.vertex' 2)] +-- scc (AdjacencyMap.'AM.circuit' (1:xs)) == vertex (NonEmpty.'NonEmpty.circuit1' (1 :| xs)) +-- 'vertexList' (scc (3 * 1 * 4 * 1 * 5)) == [NonEmpty.'NonEmpty.vertex' 3,NonEmpty.'NonEmpty.vertex' 5,NonEmpty.'NonEmpty.clique1' [1,4,1]] +-- 'edgeList' (scc (3 * 1 * 4 * 1 * 5)) == [ (NonEmpty.'NonEmpty.vertex' 3,NonEmpty.'NonEmpty.vertex' 5) +-- , (NonEmpty.'NonEmpty.vertex' 3,NonEmpty.'NonEmpty.clique1' [1,4,1]) +-- , (NonEmpty.'NonEmpty.clique1' [1,4,1],NonEmpty.'NonEmpty.vertex' 5)] +-- @ +scc :: (Ord a) => AM.AdjacencyMap a -> AdjacencyMap (NonEmpty.AdjacencyMap a) +scc = coerce AM.scc + +-- | Compute the /topological sort/ of a graph. +-- +-- @ +-- topSort (1) == [1] +-- topSort (1 * 2 * 3) == [1,2,3] +-- @ +topSort :: (Ord a) => AdjacencyMap a -> [a] +topSort (AAM am) = Typed.topSort (Typed.fromAdjacencyMap am) + +-- | Compute the /Cartesian product/ of graphs. +-- Complexity: /O(s1 * s2)/ time, memory and size, where /s1/ and /s2/ +-- are the sizes of the given graphs. +-- +-- @ +-- 'edgeList' (box (1 * 2) (3 * 4)) == [ ((1,3),(1,4)) +-- , ((1,3),(2,3)) +-- , ((1,4),(2,4)) +-- , ((2,3),(2,4))] +-- 'edgeList' (box (1 + 2) (3 + 4)) == [] +-- 'vertexList' (box (1 + 2) (3 + 4)) == [(1,3),(1,4),(2,3),(2,4)] +-- @ +box :: (Ord a, Ord b) => AdjacencyMap a -> AdjacencyMap b -> AdjacencyMap (a, b) +box = coerce AM.box + +-- | Remove a vertex from a given acyclic graph. +-- Complexity: /O(n*log(n))/ time. +-- +-- @ +-- removeVertex x ('vertex' x) == 'empty' +-- removeVertex 1 ('vertex' 2) == 'vertex' 2 +-- removeVertex 1 (1 * 2) == 'vertex' 2 +-- removeVertex x . removeVertex x == removeVertex x +-- @ +removeVertex :: Ord a => a -> AdjacencyMap a -> AdjacencyMap a +removeVertex = coerce AM.removeVertex + +-- | Remove an edge from a given acyclic graph. +-- Complexity: /O(log(n))/ time. +-- +-- @ +-- removeEdge 1 2 (1 * 2) == (1 + 2) +-- removeEdge x y . removeEdge x y == removeEdge x y +-- removeEdge x y . 'removeVertex' x == 'removeVertex' x +-- removeEdge 1 2 (1 * 2 + 3 * 4) == 1 + 2 + 3 * 4 +-- @ +removeEdge :: Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a +removeEdge = coerce AM.removeEdge + +-- | This is a signature for a __Strict Partial Order__. +-- A strict partial order is a binary relation __/R/__ that has three +-- axioms, namely, irreflexive, transitive and asymmetric. +-- +-- > a 'R' a == False (Irreflexive) +-- > a 'R' b and b 'R' c => a 'R' c (Transitive) +-- Some examples of a Strict Partial Order are +-- __\<__ and __\>__. +type PartialOrder a = a -> a -> Bool + +-- | Constructs an acyclic graph from any graph based on +-- a strict partial order to produce an acyclic graph. +-- The partial order defines the valid set of edges. +-- +-- If the partial order is \< then for any two +-- vertices x and y (x \> y), the only possible edge is (y, x). +-- This will guarantee the production of an acyclic graph since +-- no back edges are possible. +-- +-- For example, +-- /fromGraph (\<) (1 \* 2 + 2 \* 1) == 1 \* 2/ because +-- /1 \< 2 == True/ and hence the edge is allowed. +-- /2 \< 1 == False/ and hence the edge is filtered out. +-- +-- @ +-- fromGraph (<) (2 * 1) == 1 + 2 +-- fromGraph (<) (1 * 2) == 1 * 2 +-- fromGraph (<) (1 * 2 + 2 * 1) == 1 * 2 +-- @ +fromGraph :: Ord a => PartialOrder a -> Graph a -> AdjacencyMap a +fromGraph o = + AAM . induceEAM (uncurry o) . foldg AM.empty AM.vertex AM.overlay AM.connect + +-- | The sorted list of edges of a graph. +-- Complexity: /O(n + m)/ time and /O(m)/ memory. +-- +-- @ +-- edgeList 'empty' == [] +-- edgeList ('vertex' x) == [] +-- edgeList (1 * 2) == [(1,2)] +-- edgeList (2 * 1) == [] +-- @ +edgeList :: AdjacencyMap a -> [(a, a)] +edgeList = coerce AM.edgeList + +-- | The sorted list of vertices of a given graph. +-- Complexity: /O(n)/ time and memory. +-- +-- @ +-- vertexList 'empty' == [] +-- vertexList ('vertex' x) == [x] +-- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort' +-- @ +vertexList :: AdjacencyMap a -> [a] +vertexList = coerce AM.vertexList + +-- | The number of vertices in a graph. +-- Complexity: /O(1)/ time. +-- +-- @ +-- vertexCount 'empty' == 0 +-- vertexCount ('vertex' x) == 1 +-- vertexCount == 'length' . 'vertexList' +-- vertexCount x \< vertexCount y ==> x \< y +-- @ +vertexCount :: AdjacencyMap a -> Int +vertexCount = coerce AM.vertexCount + +-- | The number of edges in a graph. +-- Complexity: /O(n)/ time. +-- +-- @ +-- edgeCount 'empty' == 0 +-- edgeCount ('vertex' x) == 0 +-- edgeCount (1 * 2) == 1 +-- edgeCount == 'length' . 'edgeList' +-- @ +edgeCount :: AdjacencyMap a -> Int +edgeCount = coerce AM.edgeCount + +-- | The set of vertices of a given graph. +-- Complexity: /O(n)/ time and memory. +-- +-- @ +-- vertexSet 'empty' == Set.'Set.empty' +-- vertexSet . 'vertex' == Set.'Set.singleton' +-- vertexSet . 'vertices' == Set.'Set.fromList' +-- @ +vertexSet :: AdjacencyMap a -> Set a +vertexSet = coerce AM.vertexSet + +-- | The set of edges of a given graph. +-- Complexity: /O((n + m) * log(m))/ time and /O(m)/ memory. +-- +-- @ +-- edgeSet 'empty' == Set.'Set.empty' +-- edgeSet ('vertex' x) == Set.'Set.empty' +-- edgeSet (1 * 2) == Set.'Set.singleton' (1,2) +-- @ +edgeSet :: Eq a => AdjacencyMap a -> Set (a, a) +edgeSet = coerce AM.edgeSet + +-- | The sorted /adjacency list/ of a graph. +-- Complexity: /O(n + m)/ time and /O(m)/ memory. +-- +-- @ +-- adjacencyList 'empty' == [] +-- adjacencyList ('vertex' x) == [(x, [])] +-- adjacencyList (1 * 2) == [(1, [2]), (2, [])] +-- @ +adjacencyList :: AdjacencyMap a -> [(a, [a])] +adjacencyList = coerce AM.adjacencyList + +-- | Check if a graph is empty. +-- Complexity: /O(1)/ time. +-- +-- @ +-- isEmpty 'empty' == True +-- isEmpty ('vertex' x) == False +-- isEmpty ('removeVertex' x $ 'vertex' x) == True +-- isEmpty ('removeEdge' 1 2 $ 1 * 2) == False +-- @ +isEmpty :: AdjacencyMap a -> Bool +isEmpty = coerce AM.isEmpty + +-- | Check if a graph contains a given vertex. +-- Complexity: /O(log(n))/ time. +-- +-- @ +-- hasVertex x 'empty' == False +-- hasVertex x ('vertex' x) == True +-- hasVertex 1 ('vertex' 2) == False +-- hasVertex x . 'removeVertex' x == 'const' False +-- @ +hasVertex :: Ord a => a -> AdjacencyMap a -> Bool +hasVertex = coerce AM.hasVertex + +-- | Check if a graph contains a given edge. +-- Complexity: /O(log(n))/ time. +-- +-- @ +-- hasEdge x y 'empty' == False +-- hasEdge x y ('vertex' z) == False +-- hasEdge 1 2 (1 * 2) == True +-- hasEdge x y . 'removeEdge' x y == 'const' False +-- hasEdge x y == 'elem' (x,y) . 'edgeList' +-- @ +hasEdge :: Ord a => a -> a -> AdjacencyMap a -> Bool +hasEdge = coerce AM.hasEdge + +-- | Transpose a given acyclic graph. +-- Complexity: /O(m * log(n))/ time, /O(n + m)/ memory. +-- +-- @ +-- transpose 'empty' == 'empty' +-- transpose ('vertex' x) == 'vertex' x +-- transpose . transpose == id +-- 'edgeList' . transpose == 'Data.List.sort' . 'map' 'Data.Tuple.swap' . 'edgeList' +-- @ +transpose :: Ord a => AdjacencyMap a -> AdjacencyMap a +transpose = coerce AM.transpose + +-- | Construct the /induced subgraph/ of a given graph by removing the +-- vertices that do not satisfy a given predicate. +-- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to +-- be evaluated. +-- +-- @ +-- induce ('const' True ) x == x +-- induce ('const' False) x == 'empty' +-- induce (/= x) == 'removeVertex' x +-- induce p . induce q == induce (\x -> p x && q x) +-- @ +induce :: (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a +induce = coerce AM.induce + +-- | If possible, construct a graph of type Acyclic.AdjacencyMap +-- from a graph of type AdjacencyMap. If the input graph is contains +-- cycles then return Nothing. +-- +-- @ +-- toAcyclic (AdjacencyMap.'AM.path' [1, 2, 1]) == Nothing +-- toAcyclic (AdjacencyMap.'AM.path' [1, 2, 3]) == Just (1 * 2 + 2 * 3) +-- @ +toAcyclic :: (Ord a) => AM.AdjacencyMap a -> Maybe (AdjacencyMap a) +toAcyclic x = if AM.isAcyclic x then Just (AAM x) else Nothing + +-- Helper function, not to be exported. +-- Induce a subgraph from AM.AdjacencyList removing edges not +-- following the given predicate. +induceEAM :: + (Ord a) => ((a, a) -> Bool) -> AM.AdjacencyMap a -> AM.AdjacencyMap a +induceEAM p m = es m `AM.overlay` vs m + where + es = AM.edges . filter p . AM.edgeList + vs = AM.vertices . AM.vertexList diff --git a/test/Algebra/Graph/Test/Acyclic/AdjacencyMap.hs b/test/Algebra/Graph/Test/Acyclic/AdjacencyMap.hs new file mode 100644 index 000000000..25811ecc0 --- /dev/null +++ b/test/Algebra/Graph/Test/Acyclic/AdjacencyMap.hs @@ -0,0 +1,365 @@ +{-# LANGUAGE ViewPatterns #-} +------------------------------------------------------------- +-- | +-- Module : Algebra.Graph.Test.Acyclic.AdjacencyMap +-- Stability : experimental +-- +-- Testsuite for "Algebra.Graph.Acyclic.AdjacencyMap". +------------------------------------------------------------- + +module Algebra.Graph.Test.Acyclic.AdjacencyMap ( + testAcyclicAdjacencyMap + ) where + +import Algebra.Graph.Acyclic.AdjacencyMap +import Algebra.Graph.Test +import Data.List.NonEmpty hiding (transpose) + +import qualified Algebra.Graph.AdjacencyMap as AM +import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NonEmpty +import qualified Data.List as List +import qualified Data.Set as Set +import qualified Data.Tuple as Tuple + +type AAI = AdjacencyMap Int +type AAE = AdjacencyMap (Either Int Int) +type AAT = AdjacencyMap (Int, Int) +type AI = AM.AdjacencyMap Int + +-- TODO: Switch to using generic tests. +testAcyclicAdjacencyMap :: IO () +testAcyclicAdjacencyMap = do + + putStrLn "\n=====AcyclicAdjacencyMap Show=====" + + test "show empty == \"fromMaybe empty . toAcyclic $ empty\"" $ + show (empty :: AAI) == "fromMaybe empty . toAcyclic $ empty" + test "show 1 == \"fromMaybe empty . toAcyclic $ vertex 1\"" $ + show (1 :: AAI) == "fromMaybe empty . toAcyclic $ vertex 1" + test "show (1 + 2) == \"fromMaybe empty . toAcyclic $ vertices [1,2]\"" $ + show (1 + 2 :: AAI) == "fromMaybe empty . toAcyclic $ vertices [1,2]" + test "show (1 * 2) == \"fromMaybe empty . toAcyclic $ edge 1 2\"" $ + show (1 * 2 :: AAI) == "fromMaybe empty . toAcyclic $ edge 1 2" + test "show (1 * 2 * 3) == \"fromMaybe empty . toAcyclic $ edges [(1,2),(1,3),(2,3)]\"" $ + show (1 * 2 * 3 :: AAI) == "fromMaybe empty . toAcyclic $ edges [(1,2),(1,3),(2,3)]" + test "show (1 * 2 + 3) == \"fromMaybe empty . toAcyclic $ overlay (vertex 3) (edge 1 2)\"" $ + show (1 * 2 + 3 :: AAI) == "fromMaybe empty . toAcyclic $ overlay (vertex 3) (edge 1 2)" + + putStrLn "\n=====AcyclicAdjacencyMap toAcyclic=====" + + test "toAcyclic (AdjacencyMap.'AM.path' [1, 2, 1]) == Nothing" $ + toAcyclic (AM.path [1, 2, 1] :: AI) == Nothing + test "toAcyclic (AdjacencyMap.'AM.path' [1, 2, 3]) == Just (1 * 2 + 2 * 3)" $ + toAcyclic (AM.path [1, 2, 3] :: AI) == Just (1 * 2 + 2 * 3) + + putStrLn "\n=====AcyclicAdjacencyMap fromAcyclic=====" + + test "fromAcyclic (1 * 2 + 3 * 4) == AM.edges [(1,2), (3,4)]" $ + fromAcyclic (1 * 2 + 3 * 4 :: AAI) == AM.edges [(1,2), (3,4)] + test "AM.vertexCount . fromAcyclic == vertexCount" $ \x -> + (AM.vertexCount . fromAcyclic $ (x :: AAI)) == vertexCount x + test "AM.edgeCount . fromAcyclic == edgeCount" $ \x -> + (AM.edgeCount . fromAcyclic $ (x :: AAI)) == edgeCount x + + putStrLn "\n=====AcyclicAdjacencyMap consistency=====" + + test "arbitraryAcyclicAdjacencyMap" $ \x -> consistent (x :: AAI) + test "empty" $ consistent (empty :: AAI) + test "vertex" $ \x -> consistent (vertex x :: AAI) + test "disjointOverlay" $ \x y -> consistent (disjointOverlay x y :: AAE) + test "disjointConnect" $ \x y -> consistent (disjointConnect x y :: AAE) + test "vertices" $ \x -> consistent (vertices x :: AAI) + test "box" $ \x y -> consistent (box x y :: AAT) + test "transitiveClosure" $ \x -> consistent (transitiveClosure x :: AAI) + test "transpose" $ \x -> consistent (transpose x :: AAI) + test "fromGraph (<)" $ \x -> consistent (fromGraph (<) x :: AAI) + test "fromGraph (>)" $ \x -> consistent (fromGraph (>) x :: AAI) + + test "consistent (1 + 2) == True" $ + consistent (1 + 2 :: AAI) == True + test "consistent (1 * 2 + 2 * 3) == True" $ + consistent (1 * 2 + 2 * 3 :: AAI) == True + + putStrLn "\n=====AcyclicAdjacencyMap Num instance=====" + test "edgeList 0 == []" $ + edgeList (0 :: AAI) == [] + test "vertexList 0 == [0]" $ + vertexList (0 :: AAI) == [0] + test "edgeList (1 + 2) == []" $ + edgeList (1 + 2 :: AAI) == [] + test "vertexList (1 + 2) == [1,2]" $ + vertexList (1 + 2 :: AAI) == [1,2] + test "edgeList (1 * 2) == [(1,2)]" $ + edgeList (1 * 2 :: AAI) == [(1,2)] + test "vertexList (1 * 2) == [1,2]" $ + vertexList (1 * 2 :: AAI) == [1,2] + test "edgeList (1 + 2 * 3) == [(2,3)]" $ + edgeList (1 + 2 * 3 :: AAI) == [(2,3)] + test "vertexList (1 + 2 * 3) == [1,2,3]" $ + vertexList (1 + 2 * 3 :: AAI) == [1,2,3] + test "edgeList (1 * 2 + 3) == [(1,2)]" $ + edgeList (1 * 2 + 3 :: AAI) == [(1,2)] + test "vertexList (1 * 2 + 3) == [1,2,3]" $ + vertexList (1 * 2 + 3 :: AAI) == [1,2,3] + + putStrLn "\n=====AcyclicAdjacencyMap construction primitives=====" + + test "isEmpty 'empty' == True" $ + isEmpty (empty :: AAI) == True + test "isEmpty ('disjointOverlay' 'empty' 'empty') == True" $ + isEmpty (disjointOverlay (empty :: AAI) (empty :: AAI)) == True + test "isEmpty ('vertex' x) == False" $ \x -> + isEmpty (vertex x :: AAI) == False + test "isEmpty ('removeVertex' x $ 'vertex' x) == True" $ \x -> + isEmpty (removeVertex x $ vertex x :: AAI) == True + test "isEmpty ('removeEdge' 1 2 $ 1 * 2) == False" $ + isEmpty (removeEdge 1 2 $ 1 * 2 :: AAI) == False + + test "'isEmpty' (vertex x) == False" $ \x -> + isEmpty (vertex x :: AAI) == False + test "'hasVertex' x (vertex x) == True" $ \x -> + hasVertex x (vertex x :: AAI) == True + test "'vertexCount' (vertex x) == 1" $ \x -> + vertexCount (vertex x :: AAI) == 1 + test "'edgeCount' (vertex x) == 0" $ \x -> + edgeCount (vertex x :: AAI) == 0 + + test "vertices [] == 'empty'" $ + vertices [] == (empty :: AAI) + test "vertices [x] == 'vertex' x" $ \x -> + vertices [x] == (vertex x :: AAI) + test "'hasVertex' x . vertices == 'elem' x" $ \x y -> + (hasVertex x (vertices y :: AAI)) == elem x y + test "'vertexCount' . vertices == 'length' . 'Data.List.nub'" $ \x -> + (vertexCount (vertices x :: AAI)) == (List.length . List.nub $ x) + test "'vertexSet' . vertices == Set.'Set.fromList'" $ \x -> + (vertexSet (vertices x :: AAI)) == Set.fromList x + + test "'isEmpty' (disjointOverlay x y) == 'isEmpty' x && 'isEmpty' y" $ \x y -> + isEmpty (disjointOverlay x y :: AAE) == (isEmpty x && isEmpty y) + test "'hasVertex' (Left z) (disjointOverlay x y) == 'hasVertex' z x" $ \x y z -> + hasVertex (Left z) (disjointOverlay x y :: AAE) == hasVertex z x + test "'hasVertex' (Right z) (disjointOverlay x y) == 'hasVertex' z y" $ \x y z -> + hasVertex (Right z) (disjointOverlay x y :: AAE) == hasVertex z y + test "'vertexCount' (disjointOverlay x y) >= 'vertexCount' x" $ \x y -> + vertexCount (disjointOverlay x y :: AAE) >= vertexCount x + test "'vertexCount' (disjointOverlay x y) == 'vertexCount' x + 'vertexCount' y" $ \x y -> + vertexCount (disjointOverlay x y :: AAE) == vertexCount x + vertexCount y + test "'edgeCount' (disjointOverlay x y) >= 'edgeCount' x" $ \x y -> + edgeCount (disjointOverlay x y :: AAE) >= edgeCount x + test "'edgeCount' (disjointOverlay x y) == 'edgeCount' x + 'edgeCount' y" $ \x y -> + edgeCount (disjointOverlay x y :: AAE) == edgeCount x + edgeCount y + test "'vertexCount' (disjointOverlay 1 2) == 2" $ + vertexCount (disjointOverlay 1 2 :: AAE) == 2 + test "'edgeCount' (disjointOverlay 1 2) == 0" $ + edgeCount (disjointOverlay 1 2 :: AAE) == 0 + + test "'isEmpty' (disjointConnect x y) == 'isEmpty' x && 'isEmpty' y" $ \x y -> + isEmpty (disjointConnect x y :: AAE) == (isEmpty x && isEmpty y) + test "'hasVertex' (Left z) (disjointConnect x y) == 'hasVertex' z x" $ \x y z -> + hasVertex (Left z) (disjointConnect x y :: AAE) == hasVertex z x + test "'hasVertex' (Right z) (disjointConnect x y) == 'hasVertex' z y" $ \x y z -> + hasVertex (Right z) (disjointConnect x y :: AAE) == hasVertex z y + test "'vertexCount' (disjointConnect x y) >= 'vertexCount' x" $ \x y -> + vertexCount (disjointConnect x y :: AAE) >= vertexCount x + test "'vertexCount' (disjointConnect x y) == 'vertexCount' x + 'vertexCount' y" $ \x y -> + vertexCount (disjointConnect x y :: AAE) == vertexCount x + vertexCount y + test "'edgeCount' (disjointConnect x y) >= 'edgeCount' x" $ \x y -> + edgeCount (disjointConnect x y :: AAE) >= edgeCount x + test "'edgeCount' (disjointConnect x y) >= 'edgeCount' y" $ \x y -> + edgeCount (disjointConnect x y :: AAE) >= edgeCount y + test "'edgeCount' (disjointConnect x y) >= 'vertexCount' x * 'vertexCount' y" $ \x y -> + edgeCount (disjointConnect x y :: AAE) >= vertexCount x * vertexCount y + test "'edgeCount' (disjointConnect x y) == 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y" $ \x y -> + edgeCount (disjointConnect x y :: AAE) == vertexCount x * vertexCount y + edgeCount x + edgeCount y + test "'vertexCount' (disjointConnect 1 2) == 2" $ + vertexCount (disjointConnect 1 2 :: AAE) == 2 + test "'edgeCount' (disjointConnect 1 2) == 1" $ + edgeCount (disjointConnect 1 2 :: AAE) == 1 + + putStrLn "\n=====AcyclicAdjacencyMap transitiveClosure=====" + + test "transitiveClosure empty == empty" $ + transitiveClosure (empty :: AAI) == empty + test "transitiveClosure (vertex x) == vertex x" $ \x -> + transitiveClosure (vertex x :: AAI) == vertex x + test "transitiveClosure (1 * 2 + 2 * 3) == 1 * 2 + 2 * 3 + 1 * 3" $ + transitiveClosure (1 * 2 + 2 * 3 :: AAI) == 1 * 2 + 2 * 3 + 1 * 3 + test "transitiveClosure . transitiveClosure == transitiveClosure" $ \x -> + (transitiveClosure . transitiveClosure $ x :: AAI) == transitiveClosure x + + putStrLn "\n=====AcyclicAdjacencyMap box=====" + + test "edgeList (box (1 * 2) (3 * 4)) == [((1,3),(1,4)),((1,3),(2,3)),((1,4),(2,4)),((2,3),(2,4))]" $ + edgeList (box (1 * 2 :: AAI) (3 * 4 :: AAI)) == [((1,3),(1,4)),((1,3),(2,3)),((1,4),(2,4)),((2,3),(2,4))] + test "edgeList (box (1 + 2) (3 + 4)) == []" $ + edgeList (box (1 + 2 :: AAI) (3 + 4 :: AAI)) == [] + test "vertexList (box (1 + 2) (3 + 4)) == [(1,3),(1,4),(2,3),(2,4)]" $ + vertexList (box (1 + 2 :: AAI) (3 + 4 :: AAI)) == [(1,3),(1,4),(2,3),(2,4)] + + putStrLn "\n=====AcyclicAdjacencyMap topsort=====" + + test "topSort (1) == [1]" $ + topSort (1 :: AAI) == [1] + test "topSort (1 * 2 * 3) == [1,2,3]" $ + topSort (1 * 2 * 3 :: AAI) == [1,2,3] + + putStrLn "\n=====AcyclicAdjacencyMap fromGraph primitive=====" + + test "fromGraph (<) (2 * 1) == 1 + 2" $ + fromGraph (<) (2 * 1) == (1 + 2 :: AAI) + test "fromGraph (<) (1 * 2) == 1 * 2" $ + fromGraph (<) (1 * 2) == (1 * 2 :: AAI) + test "fromGraph (<) (1 * 2 + 2 * 1) == 1 * 2" $ + fromGraph (<) (1 * 2 + 2 * 1) == (1 * 2 :: AAI) + + putStrLn "\n=====AcyclicAdjacencyMap graph transformation=====" + + test "removeVertex x ('vertex' x) == 'empty'" $ \x -> + removeVertex x (vertex x :: AAI) == empty + test "removeVertex 1 ('vertex' 2) == 'vertex' 2" $ + removeVertex 1 (vertex 2 :: AAI) == vertex 2 + test "removeVertex 1 (1 * 2) == 'vertex' 2" $ + removeVertex 1 (1 * 2 :: AAI) == vertex 2 + test "removeVertex x . removeVertex x == removeVertex x" $ \x y -> + (removeVertex x . removeVertex x $ y :: AAI) == removeVertex x y + + test "removeEdge 1 2 (1 * 2) == (1 + 2)" $ + removeEdge 1 2 (1 * 2 :: AAI) == (1 + 2) + test "removeEdge x y . removeEdge x y == removeEdge x y" $ \x y z -> + (removeEdge x y . removeEdge x y $ z :: AAI) == removeEdge x y z + test "removeEdge x y . 'removeVertex' x == 'removeVertex' x" $ \x y z -> + (removeEdge x y . removeVertex x $ z :: AAI) == removeVertex x z + test "removeEdge 1 2 (1 * 2 + 3 * 4) == 1 + 2 + 3 * 4" $ + removeEdge 1 2 (1 * 2 + 3 * 4 :: AAI) == 1 + 2 + 3 * 4 + + test "induce ('const' True) x == x" $ \x -> + induce (const True) (x :: AAI) == x + test "induce ('const' False) x == 'empty'" $ \x -> + induce (const False) (x :: AAI) == empty + test "induce (/= x) == 'removeVertex' x" $ \x y -> + induce (/= x) y == (removeVertex x y :: AAI) + test "induce p . induce q == induce (\\x -> p x && q x)" $ \(apply -> p) (apply -> q) y -> + (induce p . induce q $ y :: AAI) == induce (\x -> p x && q x) y + + test "transpose 'empty' == 'empty'" $ + transpose empty == (empty :: AAI) + test "transpose ('vertex' x) == 'vertex' x" $ \x -> + transpose (vertex x :: AAI) == vertex x + test "transpose . transpose == id" $ \x -> + (transpose . transpose $ x :: AAI) == id x + test "'edgeList' . transpose == 'Data.List.sort' . 'map' 'Data.Tuple.swap' . 'edgeList'" $ \x -> + (edgeList . transpose $ (x :: AAI)) == (List.sort . List.map Tuple.swap . edgeList $ x) + + putStrLn "\n=====AcyclicAdjacencyMap properties=====" + + test "isEmpty empty == True" $ + isEmpty (empty :: AAI) == True + test "isEmpty (vertex x) == False" $ \x -> + isEmpty (vertex x :: AAI) == False + test "isEmpty (removeVertex x $ vertex x) == True" $ \x -> + isEmpty (removeVertex x $ vertex x :: AAI) == True + test "isEmpty (removeEdge 1 2 $ 1 * 2) == False" $ + isEmpty (removeEdge 1 2 $ 1 * 2 :: AAI) == False + + test "edgeSet empty == Set.empty" $ + edgeSet (empty :: AAI) == Set.empty + test "edgeSet (vertex x) == Set.empty" $ \x -> + edgeSet (vertex x :: AAI) == Set.empty + test "edgeSet (1 * 2) == Set.singleton (1,2)" $ + edgeSet (1 * 2 :: AAI) == Set.singleton (1,2) + + test "vertexSet empty == Set.empty" $ + vertexSet (empty :: AAI) == Set.empty + test "vertexSet . vertex == Set.singleton" $ \x -> + vertexSet (vertex x :: AAI) == Set.singleton x + test "vertexSet . vertices == Set.fromList" $ \x -> + vertexSet (vertices x :: AAI) == Set.fromList x + + test "vertexCount empty == 0" $ + vertexCount (empty :: AAI) == 0 + test "vertexCount (vertex x) == 1" $ \x -> + vertexCount (vertex x :: AAI) == 1 + test "vertexCount == length . vertexList" $ \x -> + vertexCount (x :: AAI) == (List.length . vertexList $ x) + test "vertexCount x < vertexCount y == > x < y" $ \x y -> + not (vertexCount (x :: AAI) < vertexCount y) || x < y + + test "edgeCount empty == 0" $ + edgeCount (empty :: AAI) == 0 + test "edgeCount (vertex x) == 0" $ \x -> + edgeCount (vertex x :: AAI) == 0 + test "edgeCount (1 * 2) == 1" $ + edgeCount (1 * 2 :: AAI) == 1 + test "edgeCount == length . edgeList" $ \x -> + edgeCount (x :: AAI) == (List.length . edgeList $ x) + + test "adjacencyList empty == []" $ + adjacencyList (empty :: AAI) == [] + test "adjacencyList (vertex x) == [(x, [])]" $ \x -> + adjacencyList (vertex x :: AAI) == [(x, [])] + test "adjacencyList (1 * 2) == [(1, [2]), (2, [])]" $ + adjacencyList (1 * 2 :: AAI) == [(1, [2]), (2, [])] + + test "hasEdge x y empty == False" $ \x y -> + hasEdge x y (empty :: AAI) == False + test "hasEdge x y (vertex z) == False" $ \x y z -> + hasEdge x y (vertex z :: AAI) == False + test "hasEdge 1 2 (1 * 2) == True" $ + hasEdge 1 2 (1 * 2 :: AAI) == True + test "hasEdge x y . removeEdge x y == const False" $ \x y z -> + (hasEdge x y . removeEdge x y $ (z :: AAI)) == const False z + test "hasEdge x y == elem (x,y) . edgeList" $ \x y z -> + (hasEdge x y $ (z :: AAI)) == (elem (x,y) . edgeList $ z) + + test "hasVertex x empty == False" $ \x -> + hasVertex x (empty :: AAI) == False + test "hasVertex x (vertex x) == True" $ \x -> + hasVertex x (vertex x :: AAI) == True + test "hasVertex 1 (vertex 2) == False" $ + hasVertex 1 (vertex 2 :: AAI) == False + test "hasVertex x . removeVertex x == const False" $ \x z -> + (hasVertex x . removeVertex x $ (z :: AAI)) == const False z + + test "edgeList empty == []" $ + edgeList (empty :: AAI) == [] + test "edgeList (vertex 5) == []" $ + edgeList (vertex 5 :: AAI) == [] + test "edgeList (1 * 2) == [(1,2)]" $ + edgeList (1 * 2 :: AAI) == [(1,2)] + test "edgeList (2 * 1) == []" $ + edgeList (2 * 1 :: AAI) == [] + + test "vertexList empty == []" $ + vertexList (empty :: AAI) == [] + test "vertexList (vertex 1) == [1]" $ + vertexList (vertex 1 :: AAI) == [1] + test "vertexList (vertices ([1, 3, 2])) == List.sort [1, 3, 2] == [1,2,3]" $ + vertexList (vertices ([1, 3, 2]) :: AAI) == List.sort [1, 3, 2] + + + putStrLn "\n============ AcyclicAdjacencyMap scc ============" + + test "scc AM.empty == empty" $ + scc (AM.empty :: AI) == empty + + test "scc (AM.vertex x) == vertex (NonEmpty.vertex x)" $ \(x :: Int) -> + scc (AM.vertex x) == vertex (NonEmpty.vertex x) + + test "scc (edge 1 1) == vertex (NonEmpty.edge 1 1)" $ + scc (AM.edge 1 1 :: AI) == vertex (NonEmpty.edge 1 1) + + test "vertexList (scc (edge 1 2)) == [NonEmpty.vertex 1,NonEmpty.vertex 2]" $ + vertexList (scc (AM.edge 1 2 :: AI)) == [NonEmpty.vertex 1,NonEmpty.vertex 2] + test "edgeList (scc (edge 1 2)) == [(NonEmpty.vertex 1,NonEmpty.vertex 2)]" $ + edgeList (scc (AM.edge 1 2 :: AI)) == [(NonEmpty.vertex 1,NonEmpty.vertex 2)] + + test "scc (AM.circuit (1:xs)) == vertex (NonEmpty.circuit1 (1 :| xs))" $ \(xs :: [Int]) -> + scc (AM.circuit (1:xs)) == vertex (NonEmpty.circuit1 (1 :| xs)) + + test "vertexList (scc (3 * 1 * 4 * 1 * 5)) == " $ + vertexList (scc (3 * 1 * 4 * 1 * 5 :: AI)) == [NonEmpty.vertex 3,NonEmpty.vertex 5,NonEmpty.clique1 (1 :| [4,1])] + test "edgeList (scc (3 * 1 * 4 * 1 * 5)) == " $ + edgeList (scc (3 * 1 * 4 * 1 * 5 :: AI)) == [(NonEmpty.vertex 3,NonEmpty.vertex 5),(NonEmpty.vertex 3,NonEmpty.clique1 (1 :| [4,1])),(NonEmpty.clique1 (1 :| [4,1]),NonEmpty.vertex 5)] + + diff --git a/test/Algebra/Graph/Test/Arbitrary.hs b/test/Algebra/Graph/Test/Arbitrary.hs index eac099dad..26967a998 100644 --- a/test/Algebra/Graph/Test/Arbitrary.hs +++ b/test/Algebra/Graph/Test/Arbitrary.hs @@ -24,6 +24,7 @@ import Algebra.Graph import Algebra.Graph.Export import Algebra.Graph.Label +import qualified Algebra.Graph.Acyclic.AdjacencyMap as AAM import qualified Algebra.Graph.AdjacencyIntMap as AIM import qualified Algebra.Graph.AdjacencyMap as AM import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NAM @@ -58,6 +59,20 @@ instance Arbitrary a => Arbitrary (Graph a) where shrink (Connect x y) = [Empty, x, y, Overlay x y] ++ [Connect x' y' | (x', y') <- shrink (x, y) ] +-- An Arbitrary instance for Acyclic.AdjacencyMap +instance (Ord a, Arbitrary a) => Arbitrary (AAM.AdjacencyMap a) where + arbitrary = AAM.fromGraph (<) <$> arbitrary + + shrink g = shrinkVertices ++ shrinkEdges + where + shrinkVertices = + let vertices = AAM.vertexList g + in [ AAM.removeVertex x g | x <- vertices ] + + shrinkEdges = + let edges = AAM.edgeList g + in [ AAM.removeEdge x y g | (x, y) <- edges ] + -- | Generate an arbitrary 'NonEmpty.Graph' value of a specified size. arbitraryNonEmptyGraph :: Arbitrary a => Gen (NonEmpty.Graph a) arbitraryNonEmptyGraph = sized expr diff --git a/test/Main.hs b/test/Main.hs index 62134320a..fe3855fd0 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,3 +1,4 @@ +import Algebra.Graph.Test.Acyclic.AdjacencyMap import Algebra.Graph.Test.AdjacencyIntMap import Algebra.Graph.Test.AdjacencyMap import Algebra.Graph.Test.NonEmpty.AdjacencyMap @@ -25,6 +26,7 @@ main :: IO () main = do selected <- getArgs let go current = when (null selected || current `elem` selected) + go "AcyclicAdjacencyMap" testAcyclicAdjacencyMap go "AdjacencyIntMap" testAdjacencyIntMap go "AdjacencyMap" testAdjacencyMap go "Export" testExport