algebraic-graphs 0.3 → 0.4

raw patch · 28 files changed

+1675/−300 lines, 28 filesdep +bifunctorsdep ~QuickChecksetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: bifunctors

Dependency ranges changed: QuickCheck

API changes (from Hackage documentation)

Files

• CHANGES.md +85/−78
• Setup.hs +2/−2
• algebraic-graphs.cabal +9/−5
• src/Algebra/Graph.hs +66/−21
• src/Algebra/Graph/AdjacencyIntMap/Internal.hs +3/−1
• src/Algebra/Graph/AdjacencyMap/Internal.hs +3/−1
• src/Algebra/Graph/Class.hs +11/−1
• src/Algebra/Graph/Label.hs +13/−1
• src/Algebra/Graph/Labelled.hs +4/−0
• src/Algebra/Graph/Labelled/AdjacencyMap/Internal.hs +3/−1
• src/Algebra/Graph/NonEmpty.hs +52/−21
• src/Algebra/Graph/NonEmpty/AdjacencyMap/Internal.hs +3/−1
• src/Algebra/Graph/Relation/Internal.hs +12/−12
• src/Algebra/Graph/Relation/InternalDerived.hs +4/−38
• src/Algebra/Graph/Relation/Symmetric.hs +441/−16
• src/Algebra/Graph/Relation/Symmetric/Internal.hs +215/−0
• src/Algebra/Graph/ToGraph.hs +27/−0
• test/Algebra/Graph/Test/API.hs +72/−34
• test/Algebra/Graph/Test/AdjacencyIntMap.hs +1/−4
• test/Algebra/Graph/Test/AdjacencyMap.hs +1/−4
• test/Algebra/Graph/Test/Arbitrary.hs +75/−14
• test/Algebra/Graph/Test/Generic.hs +404/−10
• test/Algebra/Graph/Test/Graph.hs +25/−0
• test/Algebra/Graph/Test/NonEmpty/Graph.hs +21/−0
• test/Algebra/Graph/Test/Relation.hs +1/−23
• test/Algebra/Graph/Test/Relation/SymmetricRelation.hs +68/−0
• test/Algebra/Graph/Test/RewriteRules.hs +28/−0
• test/Main.hs +26/−12

@@ -1,78 +1,85 @@-# Change log
-
-## 0.3
-
-* #129: Add a testsuite for rewrite rules based on the `inspection-testing` library.
-* #63, #148: Add relational composition of algebraic graphs.
-* #139, #146: Add relational operations to adjacency maps.
-* #146: Rename `preorderClosure` to `closure`.
-* #146: Switch to left-to-right composition in `Relation.compose`.
-* #143: Allow newer QuickCheck.
-* #140, #142: Fix `Show` instances.
-* #128, #130: Modify the SCC algorithm to return non-empty graph components.
-* #130: Move adjacency map algorithms to separate modules.
-* #130: Export `fromAdjacencySets` and `fromAdjacencyIntSets`.
-* #138: Do not require `Eq` instance on the string type when exporting graphs.
-* #136: Rename `Algebra.Graph.NonEmpty.NonEmptyGraph` to `Algebra.Graph.NonEmpty.Graph`.
-* #136: Add `Algebra.Graph.NonEmpty.AdjacencyMap`.
-* #136: Remove `vertexIntSet` from the API of basic graph data types. Also
-        remove `Algebra.Graph.adjacencyMap` and `Algebra.Graph.adjacencyIntMap`.
-        This functionality is still available from the type class `ToGraph`.
-* #126, #131: Implement custom `Ord` instance.
-* #17, #122, #125, #149: Add labelled algebraic graphs.
-* #121: Drop `Foldable` and `Traversable` instances.
-* #113: Add `Labelled.AdjacencyMap`.
-
-## 0.2
-
-* #117: Add `sparsify`.
-* #115: Add `isDfsForestOf`.
-* #114: Add a basic implementation of edge-labelled graphs.
-* #107: Drop `starTranspose`.
-* #106: Extend `ToGraph` with algorithms based on adjacency maps.
-* #106: Add `isAcyclic` and `reachable`.
-* #106: Rename `isTopSort` to `isTopSortOf`.
-* #102: Switch the master branch to GHC 8.4.3. Add a CI instance for GHC 8.6.1.
-* #101: Drop `-O2` from the `ghc-options` section of the Cabal file.
-* #100: Rename `fromAdjacencyList` to `stars`.
-* #79: Improve the API consistency: rename `IntAdjacencyMap` to `AdjacencyIntMap`,
-       and then rename the function that extracts its adjacency map to
-       `adjacencyIntMap` to avoid the clash with `AdjacencyMap.adjacencyMap`,
-       which has incompatible type.
-* #82, #92: Add performance regression suite.
-* #76: Remove benchmarks.
-* #74: Drop dependency of `Algebra.Graph` on graph type classes.
-* #62: Move King-Launchbury graphs into `Data.Graph.Typed`.
-* #67, #68, #69, #77, #81, #93, #94, #97, #103, #110: Various performance improvements.
-* #66, #72, #96, #98: Add missing `NFData` instances.
-
-## 0.1.1.1
-
-* #59: Allow `base-compat-0.10`.
-
-## 0.1.1
-
-* #58: Update documentation.
-* #57: Allow newer QuickCheck.
-
-## 0.1.0
-
-* Start complying with PVP.
-* #48: Add `starTranspose`.
-* #48: Add `foldg` to `ToGraph`.
-* #15: Optimise `removeEdge`.
-* #39: Factor out difference lists into `Algebra.Graph.Internal`.
-* #31: Add `Algebra.Graph.NonEmpty`.
-* #32: Remove smart constructor `graph`.
-* #27, #55: Support GHC versions 7.8.4, 7.10.3, 8.0.2, 8.2.2, 8.4.1.
-* #25: Add `NFData Graph` instance.
-* General improvements to code, documentation and tests.
-
-## 0.0.5
-
-* Add `dfs`.
-* #19: Move `GraphKL` to an internal module.
-* #18: Add `dfsForestFrom`.
-* #16: Add support for graph export, in particular in DOT format.
-* Make API more consistent, e.g. rename `postset` to `postSet`.
-* Improve documentation and tests.
+# Change log++## 0.4++* #174: Add `Symmetric.Relation`.+* #143: Allow newer QuickCheck.+* #171: Implement sparsification for King-Launchbury graph representation.+* #178: Derive `Generic` for adjacency maps.++## 0.3++* #129: Add a testsuite for rewrite rules based on the `inspection-testing` library.+* #63, #148: Add relational composition of algebraic graphs.+* #139, #146: Add relational operations to adjacency maps.+* #146: Rename `preorderClosure` to `closure`.+* #146: Switch to left-to-right composition in `Relation.compose`.+* #143: Allow newer QuickCheck.+* #140, #142: Fix `Show` instances.+* #128, #130: Modify the SCC algorithm to return non-empty graph components.+* #130: Move adjacency map algorithms to separate modules.+* #130: Export `fromAdjacencySets` and `fromAdjacencyIntSets`.+* #138: Do not require `Eq` instance on the string type when exporting graphs.+* #136: Rename `Algebra.Graph.NonEmpty.NonEmptyGraph` to `Algebra.Graph.NonEmpty.Graph`.+* #136: Add `Algebra.Graph.NonEmpty.AdjacencyMap`.+* #136: Remove `vertexIntSet` from the API of basic graph data types. Also+        remove `Algebra.Graph.adjacencyMap` and `Algebra.Graph.adjacencyIntMap`.+        This functionality is still available from the type class `ToGraph`.+* #126, #131: Implement custom `Ord` instance.+* #17, #122, #125, #149: Add labelled algebraic graphs.+* #121: Drop `Foldable` and `Traversable` instances.+* #113: Add `Labelled.AdjacencyMap`.++## 0.2++* #117: Add `sparsify`.+* #115: Add `isDfsForestOf`.+* #114: Add a basic implementation of edge-labelled graphs.+* #107: Drop `starTranspose`.+* #106: Extend `ToGraph` with algorithms based on adjacency maps.+* #106: Add `isAcyclic` and `reachable`.+* #106: Rename `isTopSort` to `isTopSortOf`.+* #102: Switch the master branch to GHC 8.4.3. Add a CI instance for GHC 8.6.1.+* #101: Drop `-O2` from the `ghc-options` section of the Cabal file.+* #100: Rename `fromAdjacencyList` to `stars`.+* #79: Improve the API consistency: rename `IntAdjacencyMap` to `AdjacencyIntMap`,+       and then rename the function that extracts its adjacency map to+       `adjacencyIntMap` to avoid the clash with `AdjacencyMap.adjacencyMap`,+       which has incompatible type.+* #82, #92: Add performance regression suite.+* #76: Remove benchmarks.+* #74: Drop dependency of `Algebra.Graph` on graph type classes.+* #62: Move King-Launchbury graphs into `Data.Graph.Typed`.+* #67, #68, #69, #77, #81, #93, #94, #97, #103, #110: Various performance improvements.+* #66, #72, #96, #98: Add missing `NFData` instances.++## 0.1.1.1++* #59: Allow `base-compat-0.10`.++## 0.1.1++* #58: Update documentation.+* #57: Allow newer QuickCheck.++## 0.1.0++* Start complying with PVP.+* #48: Add `starTranspose`.+* #48: Add `foldg` to `ToGraph`.+* #15: Optimise `removeEdge`.+* #39: Factor out difference lists into `Algebra.Graph.Internal`.+* #31: Add `Algebra.Graph.NonEmpty`.+* #32: Remove smart constructor `graph`.+* #27, #55: Support GHC versions 7.8.4, 7.10.3, 8.0.2, 8.2.2, 8.4.1.+* #25: Add `NFData Graph` instance.+* General improvements to code, documentation and tests.++## 0.0.5++* Add `dfs`.+* #19: Move `GraphKL` to an internal module.+* #18: Add `dfsForestFrom`.+* #16: Add support for graph export, in particular in DOT format.+* Make API more consistent, e.g. rename `postset` to `postSet`.+* Improve documentation and tests.

@@ -1,2 +1,2 @@-import Distribution.Simple
-main = defaultMain
+import Distribution.Simple+main = defaultMain

@@ -1,22 +1,22 @@ name:          algebraic-graphs-version:       0.3+version:       0.4 synopsis:      A library for algebraic graph construction and transformation license:       MIT license-file:  LICENSE author:        Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard maintainer:    Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard,                Alexandre Moine <alexandre@moine.me>, github: @nobrakal-copyright:     Andrey Mokhov, 2016-2018+copyright:     Andrey Mokhov, 2016-2019 homepage:      https://github.com/snowleopard/alga category:      Algebra, Algorithms, Data Structures, Graphs build-type:    Simple-cabal-version: >=1.18+cabal-version: 1.18 tested-with:   GHC==7.8.4,                GHC==7.10.3,                GHC==8.0.2,                GHC==8.2.2,                GHC==8.4.3,-               GHC==8.6.1+               GHC==8.6.4 stability:     experimental description:     <https://github.com/snowleopard/alga Alga> is a library for algebraic construction and@@ -96,6 +96,7 @@                         Algebra.Graph.Relation.Preorder,                         Algebra.Graph.Relation.Reflexive,                         Algebra.Graph.Relation.Symmetric,+                        Algebra.Graph.Relation.Symmetric.Internal,                         Algebra.Graph.Relation.Transitive,                         Algebra.Graph.ToGraph,                         Data.Graph.Typed@@ -107,6 +108,8 @@                         mtl         >= 2.1     && < 2.3     if !impl(ghc >= 8.0)         build-depends:  semigroups  >= 0.18.3  && < 0.18.4+    if !impl(ghc >= 7.10)+        build-depends:  bifunctors  >= 5       && < 5.6     default-language:   Haskell2010     default-extensions: FlexibleContexts                         FlexibleInstances@@ -146,6 +149,7 @@                         Algebra.Graph.Test.NonEmpty.AdjacencyMap,                         Algebra.Graph.Test.NonEmpty.Graph,                         Algebra.Graph.Test.Relation,+                        Algebra.Graph.Test.Relation.SymmetricRelation,                         Data.Graph.Test.Typed     if impl(ghc >= 8.0.2)         other-modules:  Algebra.Graph.Test.RewriteRules@@ -156,7 +160,7 @@                         base-orphans >= 0.5.4   && < 0.9,                         containers   >= 0.5.5.1 && < 0.8,                         extra        >= 1.5     && < 2,-                        QuickCheck   >= 2.9     && < 2.13+                        QuickCheck   >= 2.9     && < 2.14     if !impl(ghc >= 8.0)         build-depends:  semigroups   >= 0.18.3  && < 0.18.4     if impl(ghc >= 8.0.2)

@@ -41,7 +41,7 @@      -- * Graph transformation     removeVertex, removeEdge, replaceVertex, mergeVertices, splitVertex,-    transpose, induce, simplify, sparsify,+    transpose, induce, simplify, sparsify, sparsifyKL,      -- * Graph composition     compose, box,@@ -51,7 +51,7 @@     ) where  import Prelude ()-import Prelude.Compat hiding ((<>))+import Prelude.Compat  import Control.Applicative (Alternative) import Control.DeepSeq (NFData (..))@@ -59,7 +59,7 @@ import Control.Monad.State (runState, get, put) import Data.Foldable (toList) import Data.Maybe (fromMaybe)-import Data.Monoid ((<>))+import Data.Semigroup ((<>)) import Data.Tree  import Algebra.Graph.Internal@@ -67,9 +67,11 @@ import qualified Algebra.Graph.AdjacencyMap    as AM import qualified Algebra.Graph.AdjacencyIntMap as AIM import qualified Control.Applicative           as Ap+import qualified Data.Graph                    as KL import qualified Data.IntSet                   as IntSet import qualified Data.Set                      as Set import qualified Data.Tree                     as Tree+import qualified GHC.Exts                      as Exts  {-| The 'Graph' data type is a deep embedding of the core graph construction primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a 'Num'@@ -212,10 +214,9 @@ instance Functor Graph where     fmap = fmapR --- This is a usual implementation of 'fmap', but with custom rewrite rules. fmapR :: (a -> b) -> Graph a -> Graph b-fmapR f = foldg empty (vertex . f) overlay connect-{-# INLINE [0] fmapR #-}+fmapR f g = bindR g (vertex . f)+{-# INLINE fmapR #-}  instance NFData a => NFData (Graph a) where     rnf Empty         = ()@@ -263,12 +264,20 @@  instance Applicative Graph where     pure  = Vertex-    (<*>) = ap+    (<*>) = apR +apR :: Graph (a -> b) -> Graph a -> Graph b+apR f x = bindR f (<$> x)+{-# INLINE apR #-}+ instance Monad Graph where-    return  = pure-    g >>= f = foldg Empty f Overlay Connect g+    return = pure+    (>>=)  = bindR +bindR :: Graph a -> (a -> Graph b) -> Graph b+bindR g f = foldg Empty f Overlay Connect g+{-# INLINE [0] bindR #-}+ instance Alternative Graph where     empty = Empty     (<|>) = Overlay@@ -471,9 +480,14 @@ -- isSubgraphOf x y                         ==> x <= y -- @ isSubgraphOf :: Ord a => Graph a -> Graph a -> Bool-isSubgraphOf x y = overlay x y == y-{-# SPECIALISE isSubgraphOf :: Graph Int -> Graph Int -> Bool #-}+isSubgraphOf x y = AM.isSubgraphOf (toAdjacencyMap x) (toAdjacencyMap y)+{-# NOINLINE [1] isSubgraphOf #-}+{-# RULES "isSubgraphOf/Int" isSubgraphOf = isSubgraphOfIntR #-} +-- Like 'isSubgraphOf' but specialised for graphs with vertices of type 'Int'.+isSubgraphOfIntR :: Graph Int -> Graph Int -> Bool+isSubgraphOfIntR x y = AIM.isSubgraphOf (toAdjacencyIntMap x) (toAdjacencyIntMap y)+ -- | Structural equality on graph expressions. -- Complexity: /O(s)/ time. --@@ -1089,12 +1103,10 @@ -- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y -- @ box :: Graph a -> Graph b -> Graph (a, b)-box x y = overlays $ xs ++ ys+box x y = overlay (fx <*> y) (fy <*> x)   where-    xs = map (\b -> fmap (,b) x) $ toList $ toListGr y-    ys = map (\a -> fmap (a,) y) $ toList $ toListGr x-    toListGr :: Graph a -> List a-    toListGr = foldg mempty pure (<>) (<>)+    fx = foldg empty (vertex .      (,)) overlay overlay x+    fy = foldg empty (vertex . flip (,)) overlay overlay y  -- | /Sparsify/ a graph by adding intermediate 'Left' @Int@ vertices between the -- original vertices (wrapping the latter in 'Right') such that the resulting@@ -1123,6 +1135,35 @@         put (m + 1)         overlay <$> s `x` m <*> m `y` t +-- | Sparsify a graph whose vertices are integers in the range @[1..n]@, where+-- @n@ is the first argument of the function, producing an array-based graph+-- representation from "Data.Graph" (introduced by King and Launchbury, hence+-- the name of the function). In the resulting graph, vertices @[1..n]@+-- correspond to the original vertices, and all vertices greater than @n@ are+-- introduced by the sparsification procedure.+--+-- Complexity: /O(s)/ time and memory. Note that thanks to sparsification, the+-- resulting graph has a linear number of edges with respect to the size of the+-- original algebraic representation even though the latter can potentially+-- contain a quadratic /O(s^2)/ number of edges.+--+-- @+-- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' k                 == 'Data.List.sort' . 'filter' (<= n) . 'flip' 'Data.Graph.reachable' k . sparsifyKL n+-- 'length' ('Data.Graph.vertices' $ sparsifyKL n x) <= 'vertexCount' x + 'size' x + 1+-- 'length' ('Data.Graph.edges'    $ sparsifyKL n x) <= 3 * 'size' x+-- @+sparsifyKL :: Int -> Graph Int -> KL.Graph+sparsifyKL n graph = KL.buildG (1, next - 1) ((n + 1, n + 2) : Exts.toList (res :: List KL.Edge))+  where+    (res, next) = runState (foldg e v o c graph (n + 1) (n + 2)) (n + 3)+    e     _ _   = return $ Exts.fromList []+    v x   s t   = return $ Exts.fromList [(s,x), (x,t)]+    o x y s t   = (<>) <$> s `x` t <*> s `y` t+    c x y s t   = do+        m <- get+        put (m + 1)+        (\xs ys -> Exts.fromList [(s,m), (m,t)] <> xs <> ys) <$> s `x` m <*> m `y` t+ {- Note [The rules of foldg] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1144,7 +1185,7 @@   a "buildR/f" rule. These functions are higher-order functions and therefore   benefit from inlining in the final phase. -* The "fmapR/fmapR" rule optimises compositions of multiple fmapR's.+* The "bindR/bindR" rule optimises compositions of multiple bindR's. -}  type Foldg a = forall b. b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> b@@ -1163,8 +1204,8 @@  -- These rules transform functions into their buildR equivalents. {-# RULES-"buildR/fmapR" forall f g.-    fmapR f g = buildR (\e v o c -> foldg e (composeR v f) o c g)+"buildR/bindR" forall f g.+    bindR g f = buildR (\e v o c -> foldg e (composeR (foldg e v o c) f) o c g)  "buildR/induce" [~1] forall p g.     induce p g = buildR (\e v o c -> foldg e (matchR e v p) o c g)@@ -1185,10 +1226,14 @@ "foldg/buildR" forall e v o c (g :: Foldg a).     foldg e v o c (buildR g) = g e v o c --- Fuse composeR's. This occurs when two adjacent 'fmapR' were rewritted into+-- Fuse composeR's. This occurs when two adjacent 'bindR' were rewritted into -- their buildR form.-"fmapR/fmapR" forall c f g.+"bindR/bindR" forall c f g.     composeR (composeR c f) g = composeR c (f.g)++-- Rewrite identity (which can appear in the rewriting of bindR) to a much efficient one+"foldg/id"+    foldg Empty Vertex Overlay Connect = id  #-}  -- Eliminate remaining rewrite-only functions.

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.AdjacencyIntMap.Internal@@ -23,6 +24,7 @@ import Data.IntMap.Strict (IntMap, keysSet, fromSet) import Data.IntSet (IntSet) import Data.List+import GHC.Generics  import Control.DeepSeq (NFData (..)) @@ -133,7 +135,7 @@     -- adjacencyIntMap ('Algebra.Graph.AdjacencyIntMap.edge' 1 1) == IntMap.'IntMap.singleton' 1 (IntSet.'IntSet.singleton' 1)     -- adjacencyIntMap ('Algebra.Graph.AdjacencyIntMap.edge' 1 2) == IntMap.'IntMap.fromList' [(1,IntSet.'IntSet.singleton' 2), (2,IntSet.'IntSet.empty')]     -- @-    adjacencyIntMap :: IntMap IntSet } deriving Eq+    adjacencyIntMap :: IntMap IntSet } deriving (Eq, Generic)  instance Show AdjacencyIntMap where     showsPrec p (AM m)

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.AdjacencyMap.Internal@@ -24,6 +25,7 @@ import Data.Map.Strict (Map, keysSet, fromSet) import Data.Monoid import Data.Set (Set)+import GHC.Generics  import qualified Data.Map.Strict as Map import qualified Data.Set        as Set@@ -132,7 +134,7 @@     -- adjacencyMap ('Algebra.Graph.AdjacencyMap.edge' 1 1) == Map.'Map.singleton' 1 (Set.'Set.singleton' 1)     -- adjacencyMap ('Algebra.Graph.AdjacencyMap.edge' 1 2) == Map.'Map.fromList' [(1,Set.'Set.singleton' 2), (2,Set.'Set.empty')]     -- @-    adjacencyMap :: Map a (Set a) } deriving Eq+    adjacencyMap :: Map a (Set a) } deriving (Eq, Generic)  instance Ord a => Ord (AdjacencyMap a) where     compare (AM x) (AM y) = mconcat

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Class--- Copyright  : (c) Andrey Mokhov 2016-2018+-- Copyright  : (c) Andrey Mokhov 2016-2019 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -61,6 +61,7 @@ import qualified Algebra.Graph.Fold                  as F import qualified Algebra.Graph.AdjacencyIntMap       as AIM import qualified Algebra.Graph.Relation              as R+import qualified Algebra.Graph.Relation.Symmetric    as RS  {-| The core type class for constructing algebraic graphs, characterised by the@@ -169,6 +170,15 @@     vertex  = R.vertex     overlay = R.overlay     connect = R.connect++instance Ord a => Graph (RS.Relation a) where+    type Vertex (RS.Relation a) = a+    empty   = RS.empty+    vertex  = RS.vertex+    overlay = RS.overlay+    connect = RS.connect++instance Ord a => Undirected (RS.Relation a)  {-| The class of /undirected graphs/ that satisfy the following additional axiom.

@@ -322,6 +322,18 @@ noMinimum :: Minimum a noMinimum = Minimum Infinite +instance Ord a => Semigroup (Minimum a) where+    (<>) = liftA2 min++instance (Monoid a, Ord a) => Monoid (Minimum a) where+    mempty = pure mempty ++instance (Monoid a, Ord a) => Semiring (Minimum a) where+    one = noMinimum+    (<.>) = liftA2 mappend++instance (Monoid a, Ord a) => Dioid (Minimum a)+ instance (Num a, Show a) => Show (Minimum a) where     show (Minimum Infinite  ) = "one"     show (Minimum (Finite x)) = show x@@ -343,7 +355,7 @@ -- x '<.>' y = PowerSet $ 'setProductWith' 'mappend' (getPowerSet x) (getPowerSet y) -- @ newtype PowerSet a = PowerSet { getPowerSet :: Set a }-    deriving (Eq, Monoid, Ord, Semigroup)+    deriving (Eq, Monoid, Ord, Semigroup, Show)  instance (Monoid a, Ord a) => Semiring (PowerSet a) where     one                       = PowerSet (Set.singleton mempty)

@@ -46,6 +46,7 @@ import Prelude () import Prelude.Compat +import Data.Bifunctor import Data.Monoid (Any (..)) import Data.Semigroup ((<>)) @@ -81,6 +82,9 @@     signum      = const empty     abs         = id     negate      = id++instance Bifunctor Graph where+  bimap f g = foldg Empty (Vertex . g) (Connect . f)  -- TODO: This is a very inefficient implementation. Find a way to construct an -- adjacency map directly, without building intermediate representations for all

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Labelled.AdjdacencyMap.Internal@@ -22,6 +23,7 @@ import Data.Map.Strict (Map) import Data.Monoid (Monoid, getSum, Sum (..)) import Data.Set (Set, (\\))+import GHC.Generics  import qualified Data.Map.Strict as Map import qualified Data.Set        as Set@@ -37,7 +39,7 @@     -- | The /adjacency map/ of an edge-labelled graph: each vertex is     -- associated with a map from its direct successors to the corresponding     -- edge labels.-    adjacencyMap :: Map a (Map a e) } deriving (Eq, NFData)+    adjacencyMap :: Map a (Map a e) } deriving (Eq, Generic, NFData)  instance (Ord a, Show a, Ord e, Show e) => Show (AdjacencyMap e a) where     showsPrec p (AM m)

@@ -47,7 +47,7 @@      -- * Graph transformation     removeVertex1, removeEdge, replaceVertex, mergeVertices, splitVertex1,-    transpose, induce1, simplify, sparsify,+    transpose, induce1, simplify, sparsify, sparsifyKL,      -- * Graph composition     box@@ -56,23 +56,24 @@ import Prelude () import Prelude.Compat -#if !MIN_VERSION_base(4,11,0)-import Data.Semigroup-#endif- import Control.DeepSeq import Control.Monad.Compat import Control.Monad.State import Data.List.NonEmpty (NonEmpty (..))+import Data.Semigroup ((<>))  import Algebra.Graph.Internal -import qualified Algebra.Graph         as G-import qualified Algebra.Graph.ToGraph as T-import qualified Data.IntSet           as IntSet-import qualified Data.List.NonEmpty    as NonEmpty-import qualified Data.Set              as Set-import qualified Data.Tree             as Tree+import qualified Algebra.Graph                 as G+import qualified Algebra.Graph.ToGraph         as T+import qualified Algebra.Graph.AdjacencyMap    as AM+import qualified Algebra.Graph.AdjacencyIntMap as AIM+import qualified Data.Graph                    as KL+import qualified Data.IntSet                   as IntSet+import qualified Data.List.NonEmpty            as NonEmpty+import qualified Data.Set                      as Set+import qualified Data.Tree                     as Tree+import qualified GHC.Exts                      as Exts  {-| Non-empty algebraic graphs, which are constructed using three primitives: 'vertex', 'overlay' and 'connect'. See module "Algebra.Graph" for algebraic@@ -216,8 +217,8 @@ ordInt x y = compare (T.toAdjacencyIntMap x) (T.toAdjacencyIntMap y)  instance Applicative Graph where-    pure  = Vertex-    (<*>) = ap+    pure    = Vertex+    f <*> x = f >>= (<$> x)  instance Monad Graph where     return  = pure@@ -402,9 +403,14 @@ -- isSubgraphOf x y                         ==> x <= y -- @ isSubgraphOf :: Ord a => Graph a -> Graph a -> Bool-isSubgraphOf x y = overlay x y == y-{-# SPECIALISE isSubgraphOf :: Graph Int -> Graph Int -> Bool #-}+isSubgraphOf x y = AM.isSubgraphOf (T.toAdjacencyMap x) (T.toAdjacencyMap y)+{-# NOINLINE [1] isSubgraphOf #-}+{-# RULES "isSubgraphOf/Int" isSubgraphOf = isSubgraphOfIntR #-} +-- Like 'isSubgraphOf' but specialised for graphs with vertices of type 'Int'.+isSubgraphOfIntR :: Graph Int -> Graph Int -> Bool+isSubgraphOfIntR x y = AIM.isSubgraphOf (T.toAdjacencyIntMap x) (T.toAdjacencyIntMap y)+ -- | Structural equality on graph expressions. -- Complexity: /O(s)/ time. --@@ -898,13 +904,10 @@ -- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y -- @ box :: Graph a -> Graph b -> Graph (a, b)-box x y = overlays1 xs `overlay` overlays1 ys+box x y = overlay (fx <*> y) (fy <*> x)   where-    xs = fmap (\b -> fmap (,b) x) $ toNonEmptyList y-    ys = fmap (\a -> fmap (a,) y) $ toNonEmptyList x--toNonEmptyList :: Graph a -> NonEmpty a-toNonEmptyList = foldg1 (:| []) (<>) (<>)+    fx = foldg1 (vertex .      (,)) overlay overlay x+    fy = foldg1 (vertex . flip (,)) overlay overlay y  -- | /Sparsify/ a graph by adding intermediate 'Left' @Int@ vertices between the -- original vertices (wrapping the latter in 'Right') such that the resulting@@ -931,3 +934,31 @@         m <- get         put (m + 1)         overlay <$> s `x` m <*> m `y` t++-- | Sparsify a graph whose vertices are integers in the range @[1..n]@, where+-- @n@ is the first argument of the function, producing an array-based graph+-- representation from "Data.Graph" (introduced by King and Launchbury, hence+-- the name of the function). In the resulting graph, vertices @[1..n]@+-- correspond to the original vertices, and all vertices greater than @n@ are+-- introduced by the sparsification procedure.+--+-- Complexity: /O(s)/ time and memory. Note that thanks to sparsification, the+-- resulting graph has a linear number of edges with respect to the size of the+-- original algebraic representation even though the latter can potentially+-- contain a quadratic /O(s^2)/ number of edges.+--+-- @+-- 'Data.List.sort' . 'Algebra.Graph.ToGraph.reachable' k                 == 'Data.List.sort' . 'filter' (<= n) . 'flip' 'Data.Graph.reachable' k . sparsifyKL n+-- 'length' ('Data.Graph.vertices' $ sparsifyKL n x) <= 'vertexCount' x + 'size' x + 1+-- 'length' ('Data.Graph.edges'    $ sparsifyKL n x) <= 3 * 'size' x+-- @+sparsifyKL :: Int -> Graph Int -> KL.Graph+sparsifyKL n graph = KL.buildG (1, next - 1) ((n + 1, n + 2) : Exts.toList (res :: List KL.Edge))+  where+    (res, next) = runState (foldg1 v o c graph (n + 1) (n + 2)) (n + 3)+    v x   s t   = return $ Exts.fromList [(s,x), (x,t)]+    o x y s t   = (<>) <$> s `x` t <*> s `y` t+    c x y s t   = do+        m <- get+        put (m + 1)+        (\xs ys -> Exts.fromList [(s,m), (m,t)] <> xs <> ys) <$> s `x` m <*> m `y` t

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.NonEmpty.AdjacencyMap.Internal@@ -17,6 +18,7 @@  import Control.DeepSeq import Data.List+import GHC.Generics  import qualified Algebra.Graph.AdjacencyMap          as AM import qualified Algebra.Graph.AdjacencyMap.Internal as AM@@ -115,7 +117,7 @@     -- adjacencyMap ('Algebra.Graph.NonEmpty.AdjacencyMap.edge' 1 1) == Map.'Map.singleton' 1 (Set.'Set.singleton' 1)     -- adjacencyMap ('Algebra.Graph.NonEmpty.AdjacencyMap.edge' 1 2) == Map.'Map.fromList' [(1,Set.'Set.singleton' 2), (2,Set.'Set.empty')]     -- @-    am :: AM.AdjacencyMap a } deriving (Eq, NFData, Ord)+    am :: AM.AdjacencyMap a } deriving (Eq, Generic, NFData, Ord)  -- | __Note:__ this does not satisfy the usual ring laws; see 'AdjacencyMap' for -- more details.

@@ -1,8 +1,7 @@-{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation.Internal--- Copyright  : (c) Andrey Mokhov 2016-2018+-- Copyright  : (c) Andrey Mokhov 2016-2019 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : unstable@@ -102,26 +101,27 @@ Here are a few examples:  @'vertex' 1 < 'vertex' 2-'vertex' 3 < 'Algebra.Graph.AdjacencyMap.edge' 1 2-'vertex' 1 < 'Algebra.Graph.AdjacencyMap.edge' 1 1-'Algebra.Graph.AdjacencyMap.edge' 1 1 < 'Algebra.Graph.AdjacencyMap.edge' 1 2-'Algebra.Graph.AdjacencyMap.edge' 1 2 < 'Algebra.Graph.AdjacencyMap.edge' 1 1 + 'Algebra.Graph.AdjacencyMap.edge' 2 2-'Algebra.Graph.AdjacencyMap.edge' 1 2 < 'Algebra.Graph.AdjacencyMap.edge' 1 3@+'vertex' 3 < 'Algebra.Graph.Relation.edge' 1 2+'vertex' 1 < 'Algebra.Graph.Relation.edge' 1 1+'Algebra.Graph.Relation.edge' 1 1 < 'Algebra.Graph.Relation.edge' 1 2+'Algebra.Graph.Relation.edge' 1 2 < 'Algebra.Graph.Relation.edge' 1 1 + 'Algebra.Graph.Relation.edge' 2 2+'Algebra.Graph.Relation.edge' 1 2 < 'Algebra.Graph.Relation.edge' 1 3@ -Note that the resulting order refines the 'isSubgraphOf' relation and is-compatible with 'overlay' and 'connect' operations:+Note that the resulting order refines the+'Algebra.Graph.Relation.isSubgraphOf' relation and is compatible with+'overlay' and 'connect' operations: -@'Algebra.Graph.AdjacencyMap.isSubgraphOf' x y ==> x <= y@+@'Algebra.Graph.Relation.isSubgraphOf' x y ==> x <= y@  @'empty' <= x x     <= x + y x + y <= x * y@ -} data Relation a = Relation {-    -- | The /domain/ of the relation.+    -- | The /domain/ of the relation. Complexity: /O(1)/ time and memory.     domain :: Set a,     -- | The set of pairs of elements that are /related/. It is guaranteed that-    -- each element belongs to the domain.+    -- each element belongs to the domain. Complexity: /O(1)/ time and memory.     relation :: Set (a, a)   } deriving Eq 

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation.InternalDerived--- Copyright  : (c) Andrey Mokhov 2016-2018+-- Copyright  : (c) Andrey Mokhov 2016-2019 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : unstable@@ -14,16 +14,13 @@ ----------------------------------------------------------------------------- module Algebra.Graph.Relation.InternalDerived (     -- * Implementation of derived binary relations-    ReflexiveRelation (..), SymmetricRelation (..), TransitiveRelation (..),-    PreorderRelation (..)+    ReflexiveRelation (..), TransitiveRelation (..), PreorderRelation (..)   ) where - import Control.DeepSeq (NFData (..))  import Algebra.Graph.Class-import Algebra.Graph.Relation (Relation, reflexiveClosure, symmetricClosure,-                               transitiveClosure, closure)+import Algebra.Graph.Relation (Relation, reflexiveClosure, transitiveClosure, closure)  {-| The 'ReflexiveRelation' data type represents a /reflexive binary relation/ over a set of elements. Reflexive relations satisfy all laws of the@@ -54,38 +51,6 @@  instance Ord a => Reflexive (ReflexiveRelation a) --- TODO: Optimise the implementation by caching the results of symmetric closure.-{-|  The 'SymmetricRelation' data type represents a /symmetric binary relation/-over a set of elements. Symmetric relations satisfy all laws of the-'Undirected' type class and, in particular, the-commutativity of connect:--@'connect' x y == 'connect' y x@--The 'Show' instance produces symmetrically closed expressions:--@show (1     :: SymmetricRelation Int) == "vertex 1"-show (1 * 2 :: SymmetricRelation Int) == "edges [(1,2),(2,1)]"@--}-newtype SymmetricRelation a = SymmetricRelation { fromSymmetric :: Relation a }-    deriving (Num, NFData)--instance Ord a => Eq (SymmetricRelation a) where-    x == y = symmetricClosure (fromSymmetric x) == symmetricClosure (fromSymmetric y)--instance (Ord a, Show a) => Show (SymmetricRelation a) where-    show = show . symmetricClosure . fromSymmetric---- TODO: To be derived automatically using GeneralizedNewtypeDeriving in GHC 8.2-instance Ord a => Graph (SymmetricRelation a) where-    type Vertex (SymmetricRelation a) = a-    empty       = SymmetricRelation empty-    vertex      = SymmetricRelation . vertex-    overlay x y = SymmetricRelation $ fromSymmetric x `overlay` fromSymmetric y-    connect x y = SymmetricRelation $ fromSymmetric x `connect` fromSymmetric y--instance Ord a => Undirected (SymmetricRelation a)- -- TODO: Optimise the implementation by caching the results of transitive closure. {-| The 'TransitiveRelation' data type represents a /transitive binary relation/ over a set of elements. Transitive relations satisfy all laws of the@@ -162,3 +127,4 @@ instance Ord a => Reflexive  (PreorderRelation a) instance Ord a => Transitive (PreorderRelation a) instance Ord a => Preorder   (PreorderRelation a)+

@@ -1,37 +1,462 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation.Symmetric--- Copyright  : (c) Andrey Mokhov 2016-2018+-- Copyright  : (c) Andrey Mokhov 2016-2019 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental ----- An abstract implementation of symmetric binary relations. Use--- "Algebra.Graph.Class" for polymorphic construction and manipulation.+-- An abstract implementation of symmetric binary relations. To avoid name+-- clashes with "Algebra.Graph.Relation", this module can be imported qualified:+--+-- @+-- import qualified Algebra.Graph.Relation.Symmetric as Symmetric+-- @+--+-- 'Relation' is an instance of the 'Algebra.Graph.Class.Graph' type+-- class, which can be used for polymorphic graph construction and manipulation. ----------------------------------------------------------------------------- module Algebra.Graph.Relation.Symmetric (     -- * Data structure-    SymmetricRelation, fromRelation, toRelation,+    Relation, toSymmetric, fromSymmetric, +    -- * Basic graph construction primitives+    empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,++    -- * Relations on graphs+    isSubgraphOf,+     -- * Graph properties-    neighbours+    isEmpty, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, edgeList,+    adjacencyList, vertexSet, edgeSet, neighbours,++    -- * Standard families of graphs+    path, circuit, clique, biclique, star, stars, tree, forest,++    -- * Graph transformation+    removeVertex, removeEdge, replaceVertex, mergeVertices, gmap, induce,   ) where -import Algebra.Graph.Relation-import Algebra.Graph.Relation.InternalDerived+import Algebra.Graph.Relation.Symmetric.Internal+import Data.Set (Set)+import Data.Tree+import Data.Tuple  import qualified Data.Set as Set --- | Construct a symmetric relation from a 'Relation'.--- Complexity: /O(1)/ time.-fromRelation :: Relation a -> SymmetricRelation a-fromRelation = SymmetricRelation+import qualified Algebra.Graph.Relation          as R+import qualified Algebra.Graph.Relation.Internal as RI --- | Extract the underlying relation.+-- | Construct a symmetric relation from a given "Algebra.Graph.Relation". -- Complexity: /O(m*log(m))/ time.-toRelation :: Ord a => SymmetricRelation a -> Relation a-toRelation = symmetricClosure . fromSymmetric+--+-- @+-- toSymmetric ('Algebra.Graph.Relation.edge' 1 2)         == 'edge' 1 2+-- toSymmetric . 'fromSymmetric'    == id+-- 'fromSymmetric'    . toSymmetric == 'Algebra.Graph.Relation.symmetricClosure'+-- 'vertexCount'      . toSymmetric == 'Algebra.Graph.Relation.vertexCount'+-- (*2) . 'edgeCount' . toSymmetric >= 'Algebra.Graph.Relation.edgeCount'+-- @+toSymmetric :: Ord a => R.Relation a -> Relation a+toSymmetric = SR . R.symmetricClosure +-- | Construct the graph comprising /a single edge/.+-- Complexity: /O(1)/ time, memory and size.+--+-- @+-- edge x y               == 'connect' ('vertex' x) ('vertex' y)+-- edge x y               == 'edge' y x+-- edge x y               == 'edges' [(x,y), (y,x)]+-- 'hasEdge' x y (edge x y) == True+-- 'edgeCount'   (edge x y) == 1+-- 'vertexCount' (edge 1 1) == 1+-- 'vertexCount' (edge 1 2) == 2+-- @+edge :: Ord a => a -> a -> Relation a+edge x y = SR $ RI.Relation (Set.fromList [x, y]) (Set.fromList [(x,y), (y,x)])++-- | 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] -> Relation a+vertices = SR . R.vertices++-- TODO: Optimise by avoiding multiple list traversal.+-- | Construct the graph from a list of edges.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- edges []             == 'empty'+-- edges [(x,y)]        == 'edge' x y+-- edges [(x,y), (y,x)] == 'edge' x y+-- @+edges :: Ord a => [(a, a)] -> Relation a+edges es = SR $ RI.Relation+    (Set.fromList $ uncurry (++) $ unzip es) (Set.fromList (es ++ map swap es))++-- | Overlay a given list of graphs.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- overlays []        == 'empty'+-- overlays [x]       == x+-- overlays [x,y]     == 'overlay' x y+-- overlays           == 'foldr' 'overlay' 'empty'+-- 'isEmpty' . overlays == 'all' 'isEmpty'+-- @+overlays :: Ord a => [Relation a] -> Relation a+overlays = SR . R.overlays . map fromSymmetric++-- | Connect a given list of graphs.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- connects []        == 'empty'+-- connects [x]       == x+-- connects [x,y]     == 'connect' x y+-- connects           == 'foldr' 'connect' 'empty'+-- 'isEmpty' . connects == 'all' 'isEmpty'+-- connects           == connects . 'reverse'+-- @+connects :: Ord a => [Relation a] -> Relation a+connects = foldr connect empty++-- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the+-- first graph is a /subgraph/ of the second.+-- Complexity: /O((n + m) * log(n))/ time.+--+-- @+-- isSubgraphOf 'empty'         x             ==  True+-- isSubgraphOf ('vertex' x)    'empty'         ==  False+-- isSubgraphOf x             ('overlay' x y) ==  True+-- isSubgraphOf ('overlay' x y) ('connect' x y) ==  True+-- isSubgraphOf ('path' xs)     ('circuit' xs)  ==  True+-- isSubgraphOf ('edge' x y)    ('edge' y x)    ==  True+-- isSubgraphOf x y                         ==> x <= y+-- @+isSubgraphOf :: Ord a => Relation a -> Relation a -> Bool+isSubgraphOf x y = R.isSubgraphOf (fromSymmetric x) (fromSymmetric y)++-- | Check if a relation is empty.+-- Complexity: /O(1)/ time.+--+-- @+-- isEmpty 'empty'                       == True+-- isEmpty ('overlay' 'empty' 'empty')       == True+-- isEmpty ('vertex' x)                  == False+-- isEmpty ('removeVertex' x $ 'vertex' x) == True+-- isEmpty ('removeEdge' x y $ 'edge' x y) == False+-- @+isEmpty :: Relation a -> Bool+isEmpty = R.isEmpty . fromSymmetric++-- | 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 -> Relation a -> Bool+hasVertex x = R.hasVertex x . fromSymmetric++-- | 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 x y ('edge' x y)       == True+-- hasEdge x y ('edge' y x)       == True+-- hasEdge x y . 'removeEdge' x y == 'const' False+-- hasEdge x y                  == 'elem' (min x y, max x y) . 'edgeList'+-- @+hasEdge :: Ord a => a -> a -> Relation a -> Bool+hasEdge x y = R.hasEdge x y . fromSymmetric++-- | 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 :: Relation a -> Int+vertexCount = R.vertexCount . fromSymmetric++-- | The number of edges in a graph.+-- Complexity: /O(1)/ time.+--+-- @+-- edgeCount 'empty'      == 0+-- edgeCount ('vertex' x) == 0+-- edgeCount ('edge' x y) == 1+-- edgeCount            == 'length' . 'edgeList'+-- @+edgeCount :: Ord a => Relation a -> Int+edgeCount = length . 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 :: Relation a -> [a]+vertexList = R.vertexList . fromSymmetric++-- | The sorted list of edges of a graph, where edge vertices appear in the+-- non-decreasing order.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- Note: If you need the sorted list of edges where an edge appears in both+-- directions, use @'Algebra.Graph.Relation.edgeList' . 'fromSymmetric'@.+--+-- @+-- edgeList 'empty'          == []+-- edgeList ('vertex' x)     == []+-- edgeList ('edge' x y)     == [(min x y, max y x)]+-- edgeList ('star' 2 [3,1]) == [(1,2), (2,3)]+-- @+edgeList :: Ord a => Relation a -> [(a, a)]+edgeList = Set.toAscList . edgeSet++-- | The set of vertices of a given graph.+-- Complexity: /O(1)/ time.+--+-- @+-- vertexSet 'empty'      == Set.'Set.empty'+-- vertexSet . 'vertex'   == Set.'Set.singleton'+-- vertexSet . 'vertices' == Set.'Set.fromList'+-- @+vertexSet :: Relation a -> Set a+vertexSet = R.vertexSet . fromSymmetric++-- | The sorted /adjacency list/ of a graph.+-- Complexity: /O(n + m)/ time and /O(m)/ memory.+--+-- @+-- adjacencyList 'empty'          == []+-- adjacencyList ('vertex' x)     == [(x, [])]+-- adjacencyList ('edge' 1 2)     == [(1, [2]), (2, [1])]+-- adjacencyList ('star' 2 [3,1]) == [(1, [2]), (2, [1,3]), (3, [2])]+-- 'stars' . adjacencyList        == id+-- @+adjacencyList :: Eq a => Relation a -> [(a, [a])]+adjacencyList = R.adjacencyList . fromSymmetric++-- | The /path/ on a list of vertices.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- path []    == 'empty'+-- path [x]   == 'vertex' x+-- path [x,y] == 'edge' x y+-- path       == path . 'reverse'+-- @+path :: Ord a => [a] -> Relation a+path xs = case xs of []     -> empty+                     [x]    -> vertex x+                     (_:ys) -> edges (zip xs ys)++-- | The /circuit/ on a list of vertices.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- circuit []    == 'empty'+-- circuit [x]   == 'edge' x x+-- circuit [x,y] == 'edge' x y+-- circuit       == circuit . 'reverse'+-- @+circuit :: Ord a => [a] -> Relation a+circuit []     = empty+circuit (x:xs) = path $ [x] ++ xs ++ [x]++-- | The /clique/ on a list of vertices.+-- Complexity: /O((n + m) * log(n))/ time + /O(m*log(m)) time from computing the symmetricClosure and /O(n + m)/ memory.+--+-- @+-- clique []         == 'empty'+-- clique [x]        == 'vertex' x+-- clique [x,y]      == 'edge' x y+-- clique [x,y,z]    == 'edges' [(x,y), (x,z), (y,z)]+-- clique (xs ++ ys) == 'connect' (clique xs) (clique ys)+-- clique            == clique . 'reverse'+-- @+clique :: Ord a => [a] -> Relation a+clique = SR . R.symmetricClosure . R.clique++-- | The /biclique/ on two lists of vertices.+-- Complexity: /O(n * log(n) + m)/ time + /O(m*log(m)) time from computing the symmetricClosure and /O(n + m)/ memory.+--+-- @+-- biclique []      []      == 'empty'+-- biclique [x]     []      == 'vertex' x+-- biclique []      [y]     == 'vertex' y+-- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,x2), (x2,y2)]+-- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys)+-- @+biclique :: Ord a => [a] -> [a] -> Relation a+biclique xs = SR . R.symmetricClosure . R.biclique xs++-- TODO: Optimise.+-- | The /star/ formed by a centre vertex connected to a list of leaves.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- star x []    == 'vertex' x+-- star x [y]   == 'edge' x y+-- star x [y,z] == 'edges' [(x,y), (x,z)]+-- star x ys    == 'connect' ('vertex' x) ('vertices' ys)+-- @+star :: Ord a => a -> [a] -> Relation a+star x [] = vertex x+star x ys = connect (vertex x) (vertices ys)++-- | The /stars/ formed by overlaying a list of 'star's. An inverse of+-- 'adjacencyList'.+-- Complexity: /O(L * log(n))/ time, memory and size, where /L/ is the total+-- size of the input.+--+-- @+-- stars []                      == 'empty'+-- stars [(x, [])]               == 'vertex' x+-- stars [(x, [y])]              == 'edge' x y+-- stars [(x, ys)]               == 'star' x ys+-- stars                         == 'overlays' . 'map' ('uncurry' 'star')+-- stars . 'adjacencyList'         == id+-- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys)+-- @+stars :: Ord a => [(a, [a])] -> Relation a+stars as = SR $ RI.Relation (Set.fromList vs) (Set.fromList es)+  where+    vs = concatMap (uncurry (:)) as+    es = [ (x, y) | (x, ys) <- as, y <- ys ] ++ [ (y, x) | (x, ys) <- as, y <- ys ]++-- | The /tree graph/ constructed from a given 'Tree.Tree' data structure.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- tree (Node x [])                                         == 'vertex' x+-- tree (Node x [Node y [Node z []]])                       == 'path' [x,y,z]+-- tree (Node x [Node y [], Node z []])                     == 'star' x [y,z]+-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]+-- @+tree :: Ord a => Tree a -> Relation a+tree (Node x []) = vertex x+tree (Node x f ) = star x (map rootLabel f)+    `overlay` forest (filter (not . null . subForest) f)++-- | The /forest graph/ constructed from a given 'Tree.Forest' data structure.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- forest []                                                  == 'empty'+-- forest [x]                                                 == 'tree' x+-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]+-- forest                                                     == 'overlays' . 'map' 'tree'+-- @+forest :: Ord a => Forest a -> Relation a+forest = overlays . map tree++-- | Remove a vertex from a given graph.+-- Complexity: /O(n + m)/ time.+--+-- @+-- removeVertex x ('vertex' x)       == 'empty'+-- removeVertex 1 ('vertex' 2)       == 'vertex' 2+-- removeVertex x ('edge' x x)       == 'empty'+-- removeVertex 1 ('edge' 1 2)       == 'vertex' 2+-- removeVertex x . removeVertex x == removeVertex x+-- @+removeVertex :: Ord a => a -> Relation a -> Relation a+removeVertex x = SR . R.removeVertex x . fromSymmetric++-- | Remove an edge from a given graph.+-- Complexity: /O(log(m))/ time.+--+-- @+-- removeEdge x y ('edge' x y)       == 'vertices' [x,y]+-- removeEdge x y . removeEdge x y == removeEdge x y+-- removeEdge x y                  == removeEdge y x+-- removeEdge x y . 'removeVertex' x == 'removeVertex' x+-- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2+-- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2+-- @+removeEdge :: Ord a => a -> a -> Relation a -> Relation a+removeEdge x y r = SR $ RI.Relation d (Set.delete (y, x) $ Set.delete (x, y) rr)+  where+    RI.Relation d rr = fromSymmetric r++-- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a+-- given 'Relation'. If @y@ already exists, @x@ and @y@ will be merged.+-- Complexity: /O((n + m) * log(n))/ time.+--+-- @+-- replaceVertex x x            == id+-- replaceVertex x y ('vertex' x) == 'vertex' y+-- replaceVertex x y            == 'mergeVertices' (== x) y+-- @+replaceVertex :: Ord a => a -> a -> Relation a -> Relation a+replaceVertex u v = gmap $ \w -> if w == u then v else w++-- | Merge vertices satisfying a given predicate into a given vertex.+-- Complexity: /O((n + m) * log(n))/ time, assuming that the predicate takes+-- /O(1)/ to be evaluated.+--+-- @+-- mergeVertices ('const' False) x    == id+-- mergeVertices (== x) y           == 'replaceVertex' x y+-- mergeVertices 'even' 1 (0 * 2)     == 1 * 1+-- mergeVertices 'odd'  1 (3 + 4 * 5) == 4 * 1+-- @+mergeVertices :: Ord a => (a -> Bool) -> a -> Relation a -> Relation a+mergeVertices p v = gmap $ \u -> if p u then v else u++-- | Transform a graph by applying a function to each of its vertices. This is+-- similar to @Functor@'s 'fmap' but can be used with non-fully-parametric+-- 'Relation'.+-- Complexity: /O((n + m) * log(n))/ time.+--+-- @+-- gmap f 'empty'      == 'empty'+-- gmap f ('vertex' x) == 'vertex' (f x)+-- gmap f ('edge' x y) == 'edge' (f x) (f y)+-- gmap id           == id+-- gmap f . gmap g   == gmap (f . g)+-- @+gmap :: Ord b => (a -> b) -> Relation a -> Relation b+gmap f = SR . R.gmap f . fromSymmetric++-- | 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)+-- 'isSubgraphOf' (induce p x) x == True+-- @+induce :: (a -> Bool) -> Relation a -> Relation a+induce p = SR . R.induce p . fromSymmetric+ -- | The set of /neighbours/ of an element @x@ is the set of elements that are -- related to it, i.e. @neighbours x == { a | aRx }@. In the context of undirected -- graphs, this corresponds to the set of /adjacent/ vertices of vertex @x@.@@ -42,5 +467,5 @@ -- neighbours x ('Algebra.Graph.Class.edge' x y) == Set.'Set.fromList' [y] -- neighbours y ('Algebra.Graph.Class.edge' x y) == Set.'Set.fromList' [x] -- @-neighbours :: Ord a => a -> SymmetricRelation a -> Set.Set a-neighbours x = postSet x . toRelation+neighbours :: Ord a => a -> Relation a -> Set a+neighbours x = R.postSet x . fromSymmetric

@@ -0,0 +1,215 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Relation.Symmetric.Internal+-- Copyright  : (c) Andrey Mokhov 2016-2019+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : unstable+--+-- This module exposes the implementation of symmetric binary relation data type.+-- The API is unstable and unsafe, and is exposed only for documentation. You+-- should use the non-internal module "Algebra.Graph.Relation.Symmetric" instead.+-----------------------------------------------------------------------------++module Algebra.Graph.Relation.Symmetric.Internal (+    -- * Implementation of symmetric binary relations+    Relation (..), fromSymmetric, empty, vertex, overlay, connect, edgeSet,+    consistent+  ) where++import Algebra.Graph.Internal+import Control.DeepSeq+import Data.Monoid (mconcat)+import Data.Set (Set)++import qualified Data.Set as Set++import qualified Algebra.Graph.Relation.Internal as RI+import qualified Algebra.Graph.Relation          as R++{-| This data type represents a /symmetric binary relation/ over a set of+elements of type @a@. Symmetric relations satisfy all laws of the+'Algebra.Graph.Class.Undirected' type class, including the commutativity of+'connect':++@'connect' x y == 'connect' y x@++The 'Show' instance lists edge vertices in non-decreasing order:++@show (empty     :: Relation Int) == "empty"+show (1         :: Relation Int) == "vertex 1"+show (1 + 2     :: Relation Int) == "vertices [1,2]"+show (1 * 2     :: Relation Int) == "edge 1 2"+show (2 * 1     :: Relation Int) == "edge 1 2"+show (1 * 2 * 1 :: Relation Int) == "edges [(1,1),(1,2)]"+show (3 * 2 * 1 :: Relation Int) == "edges [(1,2),(1,3),(2,3)]"+show (1 * 2 + 3 :: Relation Int) == "overlay (vertex 3) (edge 1 2)"@++The total order on graphs is defined using /size-lexicographic/ comparison:++* Compare the number of vertices. In case of a tie, continue.+* Compare the sets of vertices. In case of a tie, continue.+* Compare the number of edges. In case of a tie, continue.+* Compare the sets of edges.++Here are a few examples:++@'vertex' 1 < 'vertex' 2+'vertex' 3 < 'Algebra.Graph.Relation.Symmetric.edge' 1 2+'vertex' 1 < 'Algebra.Graph.Relation.Symmetric.edge' 1 1+'Algebra.Graph.Relation.Symmetric.edge' 1 1 < 'Algebra.Graph.Relation.Symmetric.edge' 1 2+'Algebra.Graph.Relation.Symmetric.edge' 1 2 < 'Algebra.Graph.Relation.Symmetric.edge' 1 1 + 'Algebra.Graph.Relation.Symmetric.edge' 2 2+'Algebra.Graph.Relation.Symmetric.edge' 2 1 < 'Algebra.Graph.Relation.Symmetric.edge' 1 3@++@'Algebra.Graph.Relation.Symmetric.edge' 1 2 == 'Algebra.Graph.Relation.Symmetric.edge' 2 1@++Note that the resulting order refines the+'Algebra.Graph.Relation.Symmetric.isSubgraphOf' relation and is compatible with+'overlay' and 'connect' operations:++@'Algebra.Graph.Relation.Symmetric.isSubgraphOf' x y ==> x <= y@++@'empty' <= x+x     <= x + y+x + y <= x * y@+-}+newtype Relation a = SR (RI.Relation a) deriving NFData++instance Ord a => Eq (Relation a) where+    x == y = fromSymmetric x == fromSymmetric y++instance (Ord a, Show a) => Show (Relation a) where+    show r@(SR (RI.Relation d _)) = show (RI.Relation d $ edgeSet r)++instance Ord a => Ord (Relation a) where+    compare rx@(SR (RI.Relation vx _)) ry@(SR (RI.Relation vy _)) = mconcat+        [ compare (Set.size vx) (Set.size vy)+        , compare vx            vy+        , compare (Set.size ex) (Set.size ey)+        , compare ex            ey ]+      where+        ex = edgeSet rx+        ey = edgeSet ry++instance (Ord a, Num a) => Num (Relation a) where+    fromInteger = vertex . fromInteger+    (+)         = overlay+    (*)         = connect+    signum      = const empty+    abs         = id+    negate      = id++-- | Extract the underlying symmetric "Algebra.Graph.Relation".+-- Complexity: /O(1)/ time and memory.+--+-- @+-- fromSymmetric ('Algebra.Graph.Relation.Symmetric.edge' 1 2)    == 'Algebra.Graph.Relation.edges' [(1,2), (2,1)]+-- 'Algebra.Graph.Relation.vertexCount' . fromSymmetric == 'Algebra.Graph.Relation.Symmetric.vertexCount'+-- 'Algebra.Graph.Relation.edgeCount'   . fromSymmetric <= (*2) . 'Algebra.Graph.Relation.Symmetric.edgeCount'+-- @+fromSymmetric :: Relation a -> RI.Relation a+fromSymmetric (SR x) = x++-- | Construct the /empty graph/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'Algebra.Graph.Relation.Symmetric.isEmpty'     empty == True+-- 'Algebra.Graph.Relation.Symmetric.hasVertex' x empty == False+-- 'Algebra.Graph.Relation.Symmetric.vertexCount' empty == 0+-- 'Algebra.Graph.Relation.Symmetric.edgeCount'   empty == 0+-- @+empty :: Relation a+empty = SR $ RI.Relation Set.empty Set.empty++-- | Construct the graph comprising /a single isolated vertex/.+-- Complexity: /O(1)/ time and memory.+--+-- @+-- 'Algebra.Graph.Relation.Symmetric.isEmpty'     (vertex x) == False+-- 'Algebra.Graph.Relation.Symmetric.hasVertex' x (vertex x) == True+-- 'Algebra.Graph.Relation.Symmetric.vertexCount' (vertex x) == 1+-- 'Algebra.Graph.Relation.Symmetric.edgeCount'   (vertex x) == 0+-- @+vertex :: a -> Relation a+vertex x = SR $ RI.Relation (Set.singleton x) Set.empty++-- | /Overlay/ two graphs. This is a commutative, associative and idempotent+-- operation with the identity 'empty'.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.+--+-- @+-- 'Algebra.Graph.Relation.Symmetric.isEmpty'     (overlay x y) == 'Algebra.Graph.Relation.Symmetric.isEmpty'   x   && 'Algebra.Graph.Relation.Symmetric.isEmpty'   y+-- 'Algebra.Graph.Relation.Symmetric.hasVertex' z (overlay x y) == 'Algebra.Graph.Relation.Symmetric.hasVertex' z x || 'Algebra.Graph.Relation.Symmetric.hasVertex' z y+-- 'Algebra.Graph.Relation.Symmetric.vertexCount' (overlay x y) >= 'Algebra.Graph.Relation.Symmetric.vertexCount' x+-- 'Algebra.Graph.Relation.Symmetric.vertexCount' (overlay x y) <= 'Algebra.Graph.Relation.Symmetric.vertexCount' x + 'Algebra.Graph.Relation.Symmetric.vertexCount' y+-- 'Algebra.Graph.Relation.Symmetric.edgeCount'   (overlay x y) >= 'Algebra.Graph.Relation.Symmetric.edgeCount' x+-- 'Algebra.Graph.Relation.Symmetric.edgeCount'   (overlay x y) <= 'Algebra.Graph.Relation.Symmetric.edgeCount' x   + 'Algebra.Graph.Relation.Symmetric.edgeCount' y+-- 'Algebra.Graph.Relation.Symmetric.vertexCount' (overlay 1 2) == 2+-- 'Algebra.Graph.Relation.Symmetric.edgeCount'   (overlay 1 2) == 0+-- @+overlay :: Ord a => Relation a -> Relation a -> Relation a+overlay (SR x) (SR y) = SR $ RI.Relation (R.domain   x `Set.union` R.domain   y)+                                         (R.relation x `Set.union` R.relation y)++-- | /Connect/ two graphs. This is a commutative and associative operation with+-- the identity 'empty', which distributes over 'overlay' and obeys the+-- decomposition axiom.+-- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. Note that the+-- number of edges in the resulting graph is quadratic with respect to the number+-- of vertices of the arguments: /m = O(m1 + m2 + n1 * n2)/.+--+-- @+-- connect x y               == connect y x+-- 'Algebra.Graph.Relation.Symmetric.isEmpty'     (connect x y) == 'Algebra.Graph.Relation.Symmetric.isEmpty'   x   && 'Algebra.Graph.Relation.Symmetric.isEmpty'   y+-- 'Algebra.Graph.Relation.Symmetric.hasVertex' z (connect x y) == 'Algebra.Graph.Relation.Symmetric.hasVertex' z x || 'Algebra.Graph.Relation.Symmetric.hasVertex' z y+-- 'Algebra.Graph.Relation.Symmetric.vertexCount' (connect x y) >= 'Algebra.Graph.Relation.Symmetric.vertexCount' x+-- 'Algebra.Graph.Relation.Symmetric.vertexCount' (connect x y) <= 'Algebra.Graph.Relation.Symmetric.vertexCount' x + 'Algebra.Graph.Relation.Symmetric.vertexCount' y+-- 'Algebra.Graph.Relation.Symmetric.edgeCount'   (connect x y) >= 'Algebra.Graph.Relation.Symmetric.edgeCount' x+-- 'Algebra.Graph.Relation.Symmetric.edgeCount'   (connect x y) >= 'Algebra.Graph.Relation.Symmetric.edgeCount' y+-- 'Algebra.Graph.Relation.Symmetric.edgeCount'   (connect x y) >= 'Algebra.Graph.Relation.Symmetric.vertexCount' x * 'Algebra.Graph.Relation.Symmetric.vertexCount' y \`div\` 2+-- 'Algebra.Graph.Relation.Symmetric.vertexCount' (connect 1 2) == 2+-- 'Algebra.Graph.Relation.Symmetric.edgeCount'   (connect 1 2) == 1+-- @+connect :: Ord a => Relation a -> Relation a -> Relation a+connect (SR x) (SR y) = SR $ RI.Relation (R.domain x `Set.union` R.domain y)+    (Set.unions [R.relation x, R.relation y, R.domain x `setProduct` R.domain y+                                           , R.domain y `setProduct` R.domain x ])++-- | The set of edges of a given graph, where edge vertices appear in the+-- non-decreasing order.+-- Complexity: /O(m)/ time.+--+-- Note: If you need the set of edges where an edge appears in both directions,+-- use @'Algebra.Graph.Relation.relation' . 'fromSymmetric'@. The latter is much+-- faster than this function, and takes only /O(1)/ time and memory.+--+-- @+-- edgeSet 'empty'      == Set.'Set.empty'+-- edgeSet ('vertex' x) == Set.'Set.empty'+-- edgeSet ('Algebra.Graph.Relation.Symmetric.edge' x y) == Set.'Set.singleton' (min x y, max x y)+-- @+edgeSet :: Ord a => Relation a -> Set (a, a)+edgeSet (SR (RI.Relation _ r)) = Set.filter (uncurry (<=)) r++-- | Check if the internal representation of a symmetric relation is consistent,+-- i.e. if (i) all pairs of elements in the 'RI.relation' refer to existing+-- elements in the 'RI.domain', and (ii) all edges have their symmetric+-- counterparts. It should be impossible to create an inconsistent 'Relation',+-- and we use this function in testing.+-- /Note: this function is for internal use only/.+--+-- @+-- consistent 'Algebra.Graph.Relation.Symmetric.empty'         == True+-- consistent ('Algebra.Graph.Relation.Symmetric.vertex' x)    == True+-- consistent ('Algebra.Graph.Relation.Symmetric.overlay' x y) == True+-- consistent ('Algebra.Graph.Relation.Symmetric.connect' x y) == True+-- consistent ('Algebra.Graph.Relation.Symmetric.edge' x y)    == True+-- consistent ('Algebra.Graph.Relation.Symmetric.edges' xs)    == True+-- consistent ('Algebra.Graph.Relation.Symmetric.stars' xs)    == True+-- @+consistent :: Ord a => Relation a -> Bool+consistent (SR r) =+    RI.referredToVertexSet (R.relation r) `Set.isSubsetOf` R.domain r+    &&+    r == R.transpose r

@@ -63,6 +63,7 @@ import qualified Algebra.Graph.AdjacencyIntMap.Algorithm      as AIM import qualified Algebra.Graph.AdjacencyIntMap.Internal       as AIM import qualified Algebra.Graph.Relation                       as R+import qualified Algebra.Graph.Relation.Symmetric             as SR import qualified Data.IntMap                                  as IntMap import qualified Data.IntSet                                  as IntSet import qualified Data.Map                                     as Map@@ -528,6 +529,7 @@     isTopSortOf x              = isTopSortOf x . NAM.am  -- TODO: Get rid of "Relation.Internal" and move this instance to "Relation".+-- | See "Algebra.Graph.Relation". instance Ord a => ToGraph (R.Relation a) where     type ToVertex (R.Relation a) = a     toGraph r                  = G.vertices (Set.toList $ R.domain   r) `G.overlay`@@ -553,3 +555,28 @@     toAdjacencyIntMap          = AIM.AM . adjacencyIntMap     toAdjacencyMapTranspose    = AM.transpose . toAdjacencyMap     toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap++-- TODO: This instance is probably wrong because of the way it treats edges.+-- Find out a better way to integrate undirected graphs into 'ToGraph'.+-- | See "Algebra.Graph.Symmetric.Relation". Warning: this instance is likely to+-- be modified or removed in future.+instance Ord a => ToGraph (SR.Relation a) where+    type ToVertex (SR.Relation a) = a+    toGraph                    = toGraph . SR.fromSymmetric+    isEmpty                    = SR.isEmpty+    hasVertex                  = SR.hasVertex+    hasEdge                    = SR.hasEdge+    vertexCount                = SR.vertexCount+    edgeCount                  = SR.edgeCount+    vertexList                 = SR.vertexList+    vertexSet                  = SR.vertexSet+    vertexIntSet               = IntSet.fromAscList . SR.vertexList+    edgeList                   = SR.edgeList+    edgeSet                    = SR.edgeSet+    adjacencyList              = SR.adjacencyList+    adjacencyMap               = adjacencyMap . SR.fromSymmetric+    adjacencyIntMap            = adjacencyIntMap . SR.fromSymmetric+    toAdjacencyMap             = AM.AM . adjacencyMap+    toAdjacencyIntMap          = AIM.AM . adjacencyIntMap+    toAdjacencyMapTranspose    = toAdjacencyMap+    toAdjacencyIntMapTranspose = toAdjacencyIntMap

@@ -15,11 +15,13 @@   ) where  import Data.Monoid (Any)+import Data.IntSet (IntSet)+import Data.Set (Set) import Data.Tree  import Algebra.Graph.Class (Graph (..)) -import qualified Algebra.Graph                       as Graph+import qualified Algebra.Graph                       as G import qualified Algebra.Graph.AdjacencyMap          as AM import qualified Algebra.Graph.Labelled              as LG import qualified Algebra.Graph.Labelled.AdjacencyMap as LAM@@ -27,10 +29,16 @@ import qualified Algebra.Graph.HigherKinded.Class    as HClass import qualified Algebra.Graph.AdjacencyIntMap       as AIM import qualified Algebra.Graph.Relation              as R-import qualified Data.Set                            as Set-import qualified Data.IntSet                         as IntSet+import qualified Algebra.Graph.Relation.Symmetric    as SR +import qualified Algebra.Graph.AdjacencyMap.Internal       as AMI+import qualified Algebra.Graph.AdjacencyIntMap.Internal    as AIMI+import qualified Algebra.Graph.Relation.Internal           as RI+import qualified Algebra.Graph.Relation.Symmetric.Internal as SRI+ class Graph g => GraphAPI g where+    consistent           :: g -> Bool+    consistent           = notImplemented     edge                 :: Vertex g -> Vertex g -> g     edge                 = notImplemented     vertices             :: [Vertex g] -> g@@ -41,14 +49,16 @@     overlays             = notImplemented     connects             :: [g] -> g     connects             = notImplemented-    fromAdjacencySets    :: [(Vertex g, Set.Set (Vertex g))] -> g+    fromAdjacencySets    :: [(Vertex g, Set (Vertex g))] -> g     fromAdjacencySets    = notImplemented-    fromAdjacencyIntSets :: [(Int, IntSet.IntSet)] -> g+    fromAdjacencyIntSets :: [(Int, IntSet)] -> g     fromAdjacencyIntSets = notImplemented     isSubgraphOf         :: g -> g -> Bool     isSubgraphOf         = notImplemented     (===)                :: g -> g -> Bool     (===)                = notImplemented+    neighbours           :: Vertex g -> g -> Set (Vertex g)+    neighbours           = notImplemented     path                 :: [Vertex g] -> g     path                 = notImplemented     circuit              :: [Vertex g] -> g@@ -108,6 +118,7 @@ notImplemented = error "Not implemented"  instance Ord a => GraphAPI (AM.AdjacencyMap a) where+    consistent        = AMI.consistent     edge              = AM.edge     vertices          = AM.vertices     edges             = AM.edges@@ -165,39 +176,40 @@     bind          = (>>=)     simplify      = Fold.simplify -instance Ord a => GraphAPI (Graph.Graph a) where-    edge          = Graph.edge-    vertices      = Graph.vertices-    edges         = Graph.edges-    overlays      = Graph.overlays-    connects      = Graph.connects-    isSubgraphOf  = Graph.isSubgraphOf-    (===)         = (Graph.===)-    path          = Graph.path-    circuit       = Graph.circuit-    clique        = Graph.clique-    biclique      = Graph.biclique-    star          = Graph.star-    stars         = Graph.stars-    tree          = Graph.tree-    forest        = Graph.forest-    mesh          = Graph.mesh-    torus         = Graph.torus-    deBruijn      = Graph.deBruijn-    removeVertex  = Graph.removeVertex-    removeEdge    = Graph.removeEdge-    replaceVertex = Graph.replaceVertex-    mergeVertices = Graph.mergeVertices-    splitVertex   = Graph.splitVertex-    transpose     = Graph.transpose+instance Ord a => GraphAPI (G.Graph a) where+    edge          = G.edge+    vertices      = G.vertices+    edges         = G.edges+    overlays      = G.overlays+    connects      = G.connects+    isSubgraphOf  = G.isSubgraphOf+    (===)         = (G.===)+    path          = G.path+    circuit       = G.circuit+    clique        = G.clique+    biclique      = G.biclique+    star          = G.star+    stars         = G.stars+    tree          = G.tree+    forest        = G.forest+    mesh          = G.mesh+    torus         = G.torus+    deBruijn      = G.deBruijn+    removeVertex  = G.removeVertex+    removeEdge    = G.removeEdge+    replaceVertex = G.replaceVertex+    mergeVertices = G.mergeVertices+    splitVertex   = G.splitVertex+    transpose     = G.transpose     gmap          = fmap-    induce        = Graph.induce-    compose       = Graph.compose+    induce        = G.induce+    compose       = G.compose     bind          = (>>=)-    simplify      = Graph.simplify-    box           = Graph.box+    simplify      = G.simplify+    box           = G.box  instance GraphAPI AIM.AdjacencyIntMap where+    consistent           = AIMI.consistent     edge                 = AIM.edge     vertices             = AIM.vertices     edges                = AIM.edges@@ -227,6 +239,7 @@     transitiveClosure    = AIM.transitiveClosure  instance Ord a => GraphAPI (R.Relation a) where+    consistent        = RI.consistent     edge              = R.edge     vertices          = R.vertices     edges             = R.edges@@ -253,6 +266,31 @@     reflexiveClosure  = R.reflexiveClosure     symmetricClosure  = R.symmetricClosure     transitiveClosure = R.transitiveClosure++instance Ord a => GraphAPI (SR.Relation a) where+    consistent        = SRI.consistent+    edge              = SR.edge+    vertices          = SR.vertices+    edges             = SR.edges+    overlays          = SR.overlays+    connects          = SR.connects+    isSubgraphOf      = SR.isSubgraphOf+    neighbours        = SR.neighbours+    path              = SR.path+    circuit           = SR.circuit+    clique            = SR.clique+    biclique          = SR.biclique+    star              = SR.star+    stars             = SR.stars+    tree              = SR.tree+    forest            = SR.forest+    removeVertex      = SR.removeVertex+    removeEdge        = SR.removeEdge+    replaceVertex     = SR.replaceVertex+    mergeVertices     = SR.mergeVertices+    transpose         = id+    gmap              = SR.gmap+    induce            = SR.induce  instance Ord a => GraphAPI (LG.Graph Any a) where     vertices     = LG.vertices

@@ -14,7 +14,6 @@   ) where  import Algebra.Graph.AdjacencyIntMap-import Algebra.Graph.AdjacencyIntMap.Internal import Algebra.Graph.Test import Algebra.Graph.Test.Generic @@ -26,9 +25,7 @@     putStrLn "\n============ AdjacencyIntMap ============"     test "Axioms of graphs" (axioms :: GraphTestsuite AdjacencyIntMap) -    test "Consistency of arbitraryAdjacencyMap" $ \m ->-        consistent m-+    testConsistent           t     testShow                 t     testBasicPrimitives      t     testFromAdjacencyIntSets t

@@ -18,7 +18,6 @@  import Algebra.Graph.AdjacencyMap import Algebra.Graph.AdjacencyMap.Algorithm-import Algebra.Graph.AdjacencyMap.Internal import Algebra.Graph.Test import Algebra.Graph.Test.Generic @@ -34,9 +33,7 @@     putStrLn "\n============ AdjacencyMap ============"     test "Axioms of graphs" (axioms :: GraphTestsuite AI) -    test "Consistency of arbitraryAdjacencyMap" $ \(m :: AI) ->-        consistent m-+    testConsistent        t     testShow              t     testBasicPrimitives   t     testFromAdjacencySets t

@@ -18,7 +18,8 @@ import Prelude.Compat  import Control.Monad-import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty (NonEmpty (..), toList)+import Data.Maybe (catMaybes) import Data.Tree import Test.QuickCheck @@ -28,17 +29,19 @@ import Algebra.Graph.Export import Algebra.Graph.Fold (Fold) import Algebra.Graph.Label-import Algebra.Graph.Relation.Internal import Algebra.Graph.Relation.InternalDerived+import Algebra.Graph.Relation.Symmetric.Internal  import qualified Algebra.Graph.AdjacencyIntMap       as AdjacencyIntMap import qualified Algebra.Graph.AdjacencyMap          as AdjacencyMap import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NAM import qualified Algebra.Graph.Class                 as C+import qualified Algebra.Graph.Fold                  as Fold import qualified Algebra.Graph.Labelled              as LG import qualified Algebra.Graph.Labelled.AdjacencyMap as LAM import qualified Algebra.Graph.NonEmpty              as NonEmpty import qualified Algebra.Graph.Relation              as Relation+import qualified Algebra.Graph.Relation.Symmetric    as Symmetric  -- | Generate an arbitrary 'C.Graph' value of a specified size. arbitraryGraph :: (C.Graph g, Arbitrary (C.Vertex g)) => Gen g@@ -61,10 +64,20 @@     shrink (Connect x y) = [Empty, x, y, Overlay x y]                         ++ [Connect x' y' | (x', y') <- shrink (x, y) ] --- TODO: Implement a custom shrink method.-instance Arbitrary a => Arbitrary (Fold a) where+instance (Eq a, Ord a, Arbitrary a) => Arbitrary (Fold a) where     arbitrary = arbitraryGraph +    shrink g = oneLessVertex ++ oneLessEdge+      where+         oneLessVertex =+           let vertices = Fold.vertexList g+           in  [ Fold.removeVertex v g | v <- vertices ]++         oneLessEdge =+           let edges = Fold.edgeList g+           in  [ Fold.removeEdge v w g | (v, w) <- edges ]++ -- | Generate an arbitrary 'NonEmpty.Graph' value of a specified size. arbitraryNonEmptyGraph :: Arbitrary a => Gen (NonEmpty.Graph a) arbitraryNonEmptyGraph = sized expr@@ -86,18 +99,29 @@         ++ [NonEmpty.Connect x' y' | (x', y') <- shrink (x, y) ]  -- | Generate an arbitrary 'Relation'.-arbitraryRelation :: (Arbitrary a, Ord a) => Gen (Relation a)+arbitraryRelation :: (Arbitrary a, Ord a) => Gen (Relation.Relation a) arbitraryRelation = Relation.stars <$> arbitrary  -- TODO: Implement a custom shrink method.-instance (Arbitrary a, Ord a) => Arbitrary (Relation a) where+instance (Arbitrary a, Ord a) => Arbitrary (Relation.Relation a) where     arbitrary = arbitraryRelation +    shrink g = oneLessVertex ++ oneLessEdge+      where+         oneLessVertex =+           let vertices = Relation.vertexList g+           in  [ Relation.removeVertex v g | v <- vertices ]++         oneLessEdge =+           let edges = Relation.edgeList g+           in  [ Relation.removeEdge v w g | (v, w) <- edges ]++ instance (Arbitrary a, Ord a) => Arbitrary (ReflexiveRelation a) where     arbitrary = ReflexiveRelation <$> arbitraryRelation -instance (Arbitrary a, Ord a) => Arbitrary (SymmetricRelation a) where-    arbitrary = SymmetricRelation <$> arbitraryRelation+instance (Arbitrary a, Ord a) => Arbitrary (Symmetric.Relation a) where+    arbitrary = SR . Relation.symmetricClosure <$> arbitraryRelation  instance (Arbitrary a, Ord a) => Arbitrary (TransitiveRelation a) where     arbitrary = TransitiveRelation <$> arbitraryRelation@@ -110,10 +134,19 @@ arbitraryAdjacencyMap :: (Arbitrary a, Ord a) => Gen (AdjacencyMap a) arbitraryAdjacencyMap = AdjacencyMap.stars <$> arbitrary --- TODO: Implement a custom shrink method. instance (Arbitrary a, Ord a) => Arbitrary (AdjacencyMap a) where     arbitrary = arbitraryAdjacencyMap +    shrink g = oneLessVertex ++ oneLessEdge+      where+         oneLessVertex =+           let vertices = AdjacencyMap.vertexList g+           in  [ AdjacencyMap.removeVertex v g | v <- vertices ]++         oneLessEdge =+           let edges = AdjacencyMap.edgeList g+           in  [ AdjacencyMap.removeEdge v w g | (v, w) <- edges ]+ -- | Generate an arbitrary non-empty 'NAM.AdjacencyMap'. It is guaranteed that -- the resulting adjacency map is 'consistent'. arbitraryNonEmptyAdjacencyMap :: (Arbitrary a, Ord a) => Gen (NAM.AdjacencyMap a)@@ -127,28 +160,55 @@                 return ((x, []) :| []) -- There must be at least one vertex             (x:xs) -> return (x :| xs) --- TODO: Implement a custom shrink method. instance (Arbitrary a, Ord a) => Arbitrary (NAM.AdjacencyMap a) where     arbitrary = arbitraryNonEmptyAdjacencyMap +    shrink g = oneLessVertex ++ oneLessEdge+      where+         oneLessVertex =+           let vertices = toList $ NAM.vertexList1 g+           in catMaybes [ NAM.removeVertex1 v g | v <- vertices ]++         oneLessEdge =+           let edges = NAM.edgeList g+           in  [ NAM.removeEdge v w g | (v, w) <- edges ]+ -- | Generate an arbitrary 'AdjacencyIntMap'. It is guaranteed that the -- resulting adjacency map is 'consistent'. arbitraryAdjacencyIntMap :: Gen AdjacencyIntMap arbitraryAdjacencyIntMap = AdjacencyIntMap.stars <$> arbitrary --- TODO: Implement a custom shrink method. instance Arbitrary AdjacencyIntMap where     arbitrary = arbitraryAdjacencyIntMap +    shrink g = oneLessVertex ++ oneLessEdge+      where+         oneLessVertex =+           let vertices = AdjacencyIntMap.vertexList g+           in  [ AdjacencyIntMap.removeVertex v g | v <- vertices ]++         oneLessEdge =+           let edges = AdjacencyIntMap.edgeList g+           in  [ AdjacencyIntMap.removeEdge v w g | (v, w) <- edges ]+ -- | Generate an arbitrary labelled 'LAM.AdjacencyMap'. It is guaranteed -- that the resulting adjacency map is 'consistent'. arbitraryLabelledAdjacencyMap :: (Arbitrary a, Ord a, Eq e, Arbitrary e, Monoid e) => Gen (LAM.AdjacencyMap e a) arbitraryLabelledAdjacencyMap = LAM.fromAdjacencyMaps <$> arbitrary --- TODO: Implement a custom shrink method. instance (Arbitrary a, Ord a, Eq e, Arbitrary e, Monoid e) => Arbitrary (LAM.AdjacencyMap e a) where     arbitrary = arbitraryLabelledAdjacencyMap +    shrink g = oneLessVertex ++ oneLessEdge+      where+         oneLessVertex =+           let vertices = LAM.vertexList g+           in  [ LAM.removeVertex v g | v <- vertices ]++         oneLessEdge =+           let edges = LAM.edgeList g+           in  [ LAM.removeEdge v w g | (_, v, w) <- edges ]+ -- | Generate an arbitrary labelled 'LAM.Graph' value of a specified size. arbitraryLabelledGraph :: (Arbitrary a, Arbitrary e) => Gen (LG.Graph e a) arbitraryLabelledGraph = sized expr@@ -168,7 +228,6 @@     shrink (LG.Connect e x y) = [LG.Empty, x, y, LG.Connect mempty x y]                              ++ [LG.Connect e x' y' | (x', y') <- shrink (x, y) ] --- TODO: Implement a custom shrink method. instance Arbitrary a => Arbitrary (Tree a) where     arbitrary = sized go       where@@ -182,9 +241,11 @@             children <- replicateM subTrees (go subSize)             return $ Node root children +    shrink (Node r fs) = [Node r fs' | fs' <- shrink fs]+ -- TODO: Implement a custom shrink method. instance Arbitrary s => Arbitrary (Doc s) where-    arbitrary = (mconcat . map literal) <$> arbitrary+    arbitrary = mconcat . map literal <$> arbitrary  instance (Arbitrary a, Num a, Ord a) => Arbitrary (Distance a) where     arbitrary = (\x -> if x < 0 then distance infinite else distance (unsafeFinite x)) <$> arbitrary

@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Generic--- Copyright  : (c) Andrey Mokhov 2016-2018+-- Copyright  : (c) Andrey Mokhov 2016-2019 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -22,9 +22,8 @@ import Data.Tree import Data.Tuple -import Algebra.Graph (Graph (..)) import Algebra.Graph.Class (Graph (..))-import Algebra.Graph.ToGraph (ToGraph (..))+import Algebra.Graph.ToGraph import Algebra.Graph.Test import Algebra.Graph.Test.API @@ -58,6 +57,18 @@                               , testOverlays                               , testConnects ] +testSymmetricBasicPrimitives :: Testsuite -> IO ()+testSymmetricBasicPrimitives = mconcat [ testSymmetricOrd+                                       , testEmpty+                                       , testVertex+                                       , testSymmetricEdge+                                       , testOverlay+                                       , testSymmetricConnect+                                       , testVertices+                                       , testSymmetricEdges+                                       , testOverlays+                                       , testSymmetricConnects ]+ testToGraph :: Testsuite -> IO () testToGraph = mconcat [ testToGraphDefault                       , testFoldg@@ -77,6 +88,21 @@                       , testPostSet                       , testPostIntSet ] +testSymmetricToGraph :: Testsuite -> IO ()+testSymmetricToGraph = mconcat [ testSymmetricToGraphDefault+                               , testIsEmpty+                               , testHasVertex+                               , testSymmetricHasEdge+                               , testVertexCount+                               , testEdgeCount+                               , testVertexList+                               , testVertexSet+                               , testVertexIntSet+                               , testSymmetricEdgeList+                               , testSymmetricEdgeSet+                               , testSymmetricAdjacencyList+                               , testNeighbours ]+ testRelational :: Testsuite -> IO () testRelational = mconcat [ testCompose                          , testClosure@@ -94,6 +120,16 @@                             , testTree                             , testForest ] +testSymmetricGraphFamilies :: Testsuite -> IO ()+testSymmetricGraphFamilies = mconcat [ testSymmetricPath+                                     , testSymmetricCircuit+                                     , testSymmetricClique+                                     , testBiclique+                                     , testStar+                                     , testStars+                                     , testTree+                                     , testForest ]+ testTransformations :: Testsuite -> IO () testTransformations = mconcat [ testRemoveVertex                               , testRemoveEdge@@ -103,6 +139,41 @@                               , testGmap                               , testInduce ] +testSymmetricTransformations :: Testsuite -> IO ()+testSymmetricTransformations = mconcat [ testRemoveVertex+                                       , testSymmetricRemoveEdge+                                       , testReplaceVertex+                                       , testMergeVertices+                                       , testGmap+                                       , testInduce ]++testConsistent :: Testsuite -> IO ()+testConsistent (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "consistent ============"+    test "Consistency of the Arbitrary instance" $ \x -> consistent % x++    putStrLn ""+    test "consistent empty         == True" $+          consistent % empty       == True++    test "consistent (vertex x)    == True" $ \x ->+          consistent % (vertex x)  == True++    test "consistent (overlay x y) == True" $ \x y ->+          consistent % (overlay x y) == True++    test "consistent (connect x y) == True" $ \x y ->+          consistent % (connect x y) == True++    test "consistent (edge x y)    == True" $ \x y ->+          consistent % (edge x y)  == True++    test "consistent (edges xs)    == True" $ \xs ->+          consistent % (edges xs)  == True++    test "consistent (stars xs)    == True" $ \xs ->+          consistent % (stars xs)  == True+ testShow :: Testsuite -> IO () testShow (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "Show ============"@@ -131,16 +202,28 @@     test "show (vertex (-1) + vertex (-2)              ) == \"vertices [-2,-1]\"" $           show % (vertex (-1) + vertex (-2)              ) == "vertices [-2,-1]" -    test "show (vertex (-1) * vertex (-2)              ) == \"edge (-1) (-2)\"" $-          show % (vertex (-1) * vertex (-2)              ) == "edge (-1) (-2)"+    test "show (vertex (-2) * vertex (-1)              ) == \"edge (-2) (-1)\"" $+          show % (vertex (-2) * vertex (-1)              ) == "edge (-2) (-1)" -    test "show (vertex (-1) * vertex (-2) * vertex (-3)) == \"edges [(-2,-3),(-1,-3),(-1,-2)]\"" $-          show % (vertex (-1) * vertex (-2) * vertex (-3)) == "edges [(-2,-3),(-1,-3),(-1,-2)]"+    test "show (vertex (-3) * vertex (-2) * vertex (-1)) == \"edges [(-3,-2),(-3,-1),(-2,-1)]\"" $+          show % (vertex (-3) * vertex (-2) * vertex (-1)) == "edges [(-3,-2),(-3,-1),(-2,-1)]" -    test "show (vertex (-1) * vertex (-2) + vertex (-3)) == \"overlay (vertex (-3)) (edge (-1) (-2))\"" $-          show % (vertex (-1) * vertex (-2) + vertex (-3)) == "overlay (vertex (-3)) (edge (-1) (-2))"+    test "show (vertex (-3) * vertex (-2) + vertex (-1)) == \"overlay (vertex (-1)) (edge (-3) (-2))\"" $+          show % (vertex (-3) * vertex (-2) + vertex (-1)) == "overlay (vertex (-1)) (edge (-3) (-2))" +testSymmetricShow :: Testsuite -> IO ()+testSymmetricShow t@(Testsuite _ (%)) = do+    testShow t+    putStrLn ""+    test "show (2 * 1    ) == \"edge 1 2\"" $+          show % (2 * 1)   ==  "edge 1 2" +    test "show (1 * 2 * 1) == \"edges [(1,1),(1,2)]\"" $+          show % (1 * 2 * 1) == "edges [(1,1),(1,2)]"++    test "show (3 * 2 * 1) == \"edges [(1,2),(1,3),(2,3)]\"" $+          show % (3 * 2 * 1) == "edges [(1,2),(1,3),(2,3)]"+ testOrd :: Testsuite -> IO () testOrd (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "Ord ============"@@ -168,6 +251,36 @@     test "x + y    <= x * y" $ \x y ->           id % x + y <= x * y +testSymmetricOrd :: Testsuite -> IO ()+testSymmetricOrd (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "Ord ============"+    test "vertex 1 <  vertex 2" $+          vertex 1 < id % vertex 2++    test "vertex 3 <  edge 1 2" $+          vertex 3 < id % edge 1 2++    test "vertex 1 <  edge 1 1" $+          vertex 1 < id % edge 1 1++    test "edge 1 1 <  edge 1 2" $+          edge 1 1 < id % edge 1 2++    test "edge 1 2 <  edge 1 1 + edge 2 2" $+          edge 1 2 < id % edge 1 1 + edge 2 2++    test "edge 2 1 <  edge 1 3" $+          edge 2 1 < id % edge 1 3++    test "edge 1 2 == edge 2 1" $+          edge 1 2 == id % edge 2 1++    test "x        <= x + y" $ \x y ->+          id % x   <= x + y++    test "x + y    <= x * y" $ \x y ->+          id % x + y <= x * y+ testEmpty :: Testsuite -> IO () testEmpty (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "empty ============"@@ -216,6 +329,30 @@     test "vertexCount (edge 1 2) == 2" $           vertexCount % edge 1 2 == 2 +testSymmetricEdge :: Testsuite -> IO ()+testSymmetricEdge (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "edge ============"+    test "edge x y               == connect (vertex x) (vertex y)" $ \x y ->+          edge x y               == connect (vertex x) % vertex y++    test "edge x y               == edge y x" $ \x y ->+          edge x y               == id % edge y x++    test "edge x y               == edges [(x,y), (y,x)]" $ \x y ->+          edge x y               == id % edges [(x,y), (y,x)]++    test "hasEdge x y (edge x y) == True" $ \x y ->+          hasEdge x y % edge x y == True++    test "edgeCount   (edge x y) == 1" $ \x y ->+          edgeCount % edge x y   == 1++    test "vertexCount (edge 1 1) == 1" $+          vertexCount % edge 1 1 == 1++    test "vertexCount (edge 1 2) == 2" $+          vertexCount % edge 1 2 == 2+ testOverlay :: Testsuite -> IO () testOverlay (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "overlay ============"@@ -276,6 +413,42 @@     test "edgeCount   (connect 1 2) == 1" $           edgeCount  % connect 1 2  == 1 +testSymmetricConnect :: Testsuite -> IO ()+testSymmetricConnect (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "connect ============"+    test "connect x y               == connect y x" $ \x y ->+          connect x y               == id % connect y x++    test "isEmpty     (connect x y) == isEmpty   x   && isEmpty   y" $ \x y ->+          isEmpty    % connect x y  == (isEmpty   x   && isEmpty   y)++    test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \x y z ->+          hasVertex z % connect x y == (hasVertex z x || hasVertex z y)++    test "vertexCount (connect x y) >= vertexCount x" $ \x y ->+          vertexCount % connect x y >= vertexCount x++    test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \x y ->+          vertexCount % connect x y <= vertexCount x + vertexCount y++    test "edgeCount   (connect x y) >= edgeCount x" $ \x y ->+          edgeCount  % connect x y  >= edgeCount x++    test "edgeCount   (connect x y) >= edgeCount y" $ \x y ->+          edgeCount  % connect x y  >= edgeCount y++    test "edgeCount   (connect x y) >= vertexCount x * vertexCount y `div` 2" $ \x y ->+          edgeCount  % connect x y  >= vertexCount x * vertexCount y `div` 2++    test "edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \x y ->+          edgeCount  % connect x y  <= vertexCount x * vertexCount y + edgeCount x + edgeCount y++    test "vertexCount (connect 1 2) == 2" $+          vertexCount % connect 1 2 == 2++    test "edgeCount   (connect 1 2) == 1" $+          edgeCount  % connect 1 2  == 1+ testVertices :: Testsuite -> IO () testVertices (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "vertices ============"@@ -306,6 +479,18 @@     test "edgeCount . edges == length . nub" $ \xs ->           edgeCount % edges xs == (length . nubOrd) xs +testSymmetricEdges :: Testsuite -> IO ()+testSymmetricEdges (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "edges ============"+    test "edges []             == empty" $+          edges []             == id % empty++    test "edges [(x,y)]        == edge x y" $ \x y ->+          edges [(x,y)]        == id % edge x y++    test "edges [(x,y), (y,x)] == edge x y" $ \x y ->+          edges [(x,y), (y,x)] == id % edge x y+ testOverlays :: Testsuite -> IO () testOverlays (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "overlays ============"@@ -342,6 +527,12 @@     test "isEmpty . connects == all isEmpty" $ size10 $ \xs ->           isEmpty % connects xs == all isEmpty xs +testSymmetricConnects :: Testsuite -> IO ()+testSymmetricConnects t@(Testsuite _ (%)) = do+    testConnects t+    test "connects           == connects . reverse" $ size10 $ \xs ->+          connects xs        == id % connects (reverse xs)+ testStars :: Testsuite -> IO () testStars (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "stars ============"@@ -424,11 +615,17 @@         let y = x + z -- Make sure we hit the precondition         in isSubgraphOf x % y                      ==> x <= y +testSymmetricIsSubgraphOf :: Testsuite -> IO ()+testSymmetricIsSubgraphOf t@(Testsuite _ (%)) = do+    testIsSubgraphOf t+    test "isSubgraphOf (edge x y) (edge y x)       ==  True" $ \x y ->+          isSubgraphOf (edge x y) % edge y x       ==  True+ testToGraphDefault :: Testsuite -> IO () testToGraphDefault (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "toGraph et al. ============"     test "toGraph                    == foldg Empty Vertex Overlay Connect" $ \x ->-          toGraph % x                == foldg Empty Vertex Overlay Connect x+          toGraph % x                == foldg G.Empty G.Vertex G.Overlay G.Connect x      test "foldg                      == Algebra.Graph.foldg . toGraph" $ \e (apply -> v) (applyFun2 -> o) (applyFun2 -> c) x ->           foldg e v o c x            == (G.foldg (e :: Int) v o c . toGraph) % x@@ -532,6 +729,100 @@     test "isTopSortOf vs             == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x ->           isTopSortOf vs x           == (AM.isTopSortOf vs . toAdjacencyMap) % x +-- TODO: We currently do not test 'edgeSet'.+testSymmetricToGraphDefault :: Testsuite -> IO ()+testSymmetricToGraphDefault (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "toGraph et al. ============"+    test "toGraph                    == foldg Empty Vertex Overlay Connect" $ \x ->+          toGraph % x                == foldg G.Empty G.Vertex G.Overlay G.Connect x++    test "foldg                      == Algebra.Graph.foldg . toGraph" $ \e (apply -> v) (applyFun2 -> o) (applyFun2 -> c) x ->+          foldg e v o c x            == (G.foldg (e :: Int) v o c . toGraph) % x++    test "isEmpty                    == foldg True (const False) (&&) (&&)" $ \x ->+          isEmpty x                  == foldg True (const False) (&&) (&&) % x++    test "size                       == foldg 1 (const 1) (+) (+)" $ \x ->+          size x                     == foldg 1 (const 1) (+) (+) % x++    test "hasVertex x                == foldg False (==x) (||) (||)" $ \x y ->+          hasVertex x y              == foldg False (==x) (||) (||) % y++    test "hasEdge x y                == Algebra.Graph.hasEdge x y . toGraph" $ \x y z ->+          hasEdge x y z              == (G.hasEdge x y . toGraph) % z++    test "vertexCount                == Set.size . vertexSet" $ \x ->+          vertexCount x              == (Set.size . vertexSet) % x++    test "edgeCount                  == Set.size . edgeSet" $ \x ->+          edgeCount x                == (Set.size . edgeSet) % x++    test "vertexList                 == Set.toAscList . vertexSet" $ \x ->+          vertexList x               == (Set.toAscList . vertexSet) % x++    test "edgeList                   == Set.toAscList . edgeSet" $ \x ->+          edgeList x                 == (Set.toAscList . edgeSet) % x++    test "vertexSet                  == foldg Set.empty Set.singleton Set.union Set.union" $ \x ->+          vertexSet x                == foldg Set.empty Set.singleton Set.union Set.union % x++    test "vertexIntSet               == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union" $ \x ->+          vertexIntSet x             == foldg IntSet.empty IntSet.singleton IntSet.union IntSet.union % x++    test "adjacencyList              == Algebra.Graph.AdjacencyMap.adjacencyList . toAdjacencyMap" $ \x ->+          adjacencyList x            == (AM.adjacencyList . toAdjacencyMap) % x++    test "adjacencyMap               == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMap" $ \x ->+          adjacencyMap x             == (AM.adjacencyMap . toAdjacencyMap) % x++    test "adjacencyIntMap            == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMap" $ \x ->+          adjacencyIntMap x          == (AIM.adjacencyIntMap . toAdjacencyIntMap) % x++    test "adjacencyMapTranspose      == Algebra.Graph.AdjacencyMap.adjacencyMap . toAdjacencyMapTranspose" $ \x ->+          adjacencyMapTranspose x    == (AM.adjacencyMap . toAdjacencyMapTranspose) % x++    test "adjacencyIntMapTranspose   == Algebra.Graph.AdjacencyIntMap.adjacencyIntMap . toAdjacencyIntMapTranspose" $ \x ->+          adjacencyIntMapTranspose x == (AIM.adjacencyIntMap . toAdjacencyIntMapTranspose) % x++    test "dfsForest                  == Algebra.Graph.AdjacencyMap.dfsForest . toAdjacencyMap" $ \x ->+          dfsForest x                == (AM.dfsForest . toAdjacencyMap) % x++    test "dfsForestFrom vs           == Algebra.Graph.AdjacencyMap.dfsForestFrom vs . toAdjacencyMap" $ \vs x ->+          dfsForestFrom vs x         == (AM.dfsForestFrom vs . toAdjacencyMap) % x++    test "dfs vs                     == Algebra.Graph.AdjacencyMap.dfs vs . toAdjacencyMap" $ \vs x ->+          dfs vs x                   == (AM.dfs vs . toAdjacencyMap) % x++    test "reachable x                == Algebra.Graph.AdjacencyMap.reachable x . toAdjacencyMap" $ \x y ->+          reachable x y              == (AM.reachable x . toAdjacencyMap) % y++    test "topSort                    == Algebra.Graph.AdjacencyMap.topSort . toAdjacencyMap" $ \x ->+          topSort x                  == (AM.topSort . toAdjacencyMap) % x++    test "isAcyclic                  == Algebra.Graph.AdjacencyMap.isAcyclic . toAdjacencyMap" $ \x ->+          isAcyclic x                == (AM.isAcyclic . toAdjacencyMap) % x++    test "isTopSortOf vs             == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x ->+          isTopSortOf vs x           == (AM.isTopSortOf vs . toAdjacencyMap) % x++    test "toAdjacencyMap             == foldg empty vertex overlay connect" $ \x ->+          toAdjacencyMap x           == foldg AM.empty AM.vertex AM.overlay AM.connect % x++    test "toAdjacencyMapTranspose    == foldg empty vertex overlay (flip connect)" $ \x ->+          toAdjacencyMapTranspose x  == foldg AM.empty AM.vertex AM.overlay (flip AM.connect) % x++    test "toAdjacencyIntMap          == foldg empty vertex overlay connect" $ \x ->+          toAdjacencyIntMap x        == foldg AIM.empty AIM.vertex AIM.overlay AIM.connect % x++    test "toAdjacencyIntMapTranspose == foldg empty vertex overlay (flip connect)" $ \x ->+          toAdjacencyIntMapTranspose x == foldg AIM.empty AIM.vertex AIM.overlay (flip AIM.connect) % x++    test "isDfsForestOf f            == Algebra.Graph.AdjacencyMap.isDfsForestOf f . toAdjacencyMap" $ \f x ->+          isDfsForestOf f x          == (AM.isDfsForestOf f . toAdjacencyMap) % x++    test "isTopSortOf vs             == Algebra.Graph.AdjacencyMap.isTopSortOf vs . toAdjacencyMap" $ \vs x ->+          isTopSortOf vs x           == (AM.isTopSortOf vs . toAdjacencyMap) % x+ testFoldg :: Testsuite -> IO () testFoldg (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "foldg ============"@@ -620,6 +911,28 @@         (u, v) <- elements ((x, y) : edgeList z)         return $ hasEdge u v z == elem (u, v) (edgeList % z) +testSymmetricHasEdge :: Testsuite -> IO ()+testSymmetricHasEdge (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "hasEdge ============"+    test "hasEdge x y empty            == False" $ \x y ->+          hasEdge x y % empty          == False++    test "hasEdge x y (vertex z)       == False" $ \x y z ->+          hasEdge x y % vertex z       == False++    test "hasEdge x y (edge x y)       == True" $ \x y ->+          hasEdge x y % edge x y       == True++    test "hasEdge x y (edge y x)       == True" $ \x y ->+          hasEdge x y % edge y x       == True++    test "hasEdge x y . removeEdge x y == const False" $ \x y z ->+         (hasEdge x y . removeEdge x y) z == const False % z++    test "hasEdge x y                  == elem (min x y, max x y) . edgeList" $ \x y z -> do+        (u, v) <- elements ((x, y) : edgeList z)+        return $ hasEdge u v z == elem (min u v, max u v) (edgeList % z)+ testVertexCount :: Testsuite -> IO () testVertexCount (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "vertexCount ============"@@ -682,6 +995,21 @@     test "edgeList . edges        == nub . sort" $ \xs ->           edgeList % edges xs     == (nubOrd . sort) xs +testSymmetricEdgeList :: Testsuite -> IO ()+testSymmetricEdgeList (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "edgeList ============"+    test "edgeList empty          == []" $+          edgeList % empty        == []++    test "edgeList (vertex x)     == []" $ \x ->+          edgeList % vertex x     == []++    test "edgeList (edge x y)     == [(min x y, max y x)]" $ \x y ->+          edgeList % edge x y     == [(min x y, max y x)]++    test "edgeList (star 2 [3,1]) == [(1,2), (2,3)]" $+          edgeList % star 2 [3,1] == [(1,2), (2,3)]+ testAdjacencyList :: Testsuite -> IO () testAdjacencyList (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "adjacencyList ============"@@ -697,6 +1025,21 @@     test "adjacencyList (star 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])]" $           adjacencyList % star 2 [3,1] == [(1, []), (2, [1,3]), (3, [])] +testSymmetricAdjacencyList :: Testsuite -> IO ()+testSymmetricAdjacencyList (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "adjacencyList ============"+    test "adjacencyList empty          == []" $+          adjacencyList % empty        == []++    test "adjacencyList (vertex x)     == [(x, [])]" $ \x ->+          adjacencyList % vertex x     == [(x, [])]++    test "adjacencyList (edge 1 2)     == [(1, [2]), (2, [1])]" $+          adjacencyList % edge 1 2     == [(1, [2]), (2, [1])]++    test "adjacencyList (star 2 [3,1]) == [(1, [2]), (2, [1,3]), (3, [2])]" $+          adjacencyList % star 2 [3,1] == [(1, [2]), (2, [1,3]), (3, [2])]+ testVertexSet :: Testsuite -> IO () testVertexSet (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "vertexSet ============"@@ -739,6 +1082,18 @@     test "edgeSet . edges    == Set.fromList" $ \xs ->           edgeSet % edges xs == Set.fromList xs +testSymmetricEdgeSet :: Testsuite -> IO ()+testSymmetricEdgeSet (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "edgeSet ============"+    test "edgeSet empty      == Set.empty" $+          edgeSet % empty    == Set.empty++    test "edgeSet (vertex x) == Set.empty" $ \x ->+          edgeSet % vertex x == Set.empty++    test "edgeSet ('edge' x y) == Set.'Set.singleton' (min x y, max x y)" $ \x y ->+          edgeSet % edge x y   == Set.singleton (min x y, max x y)+ testPreSet :: Testsuite -> IO () testPreSet (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "preSet ============"@@ -799,6 +1154,21 @@     test "postIntSet x (edge x y) == IntSet.fromList [y]" $ \x y ->           postIntSet x % edge x y == IntSet.fromList [y] +testNeighbours :: Testsuite -> IO ()+testNeighbours (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "neighbours ============"+    test "neighbours x empty      == Set.empty" $ \x ->+          neighbours x % empty    == Set.empty++    test "neighbours x (vertex x) == Set.empty" $ \x ->+          neighbours x % vertex x == Set.empty++    test "neighbours x (edge x y) == Set.fromList [y]" $ \x y ->+          neighbours x % edge x y == Set.fromList [y]++    test "neighbours y (edge x y) == Set.fromList [x]" $ \x y ->+          neighbours y % edge x y == Set.fromList [x]+ testPath :: Testsuite -> IO () testPath (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "path ============"@@ -811,6 +1181,12 @@     test "path [x,y] == edge x y" $ \x y ->           path [x,y] == id % edge x y +testSymmetricPath :: Testsuite -> IO ()+testSymmetricPath t@(Testsuite _ (%)) = do+    testPath t+    test "path       == path . reverse" $ \xs ->+          path xs    == id % path (reverse xs)+ testCircuit :: Testsuite -> IO () testCircuit (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "circuit ============"@@ -823,6 +1199,12 @@     test "circuit [x,y] == edges [(x,y), (y,x)]" $ \x y ->           circuit [x,y] == id % edges [(x,y), (y,x)] +testSymmetricCircuit :: Testsuite -> IO ()+testSymmetricCircuit t@(Testsuite _ (%)) = do+    testCircuit t+    test "circuit       == circuit . reverse" $ \xs ->+          circuit xs    == id % circuit (reverse xs)+ testClique :: Testsuite -> IO () testClique (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "clique ============"@@ -841,6 +1223,12 @@     test "clique (xs ++ ys) == connect (clique xs) (clique ys)" $ \xs ys ->           clique (xs ++ ys) == connect (clique xs) % clique ys +testSymmetricClique :: Testsuite -> IO ()+testSymmetricClique t@(Testsuite _ (%)) = do+    testClique t+    test "clique            == clique . reverse" $ \xs->+          clique xs         == id % clique (reverse xs)+ testBiclique :: Testsuite -> IO () testBiclique (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "biclique ============"@@ -944,6 +1332,12 @@     when (prefix == "Fold." || prefix == "Graph.") $ do         test "size (removeEdge x y z)         <= 3 * size z" $ \x y z ->               size % (removeEdge x y z)       <= 3 * size z++testSymmetricRemoveEdge :: Testsuite -> IO ()+testSymmetricRemoveEdge t@(Testsuite _ (%)) = do+    testRemoveEdge t+    test "removeEdge x y                  == removeEdge y x" $ \x y z ->+          removeEdge x y z                == removeEdge y x % z  testReplaceVertex :: Testsuite -> IO () testReplaceVertex (Testsuite prefix (%)) = do

@@ -14,6 +14,9 @@     testGraph   ) where +import Prelude ()+import Prelude.Compat+ import Data.Either  import Algebra.Graph@@ -21,6 +24,8 @@ import Algebra.Graph.Test.Generic import Algebra.Graph.ToGraph (reachable) +import qualified Data.Graph as KL+ t :: Testsuite t = testsuite "Graph." empty @@ -172,6 +177,26 @@      test "size        (sparsify x) <= 3 * size x" $ \(x :: G) ->           size        (sparsify x) <= 3 * size x++    putStrLn "\n============ Graph.sparsifyKL ============"+    test "sort . reachable k                 == sort . filter (<= n) . flip reachable k . sparsifyKL n" $ \(Positive n) -> do+        let pairs = (,) <$> choose (1, n) <*> choose (1, n)+        k  <- choose (1, n)+        es <- listOf pairs+        let x = vertices [1..n] `overlay` edges es+        return $ (sort . reachable k) x == (sort . filter (<= n) . flip KL.reachable k . sparsifyKL n) x++    test "length (vertices $ sparsifyKL n x) <= vertexCount x + size x + 1" $ \(Positive n) -> do+        let pairs = (,) <$> choose (1, n) <*> choose (1, n)+        es <- listOf pairs+        let x = vertices [1..n] `overlay` edges es+        return $ length (KL.vertices $ sparsifyKL n x) <= vertexCount x + size x + 1++    test "length (edges    $ sparsifyKL n x) <= 3 * size x" $ \(Positive n) -> do+        let pairs = (,) <$> choose (1, n) <*> choose (1, n)+        es <- listOf pairs+        let x = vertices [1..n] `overlay` edges es+        return $ length (KL.edges $ sparsifyKL n x) <= 3 * size x      putStrLn "\n============ Labelled.Graph.context ============"     test "context (const False) x                   == Nothing" $ \x ->

@@ -33,6 +33,7 @@  import qualified Algebra.Graph          as G import qualified Algebra.Graph.NonEmpty as NonEmpty+import qualified Data.Graph             as KL import qualified Data.List.NonEmpty     as NonEmpty import qualified Data.Set               as Set @@ -657,6 +658,26 @@      test "size        (sparsify x) <= 3 * size x" $ \(x :: G) ->           size        (sparsify x) <= 3 * size x++    putStrLn "\n============ NonEmpty.Graph.sparsify ============"+    test "sort . reachable k                 == sort . filter (<= n) . flip reachable k . sparsifyKL n" $ \(Positive n) -> do+        let pairs = (,) <$> choose (1, n) <*> choose (1, n)+        k  <- choose (1, n)+        es <- listOf pairs+        let x = G.edges es `overlay1` vertices1 [1..n]+        return $ (sort . reachable k) x == (sort . filter (<= n) . flip KL.reachable k . sparsifyKL n) x++    test "length (vertices $ sparsifyKL n x) <= vertexCount x + size x + 1" $ \(Positive n) -> do+        let pairs = (,) <$> choose (1, n) <*> choose (1, n)+        es <- listOf pairs+        let x = G.edges es `overlay1` vertices1 [1..n]+        return $ length (KL.vertices $ sparsifyKL n x) <= vertexCount x + size x + 1++    test "length (edges    $ sparsifyKL n x) <= 3 * size x" $ \(Positive n) -> do+        let pairs = (,) <$> choose (1, n) <*> choose (1, n)+        es <- listOf pairs+        let x = G.edges es `overlay1` vertices1 [1..n]+        return $ length (KL.edges $ sparsifyKL n x) <= 3 * size x      putStrLn "\n============ NonEmpty.Graph.box ============"     test "box (path1 [0,1]) (path1 ['a','b']) == <correct result>" $ mapSize (min 10) $

@@ -14,16 +14,13 @@   ) where  import Algebra.Graph.Relation-import Algebra.Graph.Relation.Internal import Algebra.Graph.Relation.Preorder import Algebra.Graph.Relation.Reflexive-import Algebra.Graph.Relation.Symmetric import Algebra.Graph.Relation.Transitive import Algebra.Graph.Test import Algebra.Graph.Test.Generic  import qualified Algebra.Graph.Class as C-import qualified Data.Set            as Set  t :: Testsuite t = testsuite "Relation." empty@@ -35,9 +32,7 @@     putStrLn "\n============ Relation ============"     test "Axioms of graphs" $ size10 (axioms :: GraphTestsuite RI) -    test "Consistency of arbitraryRelation" $ \(m :: RI) ->-        consistent m-+    testConsistent      t     testShow            t     testBasicPrimitives t     testIsSubgraphOf    t@@ -49,23 +44,6 @@     putStrLn "\n============ ReflexiveRelation ============"     test "Axioms of reflexive graphs" $ size10         (reflexiveAxioms :: GraphTestsuite (ReflexiveRelation Int))--    putStrLn "\n============ SymmetricRelation ============"-    test "Axioms of undirected graphs" $ size10-        (undirectedAxioms :: GraphTestsuite (SymmetricRelation Int))--    putStrLn "\n============ SymmetricRelation.neighbours ============"-    test "neighbours x empty      == Set.empty" $ \(x :: Int) ->-          neighbours x C.empty    == Set.empty--    test "neighbours x (vertex x) == Set.empty" $ \(x :: Int) ->-          neighbours x (C.vertex x) == Set.empty--    test "neighbours x (edge x y) == Set.fromList [y]" $ \(x :: Int) y ->-          neighbours x (C.edge x y) == Set.fromList [y]--    test "neighbours y (edge x y) == Set.fromList [x]" $ \(x :: Int) y ->-          neighbours y (C.edge x y) == Set.fromList [x]      putStrLn "\n============ TransitiveRelation ============"     test "Axioms of transitive graphs" $ size10

@@ -0,0 +1,68 @@+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Test.Relation+-- Copyright  : (c) Andrey Mokhov 2016-2019+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- Testsuite for "Algebra.Graph.Relation".+-----------------------------------------------------------------------------+module Algebra.Graph.Test.Relation.SymmetricRelation (+    -- * Testsuite+    testSymmetricRelation+  ) where++import Algebra.Graph.Relation.Symmetric+import Algebra.Graph.Test+import Algebra.Graph.Test.Generic++import qualified Algebra.Graph.Relation as R++t :: Testsuite+t = testsuite "Symmetric.Relation." empty++type RI  = R.Relation Int+type SRI = Relation Int++testSymmetricRelation :: IO ()+testSymmetricRelation = do+    putStrLn "\n============ Symmetric.Relation ============"+    test "Axioms of undirected graphs" $+        size10 (undirectedAxioms :: GraphTestsuite SRI)++    testConsistent    t+    testSymmetricShow t++    putStrLn $ "\n============ Symmetric.Relation.toSymmetric ============"+    test "toSymmetric (edge 1 2)         == edge 1 2" $+          toSymmetric (R.edge 1 2)       == edge 1 (2 :: Int)++    test "toSymmetric . fromSymmetric    == id" $ \(x :: SRI) ->+          (toSymmetric . fromSymmetric) x == id x++    test "fromSymmetric    . toSymmetric == symmetricClosure" $ \(x :: RI) ->+          (fromSymmetric . toSymmetric) x == R.symmetricClosure x++    test "vertexCount      . toSymmetric == vertexCount" $ \(x :: RI) ->+          vertexCount (toSymmetric x) == R.vertexCount x++    test "(*2) . edgeCount . toSymmetric >= edgeCount" $ \(x :: RI) ->+          ((*2) . edgeCount . toSymmetric) x >= R.edgeCount x++    putStrLn $ "\n============ Symmetric.Relation.fromSymmetric ============"+    test "fromSymmetric (edge 1 2)    == edges [(1,2), (2,1)]" $+          fromSymmetric (edge 1 2)    == R.edges [(1,2), (2,1 :: Int)]++    test "vertexCount . fromSymmetric == vertexCount" $ \(x :: SRI) ->+          (R.vertexCount . fromSymmetric) x == vertexCount x++    test "edgeCount   . fromSymmetric <= (*2) . edgeCount" $ \(x :: SRI) ->+          (R.edgeCount . fromSymmetric) x <= ((*2) . edgeCount) x++    testSymmetricBasicPrimitives t+    testSymmetricIsSubgraphOf    t+    testSymmetricToGraph         t+    testSymmetricGraphFamilies   t+    testSymmetricTransformations t+

@@ -96,3 +96,31 @@ starTR a xs = connect (vertices xs) (vertex a)  inspect $ 'starT1 === 'starTR++fmapFmap1, fmapFmapR :: Graph a -> (a -> b) -> (b -> c) -> Graph c+fmapFmap1 g f h = fmap h (fmap f g)+fmapFmapR g f h = fmap (h . f) g++inspect $ 'fmapFmap1 === 'fmapFmapR++bind2, bind2R :: (a -> Graph b) -> (b -> Graph c) -> Graph a -> Graph c+bind2 f g x = x >>= f >>= g+bind2R f g x = x >>= (\x -> f x >>= g)++inspect $ 'bind2 === 'bind2R++-- Ideally, we want this test to pass.+-- Strangely, '<*>' in 'ovApR' does not inline and makes the test fail.+--+-- This is corrected below, where '<*>' was inlined "by hand"+ovAp, ovApR :: Graph (a -> b) -> Graph (a -> b) -> Graph a -> Graph b+ovAp  x y z = overlay x y <*> z+ovApR x y z = overlay (x <*> z) (y <*> z)++inspect $ 'ovAp =/= 'ovApR++ovAp', ovApR' :: Graph (a -> b) -> Graph (a -> b) -> Graph a -> Graph b+ovAp'  x y z = overlay x y <*> z+ovApR' x y z = overlay (x >>= (<$> z)) (y >>= (<$> z))++inspect $ 'ovAp' === 'ovApR'

@@ -9,19 +9,33 @@ import Algebra.Graph.Test.Labelled.AdjacencyMap import Algebra.Graph.Test.Labelled.Graph import Algebra.Graph.Test.Relation+import Algebra.Graph.Test.Relation.SymmetricRelation import Data.Graph.Test.Typed +import Control.Monad+import System.Environment++-- | By default, all testsuites will be executed, which takes a few minutes. If+-- you would like to execute only some specific testsuites, you can specify+-- their names in the command line. For example:+--+-- stack test --test-arguments "Graph SymmetricRelation"+--+-- will test the modules "Algebra.Graph" and "Algebra.Graph.Symmetric.Relation". main :: IO () main = do-    testAdjacencyIntMap-    testAdjacencyMap-    testExport-    testFold-    testGraph-    testInternal-    testLabelledAdjacencyMap-    testLabelledGraph-    testNonEmptyAdjacencyMap-    testNonEmptyGraph-    testRelation-    testTyped+    selected <- getArgs+    let go current = when (null selected || current `elem` selected)+    go "AdjacencyIntMap"      testAdjacencyIntMap+    go "AdjacencyMap"         testAdjacencyMap+    go "Export"               testExport+    go "Fold"                 testFold+    go "Graph"                testGraph+    go "Internal"             testInternal+    go "LabelledAdjacencyMap" testLabelledAdjacencyMap+    go "LabelledGraph"        testLabelledGraph+    go "NonEmptyAdjacencyMap" testNonEmptyAdjacencyMap+    go "NonEmptyGraph"        testNonEmptyGraph+    go "Relation"             testRelation+    go "SymmetricRelation"    testSymmetricRelation+    go "Typed"                testTyped