algebraic-graphs 0.0.5 → 0.1.0

raw patch · 36 files changed

+2252/−515 lines, 36 filesdep +base-compatdep +base-orphansdep +deepseqdep ~QuickCheckdep ~arraydep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: base-compat, base-orphans, deepseq, semigroups

Dependency ranges changed: QuickCheck, array, base, containers

API changes (from Hackage documentation)

Files

• CHANGES.md +13/−0
• LICENSE +1/−1
• algebraic-graphs.cabal +43/−19
• bench/Bench.hs +4/−1
• src/Algebra/Graph.hs +76/−76
• src/Algebra/Graph/AdjacencyMap.hs +31/−28
• src/Algebra/Graph/AdjacencyMap/Internal.hs +17/−16
• src/Algebra/Graph/Class.hs +70/−25
• src/Algebra/Graph/Export.hs +26/−20
• src/Algebra/Graph/Export/Dot.hs +2/−2
• src/Algebra/Graph/Fold.hs +42/−51
• src/Algebra/Graph/HigherKinded/Class.hs +59/−34
• src/Algebra/Graph/IntAdjacencyMap.hs +31/−28
• src/Algebra/Graph/IntAdjacencyMap/Internal.hs +17/−16
• src/Algebra/Graph/Internal.hs +123/−0
• src/Algebra/Graph/NonEmpty.hs +755/−0
• src/Algebra/Graph/Relation.hs +39/−33
• src/Algebra/Graph/Relation/Internal.hs +15/−16
• src/Algebra/Graph/Relation/InternalDerived.hs +5/−5
• src/Algebra/Graph/Relation/Preorder.hs +1/−1
• src/Algebra/Graph/Relation/Reflexive.hs +1/−1
• src/Algebra/Graph/Relation/Symmetric.hs +1/−1
• src/Algebra/Graph/Relation/Transitive.hs +1/−1
• test/Algebra/Graph/Test.hs +8/−8
• test/Algebra/Graph/Test/API.hs +15/−10
• test/Algebra/Graph/Test/AdjacencyMap.hs +2/−2
• test/Algebra/Graph/Test/Arbitrary.hs +28/−4
• test/Algebra/Graph/Test/Export.hs +9/−5
• test/Algebra/Graph/Test/Fold.hs +19/−19
• test/Algebra/Graph/Test/Generic.hs +109/−75
• test/Algebra/Graph/Test/Graph.hs +11/−11
• test/Algebra/Graph/Test/IntAdjacencyMap.hs +2/−2
• test/Algebra/Graph/Test/Internal.hs +33/−0
• test/Algebra/Graph/Test/NonEmptyGraph.hs +635/−0
• test/Algebra/Graph/Test/Relation.hs +4/−4
• test/Main.hs +4/−0

@@ -1,5 +1,18 @@ # Change log
 
+## 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`.

@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2016-2017 Andrey Mokhov+Copyright (c) 2016-2018 Andrey Mokhov  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,16 +1,20 @@ name:          algebraic-graphs-version:       0.0.5+version:       0.1.0 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-copyright:     Andrey Mokhov, 2016-2017+copyright:     Andrey Mokhov, 2016-2018 homepage:      https://github.com/snowleopard/alga category:      Algebra, Algorithms, Data Structures, Graphs build-type:    Simple cabal-version: >=1.18-tested-with:   GHC==8.0.2+tested-with:   GHC==7.8.4,+               GHC==7.10.3,+               GHC==8.0.2,+               GHC==8.2.2,+               GHC==8.4.1 stability:     experimental description:     <https://github.com/snowleopard/alga Alga> is a library for algebraic construction and@@ -36,8 +40,8 @@     that defines the Boehm-Berarducci encoding of algebraic graphs and provides additional     flexibility for polymorphic graph manipulation.     .-    This is an experimental library and the API will be unstable until version 1.0.0. Please-    consider contributing to the on-going+    This is an experimental library and the API is expected to remain unstable until version 1.0.0.+    Please consider contributing to the on-going     <https://github.com/snowleopard/alga/issues discussions on the library API>.  extra-doc-files:@@ -60,6 +64,8 @@                         Algebra.Graph.HigherKinded.Class,                         Algebra.Graph.IntAdjacencyMap,                         Algebra.Graph.IntAdjacencyMap.Internal,+                        Algebra.Graph.Internal,+                        Algebra.Graph.NonEmpty,                         Algebra.Graph.Relation,                         Algebra.Graph.Relation.Internal,                         Algebra.Graph.Relation.InternalDerived,@@ -67,22 +73,29 @@                         Algebra.Graph.Relation.Reflexive,                         Algebra.Graph.Relation.Symmetric,                         Algebra.Graph.Relation.Transitive-    build-depends:      array      >= 0.5 && < 0.8,-                        base       >= 4.9 && < 5,-                        containers >= 0.5 && < 0.8+    build-depends:      array       >= 0.4     && < 0.6,+                        base        >= 4.7     && < 5,+                        base-compat >= 0.9.1   && < 0.10,+                        containers  >= 0.5.5.1 && < 0.8,+                        deepseq     >= 1.3.0.1 && < 1.5+    if !impl(ghc >= 8.0)+        build-depends:  semigroups  >= 0.18.3  && < 0.18.4     default-language:   Haskell2010     default-extensions: FlexibleContexts                         GeneralizedNewtypeDeriving                         ScopedTypeVariables                         TupleSections                         TypeFamilies-    other-extensions:   DeriveFoldable+    other-extensions:   CPP+                        DeriveFoldable                         DeriveFunctor                         DeriveTraversable                         OverloadedStrings                         RecordWildCards     GHC-options:        -Wall-                        -Wcompat+                        -fno-warn-name-shadowing+    if impl(ghc >= 8.0)+        GHC-options:    -Wcompat                         -Wincomplete-record-updates                         -Wincomplete-uni-patterns                         -Wredundant-constraints@@ -100,16 +113,24 @@                         Algebra.Graph.Test.Generic,                         Algebra.Graph.Test.Graph,                         Algebra.Graph.Test.IntAdjacencyMap,+                        Algebra.Graph.Test.Internal,+                        Algebra.Graph.Test.NonEmptyGraph,                         Algebra.Graph.Test.Relation     build-depends:      algebraic-graphs,-                        base       >= 4.9,-                        containers >= 0.5,-                        extra      >= 1.5,-                        QuickCheck >= 2.9+                        base         >= 4.7     && < 5,+                        base-compat  >= 0.9.1   && < 0.10,+                        base-orphans >= 0.5.4   && < 0.8,+                        containers   >= 0.5.5.1 && < 0.8,+                        extra        >= 1.5,+                        QuickCheck   >= 2.9     && < 2.11+    if !impl(ghc >= 8.0)+        build-depends:  semigroups   >= 0.18.3  && < 0.18.4     default-language:   Haskell2010     GHC-options:        -O2                         -Wall-                        -Wcompat+                        -fno-warn-name-shadowing+    if impl(ghc >= 8.0)+        GHC-options:    -Wcompat                         -Wincomplete-record-updates                         -Wincomplete-uni-patterns                         -Wredundant-constraints@@ -127,13 +148,16 @@     type:               exitcode-stdio-1.0     main-is:            Bench.hs     build-depends:      algebraic-graphs,-                        base       >= 4.9,-                        containers >= 0.5,-                        criterion  >= 1.1+                        base        >= 4.7     && < 5,+                        base-compat >= 0.9.1   && < 0.10,+                        containers  >= 0.5.5.1 && < 0.8,+                        criterion   >= 1.1     default-language:   Haskell2010     GHC-options:        -O2                         -Wall-                        -Wcompat+                        -fno-warn-name-shadowing+    if impl(ghc >= 8.0)+        GHC-options:    -Wcompat                         -Wincomplete-record-updates                         -Wincomplete-uni-patterns                         -Wredundant-constraints

@@ -1,6 +1,9 @@+import Prelude ()+import Prelude.Compat+ import Criterion.Main import Data.Char-import Data.Foldable+import Data.Foldable (toList)  import Algebra.Graph.Class import Algebra.Graph.AdjacencyMap (AdjacencyMap, adjacencyMap)

@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -23,7 +23,6 @@      -- * Basic graph construction primitives     empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,-    graph,      -- * Graph folding     foldg,@@ -36,7 +35,8 @@     edgeList, vertexSet, vertexIntSet, edgeSet,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, tree, forest, mesh, torus, deBruijn,+    path, circuit, clique, biclique, star, starTranspose, tree, forest, mesh,+    torus, deBruijn,      -- * Graph transformation     removeVertex, removeEdge, replaceVertex, mergeVertices, splitVertex,@@ -46,9 +46,15 @@     box   ) where +import Prelude ()+import Prelude.Compat+ import Control.Applicative (Alternative, (<|>))-import Control.Monad+import Control.DeepSeq (NFData (..))+import Control.Monad.Compat +import Algebra.Graph.Internal+ import qualified Algebra.Graph.AdjacencyMap       as AM import qualified Algebra.Graph.Class              as C import qualified Algebra.Graph.HigherKinded.Class as H@@ -57,7 +63,7 @@ import qualified Data.Set                         as Set import qualified Data.Tree                        as Tree -{-| The 'Graph' datatype is a deep embedding of the core graph construction+{-| The 'Graph' data type is a deep embedding of the core graph construction primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a 'Num' instance as a convenient notation for working with graphs: @@ -106,8 +112,8 @@ When specifying the time and memory complexity of graph algorithms, /n/ will denote the number of vertices in the graph, /m/ will denote the number of edges in the graph, and /s/ will denote the /size/ of the corresponding-'Graph' expression. For example, if g is a 'Graph' then /n/, /m/ and /s/ can be-computed as follows:+'Graph' expression. For example, if @g@ is a 'Graph' then /n/, /m/ and /s/ can+be computed as follows:  @n == 'vertexCount' g m == 'edgeCount' g@@ -138,6 +144,12 @@              | Connect (Graph a) (Graph a)              deriving (Foldable, Functor, Show, Traversable) +instance NFData a => NFData (Graph a) where+    rnf Empty         = ()+    rnf (Vertex  x  ) = rnf x+    rnf (Overlay x y) = rnf x `seq` rnf y+    rnf (Connect x y) = rnf x `seq` rnf y+ instance C.Graph (Graph a) where     type Vertex (Graph a) = a     empty   = empty@@ -147,7 +159,12 @@  instance C.ToGraph (Graph a) where     type ToVertex (Graph a) = a-    toGraph = foldg C.empty C.vertex C.overlay C.connect+    foldg e v o c = go+      where+        go Empty         = e+        go (Vertex  x  ) = v x+        go (Overlay x y) = o (go x) (go y)+        go (Connect x y) = c (go x) (go y)  instance H.ToGraph Graph where     toGraph = foldg H.empty H.vertex H.overlay H.connect@@ -202,7 +219,6 @@ -- @ -- 'isEmpty'     (vertex x) == False -- 'hasVertex' x (vertex x) == True--- 'hasVertex' 1 (vertex 2) == False -- 'vertexCount' (vertex x) == 1 -- 'edgeCount'   (vertex x) == 0 -- 'size'        (vertex x) == 1@@ -223,8 +239,8 @@ edge :: a -> a -> Graph a edge = H.edge --- | /Overlay/ two graphs. An alias for the constructor 'Overlay'. This is an--- idempotent, commutative and associative operation with the identity 'empty'.+-- | /Overlay/ two graphs. An alias for the constructor 'Overlay'. This is a+-- commutative, associative and idempotent operation with the identity 'empty'. -- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. -- -- @@@ -242,8 +258,8 @@ overlay = Overlay  -- | /Connect/ two graphs. An alias for the constructor 'Connect'. This is an--- associative operation with the identity 'empty', which distributes over the--- overlay and obeys the decomposition axiom.+-- associative operation with the identity 'empty', which distributes over+-- 'overlay' and obeys the decomposition axiom. -- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. 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)/.@@ -298,6 +314,7 @@ -- overlays []        == 'empty' -- overlays [x]       == x -- overlays [x,y]     == 'overlay' x y+-- overlays           == 'foldr' 'overlay' 'empty' -- 'isEmpty' . overlays == 'all' 'isEmpty' -- @ overlays :: [Graph a] -> Graph a@@ -311,25 +328,12 @@ -- connects []        == 'empty' -- connects [x]       == x -- connects [x,y]     == 'connect' x y+-- connects           == 'foldr' 'connect' 'empty' -- 'isEmpty' . connects == 'all' 'isEmpty' -- @ connects :: [Graph a] -> Graph a connects = H.connects --- | Construct the graph from given lists of vertices /V/ and edges /E/.--- The resulting graph contains the vertices /V/ as well as all the vertices--- referred to by the edges /E/.--- Complexity: /O(|V| + |E|)/ time, memory and size.------ @--- graph []  []      == 'empty'--- graph [x] []      == 'vertex' x--- graph []  [(x,y)] == 'edge' x y--- graph vs  es      == 'overlay' ('vertices' vs) ('edges' es)--- @-graph :: [a] -> [(a, a)] -> Graph a-graph = H.graph- -- | Generalised 'Graph' folding: recursively collapse a 'Graph' by applying -- the provided functions to the leaves and internal nodes of the expression. -- The order of arguments is: empty, vertex, overlay and connect.@@ -345,12 +349,7 @@ -- foldg True  (const False) (&&)    (&&)           == 'isEmpty' -- @ foldg :: b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> Graph a -> b-foldg e v o c = go-  where-    go Empty         = e-    go (Vertex x)    = v x-    go (Overlay x y) = o (go x) (go y)-    go (Connect x y) = c (go x) (go y)+foldg = C.foldg  -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the -- first graph is a /subgraph/ of the second.@@ -379,7 +378,7 @@ -- @ (===) :: Eq a => Graph a -> Graph a -> Bool Empty           === Empty           = True-(Vertex x)      === (Vertex y)      = x == y+(Vertex  x1   ) === (Vertex  x2   ) = x1 ==  x2 (Overlay x1 y1) === (Overlay x2 y2) = x1 === x2 && y1 === y2 (Connect x1 y1) === (Connect x2 y2) = x1 === x2 && y1 === y2 _               === _               = False@@ -420,6 +419,7 @@ -- @ -- hasVertex x 'empty'            == False -- hasVertex x ('vertex' x)       == True+-- hasVertex 1 ('vertex' 2)       == False -- hasVertex x . 'removeVertex' x == const False -- @ hasVertex :: Eq a => a -> Graph a -> Bool@@ -566,7 +566,7 @@ clique :: [a] -> Graph a clique = H.clique --- | The /biclique/ on a list of vertices.+-- | The /biclique/ on two lists of vertices. -- Complexity: /O(L1 + L2)/ time, memory and size, where /L1/ and /L2/ are the -- lengths of the given lists. --@@ -580,7 +580,7 @@ biclique :: [a] -> [a] -> Graph a biclique = H.biclique --- | The /star/ formed by a centre vertex and a list of leaves.+-- | The /star/ formed by a centre vertex connected to a list of leaves. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the -- given list. --@@ -588,11 +588,26 @@ -- 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 :: a -> [a] -> Graph a star = H.star --- | The /tree graph/ constructed from a given 'Tree' data structure.+-- | The /star transpose/ formed by a list of leaves connected to a centre vertex.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- starTranspose x []    == 'vertex' x+-- starTranspose x [y]   == 'edge' y x+-- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]+-- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)+-- starTranspose x ys    == 'transpose' ('star' x ys)+-- @+starTranspose :: a -> [a] -> Graph a+starTranspose = H.starTranspose++-- | The /tree graph/ constructed from a given 'Tree.Tree' data structure. -- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the -- given tree (i.e. the number of vertices in the tree). --@@ -605,7 +620,7 @@ tree :: Tree.Tree a -> Graph a tree = H.tree --- | The /forest graph/ constructed from a given 'Forest' data structure.+-- | The /forest graph/ constructed from a given 'Tree.Forest' data structure. -- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the -- given forest (i.e. the number of vertices in the forest). --@@ -651,7 +666,7 @@ -- | Construct a /De Bruijn graph/ of a given non-negative dimension using symbols -- from a given alphabet. -- Complexity: /O(A^(D + 1))/ time, memory and size, where /A/ is the size of the--- alphabet and /D/ is the dimention of the graph.+-- alphabet and /D/ is the dimension of the graph. -- -- @ --           deBruijn 0 xs               == 'edge' [] []@@ -672,52 +687,36 @@ -- -- @ -- 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 :: Eq a => a -> Graph a -> Graph a removeVertex = H.removeVertex  -- | Remove an edge from a given graph.--- Complexity: /O(s)/ time and memory. The worst case size complexity is /O(s^2)/,--- although in practice it is usually also linear /O(s)/.+-- Complexity: /O(s)/ time, memory and size. -- -- @ -- removeEdge x y ('edge' x y)       == 'vertices' [x, y] -- removeEdge x y . removeEdge x y == removeEdge x y--- removeEdge x y . 'Algebra.Graph.HigherKinded.Util.removeVertex' x == 'Algebra.Graph.HigherKinded.Util.removeVertex' 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+-- 'size' (removeEdge x y z)         <= 3 * 'size' z -- @ removeEdge :: Eq a => a -> a -> Graph a -> Graph a-removeEdge s t g = piece st where (_, _, st) = smash s t g--data Piece a = Piece { piece :: Graph a, intact :: Bool }--breakIf :: Bool -> Piece a -> Piece a-breakIf True  _ = Piece Empty False-breakIf False x = x--instance C.Graph (Piece a) where-    type Vertex (Piece a) = a-    empty       = Piece Empty True-    vertex x    = Piece (Vertex x) True-    overlay x y = Piece (nonTrivial Overlay (piece x) (piece y)) (intact x && intact y)-    connect x y = Piece (nonTrivial Connect (piece x) (piece y)) (intact x && intact y)--nonTrivial :: (Graph a -> Graph a -> Graph a) -> Graph a -> Graph a -> Graph a-nonTrivial _ Empty x = x-nonTrivial _ x Empty = x-nonTrivial f x y     = f x y--type Pieces a = (Piece a, Piece a, Piece a)+removeEdge s t = filterContext s (/=s) (/=t) -smash :: Eq a => a -> a -> Graph a -> Pieces a-smash s t = foldg C.empty v C.overlay c+-- TODO: Export+-- | Filter vertices in a subgraph context.+filterContext :: Eq a => a -> (a -> Bool) -> (a -> Bool) -> Graph a -> Graph a+filterContext s i o g = maybe g go $ context (==s) g   where-    v x = (breakIf (x == s) $ C.vertex x, breakIf (x == t) $ C.vertex x, C.vertex x)-    c x@(sx, tx, stx) y@(sy, ty, sty)-        | intact sx || intact ty = C.connect x y-        | otherwise = (C.connect sx sy, C.connect tx ty, C.connect sx sty `C.overlay` C.connect stx ty)+    go (Context is os) = overlays [ induce (/=s) g+                                  , starTranspose s (filter i is)+                                  , star          s (filter o os) ]  -- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a -- given 'Graph'. If @y@ already exists, @x@ and @y@ will be merged.@@ -731,7 +730,7 @@ replaceVertex :: Eq a => a -> a -> Graph a -> Graph a replaceVertex = H.replaceVertex --- | Merge vertices satisfying a given predicate with a given vertex.+-- | Merge vertices satisfying a given predicate into a given vertex. -- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes -- /O(1)/ to be evaluated. --@@ -766,14 +765,11 @@ -- transpose ('vertex' x)  == 'vertex' x -- transpose ('edge' x y)  == 'edge' y x -- transpose . transpose == id--- transpose . 'path'      == 'path'    . 'reverse'--- transpose . 'circuit'   == 'circuit' . 'reverse'--- transpose . 'clique'    == 'clique'  . 'reverse' -- transpose ('box' x y)   == 'box' (transpose x) (transpose y) -- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' -- @ transpose :: Graph a -> Graph a-transpose = foldg empty vertex overlay (flip connect)+transpose = foldg Empty Vertex Overlay (flip Connect)  -- | Construct the /induced subgraph/ of a given graph by removing the -- vertices that do not satisfy a given predicate.@@ -781,14 +777,18 @@ -- /O(1)/ to be evaluated. -- -- @--- induce (const True)  x      == x+-- 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) -> Graph a -> Graph a-induce = H.induce+induce p = foldg Empty (\x -> if p x then Vertex x else Empty) (k Overlay) (k Connect)+  where+    k _ x     Empty = x -- Constant folding to get rid of Empty leaves+    k _ Empty y     = y+    k f x     y     = f x y  -- | Simplify a graph expression. Semantically, this is the identity function, -- but it simplifies a given expression according to the laws of the algebra.

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.AdjacencyMap--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -22,7 +22,7 @@      -- * Basic graph construction primitives     empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,-    graph, fromAdjacencyList,+    fromAdjacencyList,      -- * Relations on graphs     isSubgraphOf,@@ -32,7 +32,7 @@     adjacencyList, vertexSet, edgeSet, postSet,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, tree, forest,+    path, circuit, clique, biclique, star, starTranspose, tree, forest,      -- * Graph transformation     removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,@@ -71,7 +71,6 @@ -- @ -- 'isEmpty'     (vertex x) == False -- 'hasVertex' x (vertex x) == True--- 'hasVertex' 1 (vertex 2) == False -- 'vertexCount' (vertex x) == 1 -- 'edgeCount'   (vertex x) == 0 -- @@@ -91,7 +90,7 @@ edge :: Ord a => a -> a -> AdjacencyMap a edge = C.edge --- | /Overlay/ two graphs. This is an idempotent, commutative and associative+-- | /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. --@@ -109,7 +108,7 @@ overlay = C.overlay  -- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over the overlay and obeys the decomposition axiom.+-- '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)/.@@ -162,6 +161,7 @@ -- overlays []        == 'empty' -- overlays [x]       == x -- overlays [x,y]     == 'overlay' x y+-- overlays           == 'foldr' 'overlay' 'empty' -- 'isEmpty' . overlays == 'all' 'isEmpty' -- @ overlays :: Ord a => [AdjacencyMap a] -> AdjacencyMap a@@ -174,25 +174,12 @@ -- connects []        == 'empty' -- connects [x]       == x -- connects [x,y]     == 'connect' x y+-- connects           == 'foldr' 'connect' 'empty' -- 'isEmpty' . connects == 'all' 'isEmpty' -- @ connects :: Ord a => [AdjacencyMap a] -> AdjacencyMap a connects = C.connects --- | Construct the graph from given lists of vertices /V/ and edges /E/.--- The resulting graph contains the vertices /V/ as well as all the vertices--- referred to by the edges /E/.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- graph []  []      == 'empty'--- graph [x] []      == 'vertex' x--- graph []  [(x,y)] == 'edge' x y--- graph vs  es      == 'overlay' ('vertices' vs) ('edges' es)--- @-graph :: Ord a => [a] -> [(a, a)] -> AdjacencyMap a-graph vs es = overlay (vertices vs) (edges es)- -- | Construct a graph from an adjacency list. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -243,6 +230,7 @@ -- @ -- hasVertex x 'empty'            == False -- hasVertex x ('vertex' x)       == True+-- hasVertex 1 ('vertex' 2)       == False -- hasVertex x . 'removeVertex' x == const False -- @ hasVertex :: Ord a => a -> AdjacencyMap a -> Bool@@ -348,7 +336,7 @@ edgeSet :: Ord a => AdjacencyMap a -> Set (a, a) edgeSet = Map.foldrWithKey (\v es -> Set.union (Set.mapMonotonic (v,) es)) Set.empty . adjacencyMap --- | The /postset/ of a vertex is the set of its /direct successors/.+-- | The /postset/ (here 'postSet') of a vertex is the set of its /direct successors/. -- -- @ -- postSet x 'empty'      == Set.'Set.empty'@@ -397,7 +385,7 @@ clique :: Ord a => [a] -> AdjacencyMap a clique = C.clique --- | The /biclique/ on a list of vertices.+-- | The /biclique/ on two lists of vertices. -- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory. -- -- @@@ -416,17 +404,32 @@         | v `Set.member` x = y         | otherwise        = Set.empty --- | The /star/ formed by a centre vertex and a list of leaves.+-- | 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] -> AdjacencyMap a star = C.star +-- | The /star transpose/ formed by a list of leaves connected to a centre vertex.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- starTranspose x []    == 'vertex' x+-- starTranspose x [y]   == 'edge' y x+-- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]+-- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)+-- starTranspose x ys    == 'transpose' ('star' x ys)+-- @+starTranspose :: Ord a => a -> [a] -> AdjacencyMap a+starTranspose = C.starTranspose+ -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -456,6 +459,9 @@ -- -- @ -- 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 -> AdjacencyMap a -> AdjacencyMap a@@ -486,7 +492,7 @@ replaceVertex :: Ord a => a -> a -> AdjacencyMap a -> AdjacencyMap a replaceVertex u v = gmap $ \w -> if w == u then v else w --- | Merge vertices satisfying a given predicate with a given vertex.+-- | 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. --@@ -507,9 +513,6 @@ -- transpose ('vertex' x)  == 'vertex' x -- transpose ('edge' x y)  == 'edge' y x -- transpose . transpose == id--- transpose . 'path'      == 'path'    . 'reverse'--- transpose . 'circuit'   == 'circuit' . 'reverse'--- transpose . 'clique'    == 'clique'  . 'reverse' -- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' -- @ transpose :: Ord a => AdjacencyMap a -> AdjacencyMap a@@ -539,7 +542,7 @@ -- be evaluated. -- -- @--- induce (const True)  x      == x+-- induce (const True ) x      == x -- induce (const False) x      == 'empty' -- induce (/= x)               == 'removeVertex' x -- induce p . induce q         == induce (\\x -> p x && q x)

@@ -1,14 +1,14 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.AdjacencyMap.Internal--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : unstable -- -- This module exposes the implementation of adjacency maps. The API is unstable--- and unsafe. Where possible use non-internal module "Algebra.Graph.AdjacencyMap"--- instead.+-- and unsafe, and is exposed only for documentation. You should use the+-- non-internal module "Algebra.Graph.AdjacencyMap" instead. ----------------------------------------------------------------------------- module Algebra.Graph.AdjacencyMap.Internal (     -- * Adjacency map implementation@@ -18,6 +18,7 @@     GraphKL (..), mkGraphKL   ) where +import Data.List import Data.Map.Strict (Map, keysSet, fromSet) import Data.Set (Set) @@ -44,7 +45,7 @@ show (1 + 2     :: AdjacencyMap Int) == "vertices [1,2]" show (1 * 2     :: AdjacencyMap Int) == "edge 1 2" show (1 * 2 * 3 :: AdjacencyMap Int) == "edges [(1,2),(1,3),(2,3)]"-show (1 * 2 + 3 :: AdjacencyMap Int) == "graph [1,2,3] [(1,2)]"@+show (1 * 2 + 3 :: AdjacencyMap Int) == "overlay (vertex 3) (edge 1 2)"@  The 'Eq' instance satisfies all axioms of algebraic graphs: @@ -106,22 +107,22 @@  instance (Ord a, Show a) => Show (AdjacencyMap a) where     show (AM m _)-        | m == Map.empty = "empty"-        | es == []       = if Set.size vs > 1 then "vertices " ++ show (Set.toAscList vs)-                                              else "vertex "   ++ show v-        | vs == referred = if length es > 1 then "edges " ++ show es-                                            else "edge "  ++ show e ++ " " ++ show f-        | otherwise      = "graph " ++ show (Set.toAscList vs) ++ " " ++ show es+        | null vs    = "empty"+        | null es    = vshow vs+        | vs == used = eshow es+        | otherwise  = "overlay (" ++ vshow (vs \\ used) ++ ") (" ++ eshow es ++ ")"       where-        vs       = keysSet m-        es       = internalEdgeList m-        v        = head $ Set.toList vs-        (e, f)   = head es-        referred = referredToVertexSet m+        vs             = Set.toAscList (keysSet m)+        es             = internalEdgeList m+        vshow [x]      = "vertex "   ++ show x+        vshow xs       = "vertices " ++ show xs+        eshow [(x, y)] = "edge "     ++ show x ++ " " ++ show y+        eshow xs       = "edges "    ++ show xs+        used           = Set.toAscList (referredToVertexSet m)  instance Ord a => Graph (AdjacencyMap a) where     type Vertex (AdjacencyMap a) = a-    empty       = mkAM $ Map.empty+    empty       = mkAM   Map.empty     vertex x    = mkAM $ Map.singleton x Set.empty     overlay x y = mkAM $ Map.unionWith Set.union (adjacencyMap x) (adjacencyMap y)     connect x y = mkAM $ Map.unionsWith Set.union [ adjacencyMap x, adjacencyMap y,

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Class--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -38,18 +38,21 @@     Preorder,      -- * Basic graph construction primitives-    edge, vertices, overlays, connects, edges, graph,+    edge, vertices, overlays, connects, edges,      -- * Relations on graphs     isSubgraphOf,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, tree, forest,+    path, circuit, clique, biclique, star, starTranspose, tree, forest,      -- * Conversion between graph data types     ToGraph (..)   ) where +import Prelude ()+import Prelude.Compat+ import Data.Tree  {-|@@ -252,9 +255,12 @@ -- overlays []    == 'empty' -- overlays [x]   == x -- overlays [x,y] == 'overlay' x y+-- overlays       == 'foldr' 'overlay' 'empty' -- @ overlays :: Graph g => [g] -> g-overlays = foldr overlay empty+overlays []     = empty+overlays [x]    = x+overlays (x:xs) = x `overlay` overlays xs  -- | Connect a given list of graphs. -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length@@ -264,23 +270,12 @@ -- connects []    == 'empty' -- connects [x]   == x -- connects [x,y] == 'connect' x y+-- connects       == 'foldr' 'connect' 'empty' -- @ connects :: Graph g => [g] -> g-connects = foldr connect empty---- | Construct the graph from given lists of vertices /V/ and edges /E/.--- The resulting graph contains the vertices /V/ as well as all the vertices--- referred to by the edges /E/.--- Complexity: /O(|V| + |E|)/ time, memory and size.------ @--- graph []  []      == 'empty'--- graph [x] []      == 'vertex' x--- graph []  [(x,y)] == 'edge' x y--- graph vs  es      == 'overlay' ('vertices' vs) ('edges' es)--- @-graph :: Graph g => [Vertex g] -> [(Vertex g, Vertex g)] -> g-graph vs es = overlay (vertices vs) (edges es)+connects []     = empty+connects [x]    = x+connects (x:xs) = x `connect` connects xs  -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the -- first graph is a /subgraph/ of the second. Here is the current implementation:@@ -311,9 +306,9 @@ -- path [x,y] == 'edge' x y -- @ path :: Graph g => [Vertex g] -> g-path []  = empty-path [x] = vertex x-path xs  = edges $ zip xs (tail xs)+path xs = case xs of []     -> empty+                     [x]    -> vertex x+                     (_:ys) -> edges (zip xs ys)  -- | The /circuit/ on a list of vertices. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -342,7 +337,7 @@ clique :: Graph g => [Vertex g] -> g clique = connects . map vertex --- | The /biclique/ on a list of vertices.+-- | The /biclique/ on two lists of vertices. -- Complexity: /O(L1 + L2)/ time, memory and size, where /L1/ and /L2/ are the -- lengths of the given lists. --@@ -354,9 +349,11 @@ -- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: Graph g => [Vertex g] -> [Vertex g] -> g+biclique xs [] = vertices xs+biclique [] ys = vertices ys biclique xs ys = connect (vertices xs) (vertices ys) --- | The /star/ formed by a centre vertex and a list of leaves.+-- | The /star/ formed by a centre vertex connected to a list of leaves. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the -- given list. --@@ -364,10 +361,27 @@ -- 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 :: Graph g => Vertex g -> [Vertex g] -> g+star x [] = vertex x star x ys = connect (vertex x) (vertices ys) +-- | The /star transpose/ formed by a list of leaves connected to a centre vertex.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- starTranspose x []    == 'vertex' x+-- starTranspose x [y]   == 'edge' y x+-- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]+-- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)+-- starTranspose x ys    == transpose ('star' x ys)+-- @+starTranspose :: Graph g => Vertex g -> [Vertex g] -> g+starTranspose x [] = vertex x+starTranspose x ys = connect (vertices ys) (vertex x)+ -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the -- given tree (i.e. the number of vertices in the tree).@@ -379,7 +393,9 @@ -- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)] -- @ tree :: Graph g => Tree (Vertex g) -> g-tree (Node x f) = overlay (star x $ map rootLabel f) (forest f)+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 'Forest' data structure. -- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the@@ -403,6 +419,35 @@ --       toGraph (g     :: 'Algebra.Graph.Graph' a  ) :: 'Algebra.Graph.Graph' a       == g -- 'show' (toGraph (1 * 2 :: 'Algebra.Graph.Graph' Int) :: 'Algebra.Graph.Relation' Int) == "edge 1 2" -- @+--+-- The second method 'foldg' is used for generalised graph folding. It recursively+-- collapses a given data type by applying the provided graph construction+-- primitives. The order of arguments is: empty, vertex, overlay and connect,+-- and it is assumed that the functions satisfy the axioms of the algebra.+-- The following law establishes the relation between 'toGraph' and 'foldg':+--+-- @+-- toGraph == foldg 'empty' 'vertex' 'overlay' 'connect'+-- @ class ToGraph t where     type ToVertex t     toGraph :: (Graph g, Vertex g ~ ToVertex t) => t -> g+    toGraph = foldg empty vertex overlay connect+    foldg :: r -> (ToVertex t -> r) -> (r -> r -> r) -> (r -> r -> r) -> t -> r+    foldg e v o c = go . toGraph+      where+        go E       = e+        go (V x  ) = v x+        go (O x y) = o (go x) (go y)+        go (C x y) = c (go x) (go y)++-- TODO: Get rid of code duplication. Note: we do not use the data type Graph+-- here due to import cycle.+data G a = E | V a | O (G a) (G a) | C (G a) (G a)++instance Graph (G a) where+    type Vertex (G a) = a+    empty   = E+    vertex  = V+    overlay = O+    connect = C

@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Export--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -11,9 +11,8 @@ -- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the -- motivation behind the library, the underlying theory, and implementation details. ----- This module defines basic data types and functions for exporting graphs in--- textual and binary formats. "Algebra.Graph.Export.Dot" provides DOT-specific--- functionality.+-- This module defines basic functionality for exporting graphs in textual and+-- binary formats. "Algebra.Graph.Export.Dot" provides DOT-specific functions. ----------------------------------------------------------------------------- module Algebra.Graph.Export (     -- * Constructing and exporting documents@@ -26,19 +25,27 @@     export   ) where +import Prelude ()+import Prelude.Compat hiding (unlines)++import Data.Foldable (fold) import Data.Semigroup import Data.String hiding (unlines)-import Prelude hiding (unlines)  import Algebra.Graph.AdjacencyMap import Algebra.Graph.Class (ToGraph (..))+import Algebra.Graph.Internal --- | An abstract document type, where @s@ is the type of strings or words (text--- or binary). 'Doc' @s@ is a 'Monoid', therefore 'mempty' corresponds to the--- empty document and two documents can be concatenated with 'mappend' (or--- operator 'Data.Monoid.<>'). Note that most functions on 'Doc' @s@ require--- that the underlying type @s@ is also a 'Monoid'.-newtype Doc s = Doc (Endo [s]) deriving (Monoid, Semigroup)+-- | An abstract document data type with /O(1)/ time concatenation (the current+-- implementation uses difference lists). Here @s@ is the type of abstract+-- symbols or strings (text or binary). 'Doc' @s@ is a 'Monoid', therefore+-- 'mempty' corresponds to the empty document and two documents can be+-- concatenated with 'mappend' (or operator 'Data.Monoid.<>'). Documents+-- comprising a single symbol or string can be constructed using the function+-- 'literal'. Alternatively, you can construct documents as string literals, e.g.+-- simply as @"alga"@, by using the @OverloadedStrings@ GHC extension. To extract+-- the document contents use the function 'render'. See some examples below.+newtype Doc s = Doc (List s) deriving (Monoid, Semigroup)  instance (Monoid s, Show s) => Show (Doc s) where     show = show . render@@ -52,32 +59,31 @@ instance IsString s => IsString (Doc s) where     fromString = literal . fromString --- | Construct a document comprising a single string or word. If @s@ is an+-- | Construct a document comprising a single symbol or string. If @s@ is an -- instance of class 'IsString', then documents of type 'Doc' @s@ can be -- constructed directly from string literals (see the second example below). -- -- @--- literal "Hello, " <> literal "World!" == literal "Hello, World!"+-- literal "Hello, " 'Data.Monoid.<>' literal "World!" == literal "Hello, World!" -- literal "I am just a string literal"  == "I am just a string literal" -- literal 'mempty'                        == 'mempty' -- 'render' . literal                      == 'id' -- literal . 'render'                      == 'id' -- @ literal :: s -> Doc s-literal = Doc . Endo . (:)+literal = Doc . pure --- | Render a document as a single string or word. An inverse of the function--- 'literal'.+-- | Render the document as a single string. An inverse of the function 'literal'. -- -- @--- render ('literal' "al" <> 'literal' "ga") :: ('IsString' s, 'Monoid' s) => s--- render ('literal' "al" <> 'literal' "ga") == "alga"+-- render ('literal' "al" 'Data.Monoid.<>' 'literal' "ga") :: ('IsString' s, 'Monoid' s) => s+-- render ('literal' "al" 'Data.Monoid.<>' 'literal' "ga") == "alga" -- render 'mempty'                         == 'mempty' -- render . 'literal'                      == 'id' -- 'literal' . render                      == 'id' -- @ render :: Monoid s => Doc s -> s-render (Doc x) = mconcat $ appEndo x []+render (Doc x) = fold x  -- | Concatenate two documents, separated by a single space, unless one of the -- documents is empty. The operator \<+\> is associative with identity 'mempty'.@@ -155,6 +161,6 @@ export :: (Ord a, ToGraph g, ToVertex g ~ a) => (a -> Doc s) -> (a -> a -> Doc s) -> g -> Doc s export vs es g = vDoc <> eDoc   where-    vDoc   = mconcat $ map (vs        ) (vertexList adjMap)+    vDoc   = mconcat $ map  vs          (vertexList adjMap)     eDoc   = mconcat $ map (uncurry es) (edgeList   adjMap)     adjMap = toGraph g

@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Export.Dot--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -113,7 +113,7 @@ export Style {..} g = render $ header <> body <> "}\n"   where     header    = "digraph" <+> literal graphName <> "\n{\n"-             <> if preamble == mempty then mempty else (literal preamble <> "\n")+             <> if preamble == mempty then mempty else literal preamble <> "\n"     with x as = if null as            then mempty else line (x <+> attributes as)     line s    = indent 2 s <> "\n"     body      = ("graph" `with` graphAttributes)

@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Fold--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -24,7 +24,6 @@      -- * Basic graph construction primitives     empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,-    C.graph,      -- * Graph folding     foldg,@@ -37,8 +36,8 @@     edgeList, vertexSet, vertexIntSet, edgeSet,      -- * Standard families of graphs-    C.path, C.circuit, C.clique, C.biclique, C.star, C.tree, C.forest,-    mesh, torus, deBruijn,+    C.path, C.circuit, C.clique, C.biclique, C.star, C.starTranspose, C.tree,+    C.forest, mesh, torus, deBruijn,      -- * Graph transformation     removeVertex, removeEdge, replaceVertex, mergeVertices, splitVertex,@@ -48,10 +47,15 @@     box   ) where +import Prelude ()+import Prelude.Compat+ import Control.Applicative hiding (empty)-import Control.Monad+import Control.Monad.Compat (MonadPlus (..), ap) import Data.Foldable +import Algebra.Graph.Internal+ import qualified Algebra.Graph.AdjacencyMap       as AM import qualified Algebra.Graph.Class              as C import qualified Algebra.Graph.HigherKinded.Class as H@@ -59,7 +63,7 @@ import qualified Data.IntSet                      as IntSet import qualified Data.Set                         as Set -{-| The 'Fold' datatype is the Boehm-Berarducci encoding of the core graph+{-| The 'Fold' data type is the Boehm-Berarducci encoding of the core graph construction primitives 'empty', 'vertex', 'overlay' and 'connect'. We define a 'Num' instance as a convenient notation for working with graphs: @@ -76,7 +80,7 @@ show (1 + 2     :: Fold Int) == "vertices [1,2]" show (1 * 2     :: Fold Int) == "edge 1 2" show (1 * 2 * 3 :: Fold Int) == "edges [(1,2),(1,3),(2,3)]"-show (1 * 2 + 3 :: Fold Int) == "graph [1,2,3] [(1,2)]"@+show (1 * 2 + 3 :: Fold Int) == "overlay (vertex 3) (edge 1 2)"@  The 'Eq' instance is currently implemented using the 'AM.AdjacencyMap' as the /canonical graph representation/ and satisfies all axioms of algebraic graphs:@@ -196,7 +200,7 @@  instance C.ToGraph (Fold a) where     type ToVertex (Fold a) = a-    toGraph = foldg C.empty C.vertex C.overlay C.connect+    foldg e v o c g = runFold g e v o c  instance H.ToGraph Fold where     toGraph = foldg H.empty H.vertex H.overlay H.connect@@ -220,7 +224,6 @@ -- @ -- 'isEmpty'     (vertex x) == False -- 'hasVertex' x (vertex x) == True--- 'hasVertex' 1 (vertex 2) == False -- 'vertexCount' (vertex x) == 1 -- 'edgeCount'   (vertex x) == 0 -- 'size'        (vertex x) == 1@@ -241,7 +244,7 @@ edge :: C.Graph g => C.Vertex g -> C.Vertex g -> g edge = C.edge --- | /Overlay/ two graphs. This is an idempotent, commutative and associative+-- | /Overlay/ two graphs. This is a commutative, associative and idempotent -- operation with the identity 'empty'. -- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. --@@ -260,7 +263,7 @@ overlay = C.overlay  -- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over the overlay and obeys the decomposition axiom.+-- 'empty', which distributes over 'overlay' and obeys the decomposition axiom. -- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. 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)/.@@ -315,6 +318,7 @@ -- overlays []        == 'empty' -- overlays [x]       == x -- overlays [x,y]     == 'overlay' x y+-- overlays           == 'foldr' 'overlay' 'empty' -- 'isEmpty' . overlays == 'all' 'isEmpty' -- @ overlays :: C.Graph g => [g] -> g@@ -328,6 +332,7 @@ -- connects []        == 'empty' -- connects [x]       == x -- connects [x,y]     == 'connect' x y+-- connects           == 'foldr' 'connect' 'empty' -- 'isEmpty' . connects == 'all' 'isEmpty' -- @ connects :: C.Graph g => [g] -> g@@ -348,7 +353,7 @@ -- foldg True  (const False) (&&)    (&&)           == 'isEmpty' -- @ foldg :: b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> Fold a -> b-foldg e v o c g = runFold g e v o c+foldg = C.foldg  -- | Check if a graph is empty. A convenient alias for 'null'. -- Complexity: /O(s)/ time.@@ -384,6 +389,7 @@ -- @ -- hasVertex x 'empty'            == False -- hasVertex x ('vertex' x)       == True+-- hasVertex 1 ('vertex' 2)       == False -- hasVertex x . 'removeVertex' x == const False -- @ hasVertex :: Eq a => a -> Fold a -> Bool@@ -402,35 +408,6 @@ hasEdge :: Ord a => a -> a -> Fold a -> Bool hasEdge = H.hasEdge -data Piece g = Piece { piece :: g, intact :: Bool, trivial :: Bool }--breakIf :: C.Graph g => Bool -> Piece g -> Piece g-breakIf True  _ = Piece C.empty False True-breakIf False x = x--instance C.Graph g => C.Graph (Piece g) where-    type Vertex (Piece g) = C.Vertex g-    empty       = Piece C.empty True True-    vertex x    = Piece (C.vertex x) True False-    overlay x y = Piece (nonTrivial C.overlay x y) (intact x && intact y) False-    connect x y = Piece (nonTrivial C.connect x y) (intact x && intact y) False--nonTrivial :: (g -> g -> g) -> Piece g -> Piece g -> g-nonTrivial f x y-    | trivial x = piece y-    | trivial y = piece x-    | otherwise = f (piece x) (piece y)--type Pieces a = (Piece a, Piece a, Piece a)--smash :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> C.Vertex g -> Fold (C.Vertex g) -> Pieces g-smash s t = foldg C.empty v C.overlay c-  where-    v x = (breakIf (x == s) $ C.vertex x, breakIf (x == t) $ C.vertex x, C.vertex x)-    c x@(sx, tx, stx) y@(sy, ty, sty)-        | intact sx || intact ty = C.connect x y-        | otherwise = (C.connect sx sy, C.connect tx ty, C.connect sx sty `C.overlay` C.connect stx ty)- -- | The number of vertices in a graph. -- Complexity: /O(s * log(n))/ time. --@@ -551,7 +528,7 @@ -- | Construct a /De Bruijn graph/ of a given non-negative dimension using symbols -- from a given alphabet. -- Complexity: /O(A^(D + 1))/ time, memory and size, where /A/ is the size of the--- alphabet and /D/ is the dimention of the graph.+-- alphabet and /D/ is the dimension of the graph. -- -- @ --           deBruijn 0 xs               == 'edge' [] []@@ -577,14 +554,16 @@ -- -- @ -- 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 :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> Fold (C.Vertex g) -> g removeVertex v = induce (/= v)  -- | Remove an edge from a given graph.--- Complexity: /O(s)/ time and memory. The worst case size complexity is /O(s^2)/,--- although in practice it is usually also linear /O(s)/.+-- Complexity: /O(s)/ time, memory and size. -- -- @ -- removeEdge x y ('edge' x y)       == 'vertices' [x, y]@@ -592,10 +571,21 @@ -- 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+-- 'size' (removeEdge x y z)         <= 3 * 'size' z -- @ removeEdge :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> C.Vertex g -> Fold (C.Vertex g) -> g-removeEdge s t g = piece st where (_, _, st) = smash s t g+removeEdge s t = filterContext s (/=s) (/=t) +-- TODO: Export+-- | Filter vertices in a subgraph context.+filterContext :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> (C.Vertex g -> Bool)+              -> (C.Vertex g -> Bool) -> Fold (C.Vertex g) -> g+filterContext s i o g = maybe (C.toGraph g) go $ context (==s) g+  where+    go (Context is os) = overlays [ induce (/=s) g+                                  , C.starTranspose s (filter i is)+                                  , C.star          s (filter o os) ]+ -- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a -- given graph expression. If @y@ already exists, @x@ and @y@ will be merged. -- Complexity: /O(s)/ time, memory and size.@@ -608,7 +598,7 @@ replaceVertex :: (Eq (C.Vertex g), C.Graph g) => C.Vertex g -> C.Vertex g -> Fold (C.Vertex g) -> g replaceVertex u v = gmap $ \w -> if w == u then v else w --- | Merge vertices satisfying a given predicate with a given vertex.+-- | Merge vertices satisfying a given predicate into a given vertex. -- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes -- /O(1)/ to be evaluated. --@@ -643,9 +633,6 @@ -- transpose ('vertex' x)  == 'vertex' x -- transpose ('edge' x y)  == 'edge' y x -- transpose . transpose == id--- transpose . 'C.path'      == 'C.path'    . 'reverse'--- transpose . 'C.circuit'   == 'C.circuit' . 'reverse'--- transpose . 'C.clique'    == 'C.clique'  . 'reverse' -- transpose ('box' x y)   == 'box' (transpose x) (transpose y) -- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' -- @@@ -687,14 +674,18 @@ -- /O(1)/ to be evaluated. -- -- @--- induce (const True)  x      == x+-- 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 :: C.Graph g => (C.Vertex g -> Bool) -> Fold (C.Vertex g) -> g-induce p g = bind g $ \v -> if p v then C.vertex v else C.empty+induce p = C.toGraph . foldg empty (\x -> if p x then vertex x else empty) (k overlay) (k connect)+  where+    k f x y | isEmpty x = y -- Constant folding to get rid of Empty leaves+            | isEmpty y = x+            | otherwise = f x y  -- | Simplify a graph expression. Semantically, this is the identity function, -- but it simplifies a given polymorphic graph expression according to the laws

@@ -1,7 +1,8 @@+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.HigherKinded.Class--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -36,7 +37,7 @@     Preorder,      -- * Basic graph construction primitives-    edge, vertices, edges, overlays, connects, graph,+    edge, vertices, edges, overlays, connects,      -- * Relations on graphs     isSubgraphOf,@@ -45,7 +46,8 @@     isEmpty, hasVertex, hasEdge, vertexCount, vertexList, vertexSet, vertexIntSet,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, tree, forest, mesh, torus, deBruijn,+    path, circuit, clique, biclique, star, starTranspose, tree, forest, mesh,+    torus, deBruijn,      -- * Graph transformation     removeVertex, replaceVertex, mergeVertices, splitVertex, induce,@@ -58,9 +60,12 @@    ) where -import Control.Applicative (empty, (<|>))-import Control.Monad-import Data.Foldable+import Prelude ()+import Prelude.Compat++import Control.Applicative (Alternative(empty, (<|>)))+import Control.Monad.Compat (MonadPlus, msum, mfilter)+import Data.Foldable (toList) import Data.Tree  import qualified Data.IntSet as IntSet@@ -125,7 +130,11 @@ edges in the graph, and /s/ will denote the /size/ of the corresponding 'Graph' expression. -}-class (Traversable g, MonadPlus g) => Graph g where+class (Traversable g,+#if !MIN_VERSION_base(4,8,0)+  Alternative g,+#endif+  MonadPlus g) => Graph g where     -- | Connect two graphs.     connect :: g a -> g a -> g a @@ -224,10 +233,13 @@ -- overlays []        == 'empty' -- overlays [x]       == x -- overlays [x,y]     == 'overlay' x y+-- overlays           == 'foldr' 'overlay' 'empty' -- 'isEmpty' . overlays == 'all' 'isEmpty' -- @ overlays :: Graph g => [g a] -> g a-overlays = msum+overlays []     = empty+overlays [x]    = x+overlays (x:xs) = x `overlay` overlays xs  -- | Connect a given list of graphs. -- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length@@ -237,24 +249,13 @@ -- connects []        == 'empty' -- connects [x]       == x -- connects [x,y]     == 'connect' x y+-- connects           == 'foldr' 'connect' 'empty' -- 'isEmpty' . connects == 'all' 'isEmpty' -- @ connects :: Graph g => [g a] -> g a-connects = foldr connect empty---- | Construct the graph from given lists of vertices /V/ and edges /E/.--- The resulting graph contains the vertices /V/ as well as all the vertices--- referred to by the edges /E/.--- Complexity: /O(|V| + |E|)/ time, memory and size.------ @--- graph []  []      == 'empty'--- graph [x] []      == 'vertex' x--- graph []  [(x,y)] == 'edge' x y--- graph vs  es      == 'overlay' ('vertices' vs) ('edges' es)--- @-graph :: Graph g => [a] -> [(a, a)] -> g a-graph vs es = overlay (vertices vs) (edges es)+connects []     = empty+connects [x]    = x+connects (x:xs) = x `connect` connects xs  -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the -- first graph is a /subgraph/ of the second. Here is the current implementation:@@ -293,6 +294,7 @@ -- @ -- hasVertex x 'empty'            == False -- hasVertex x ('vertex' x)       == True+-- hasVertex 1 ('vertex' 2)       == False -- hasVertex x . 'removeVertex' x == const False -- @ hasVertex :: (Eq a, Graph g) => a -> g a -> Bool@@ -367,9 +369,9 @@ -- path [x,y] == 'edge' x y -- @ path :: Graph g => [a] -> g a-path []  = empty-path [x] = vertex x-path xs  = edges $ zip xs (tail xs)+path xs = case xs of []     -> empty+                     [x]    -> vertex x+                     (_:ys) -> edges (zip xs ys)  -- | The /circuit/ on a list of vertices. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the@@ -398,7 +400,7 @@ clique :: Graph g => [a] -> g a clique = connects . map vertex --- | The /biclique/ on a list of vertices.+-- | The /biclique/ on two lists of vertices. -- Complexity: /O(L1 + L2)/ time, memory and size, where /L1/ and /L2/ are the -- lengths of the given lists. --@@ -410,9 +412,11 @@ -- biclique xs      ys      == 'connect' ('vertices' xs) ('vertices' ys) -- @ biclique :: Graph g => [a] -> [a] -> g a+biclique xs [] = vertices xs+biclique [] ys = vertices ys biclique xs ys = connect (vertices xs) (vertices ys) --- | The /star/ formed by a centre vertex and a list of leaves.+-- | The /star/ formed by a centre vertex connected to a list of leaves. -- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the -- given list. --@@ -420,10 +424,27 @@ -- 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 :: Graph g => a -> [a] -> g a+star x [] = vertex x star x ys = connect (vertex x) (vertices ys) +-- | The /star transpose/ formed by a list of leaves connected to a centre vertex.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- starTranspose x []    == 'vertex' x+-- starTranspose x [y]   == 'edge' y x+-- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]+-- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)+-- starTranspose x ys    == transpose ('star' x ys)+-- @+starTranspose :: Graph g => a -> [a] -> g a+starTranspose x [] = vertex x+starTranspose x ys = connect (vertices ys) (vertex x)+ -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the -- given tree (i.e. the number of vertices in the tree).@@ -435,7 +456,9 @@ -- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)] -- @ tree :: Graph g => Tree a -> g a-tree (Node x f) = overlay (star x $ map rootLabel f) (forest f)+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 'Forest' data structure. -- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the@@ -483,7 +506,7 @@ -- | Construct a /De Bruijn graph/ of a given non-negative dimension using symbols -- from a given alphabet. -- Complexity: /O(A^(D + 1))/ time, memory and size, where /A/ is the size of the--- alphabet and /D/ is the dimention of the graph.+-- alphabet and /D/ is the dimension of the graph. -- -- @ --           deBruijn 0 xs               == 'edge' [] []@@ -492,7 +515,7 @@ --           deBruijn 2 "0"              == 'edge' "00" "00" --           deBruijn 2 "01"             == 'edges' [ ("00","00"), ("00","01"), ("01","10"), ("01","11") --                                                , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]---           'transpose'   (deBruijn n xs) == 'fmap' 'reverse' $ deBruijn n xs+--           transpose   (deBruijn n xs) == 'fmap' 'reverse' $ deBruijn n xs --           'vertexCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^n -- n > 0 ==> 'edgeCount'   (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1) -- @@@ -510,7 +533,7 @@ -- /O(1)/ to be evaluated. -- -- @--- induce (const True)  x      == x+-- induce (const True ) x      == x -- induce (const False) x      == 'empty' -- induce (/= x)               == 'removeVertex' x -- induce p . induce q         == induce (\\x -> p x && q x)@@ -524,6 +547,9 @@ -- -- @ -- 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 :: (Eq a, Graph g) => a -> g a -> g a@@ -541,7 +567,7 @@ replaceVertex :: (Eq a, Graph g) => a -> a -> g a -> g a replaceVertex u v = fmap $ \w -> if w == u then v else w --- | Merge vertices satisfying a given predicate with a given vertex.+-- | Merge vertices satisfying a given predicate into a given vertex. -- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes -- /O(1)/ to be evaluated. --@@ -609,4 +635,3 @@ -- @ class ToGraph t where     toGraph :: Graph g => t a -> g a-

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.IntAdjacencyMap--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -22,7 +22,7 @@      -- * Basic graph construction primitives     empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,-    graph, fromAdjacencyList,+    fromAdjacencyList,      -- * Relations on graphs     isSubgraphOf,@@ -32,7 +32,7 @@     adjacencyList, vertexIntSet, edgeSet, postIntSet,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, tree, forest,+    path, circuit, clique, biclique, star, starTranspose, tree, forest,      -- * Graph transformation     removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,@@ -72,7 +72,6 @@ -- @ -- 'isEmpty'     (vertex x) == False -- 'hasVertex' x (vertex x) == True--- 'hasVertex' 1 (vertex 2) == False -- 'vertexCount' (vertex x) == 1 -- 'edgeCount'   (vertex x) == 0 -- @@@ -92,7 +91,7 @@ edge :: Int -> Int -> IntAdjacencyMap edge = C.edge --- | /Overlay/ two graphs. This is an idempotent, commutative and associative+-- | /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. --@@ -110,7 +109,7 @@ overlay = C.overlay  -- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over the overlay and obeys the decomposition axiom.+-- '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)/.@@ -163,6 +162,7 @@ -- overlays []        == 'empty' -- overlays [x]       == x -- overlays [x,y]     == 'overlay' x y+-- overlays           == 'foldr' 'overlay' 'empty' -- 'isEmpty' . overlays == 'all' 'isEmpty' -- @ overlays :: [IntAdjacencyMap] -> IntAdjacencyMap@@ -175,25 +175,12 @@ -- connects []        == 'empty' -- connects [x]       == x -- connects [x,y]     == 'connect' x y+-- connects           == 'foldr' 'connect' 'empty' -- 'isEmpty' . connects == 'all' 'isEmpty' -- @ connects :: [IntAdjacencyMap] -> IntAdjacencyMap connects = C.connects --- | Construct the graph from given lists of vertices /V/ and edges /E/.--- The resulting graph contains the vertices /V/ as well as all the vertices--- referred to by the edges /E/.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- graph []  []      == 'empty'--- graph [x] []      == 'vertex' x--- graph []  [(x,y)] == 'edge' x y--- graph vs  es      == 'overlay' ('vertices' vs) ('edges' es)--- @-graph :: [Int] -> [(Int, Int)] -> IntAdjacencyMap-graph vs es = overlay (vertices vs) (edges es)- -- | Construct a graph from an adjacency list. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -244,6 +231,7 @@ -- @ -- hasVertex x 'empty'            == False -- hasVertex x ('vertex' x)       == True+-- hasVertex 1 ('vertex' 2)       == False -- hasVertex x . 'removeVertex' x == const False -- @ hasVertex :: Int -> IntAdjacencyMap -> Bool@@ -351,7 +339,7 @@   where     combine u es = Set.union (Set.fromAscList [ (u, v) | v <- IntSet.toAscList es ]) --- | The /postset/ of a vertex is the set of its /direct successors/.+-- | The /postset/ (here 'postIntSet') of a vertex is the set of its /direct successors/. -- -- @ -- postIntSet x 'empty'      == IntSet.'IntSet.empty'@@ -400,7 +388,7 @@ clique :: [Int] -> IntAdjacencyMap clique = C.clique --- | The /biclique/ on a list of vertices.+-- | The /biclique/ on two lists of vertices. -- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory. -- -- @@@ -419,17 +407,32 @@         | v `IntSet.member` x = y         | otherwise        = IntSet.empty --- | The /star/ formed by a centre vertex and a list of leaves.+-- | 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 :: Int -> [Int] -> IntAdjacencyMap star = C.star +-- | The /star transpose/ formed by a list of leaves connected to a centre vertex.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- starTranspose x []    == 'vertex' x+-- starTranspose x [y]   == 'edge' y x+-- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]+-- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)+-- starTranspose x ys    == 'transpose' ('star' x ys)+-- @+starTranspose :: Int -> [Int] -> IntAdjacencyMap+starTranspose = C.starTranspose+ -- | The /tree graph/ constructed from a given 'Tree' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -459,6 +462,9 @@ -- -- @ -- 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 :: Int -> IntAdjacencyMap -> IntAdjacencyMap@@ -489,7 +495,7 @@ replaceVertex :: Int -> Int -> IntAdjacencyMap -> IntAdjacencyMap replaceVertex u v = gmap $ \w -> if w == u then v else w --- | Merge vertices satisfying a given predicate with a given vertex.+-- | 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. --@@ -510,9 +516,6 @@ -- transpose ('vertex' x)  == 'vertex' x -- transpose ('edge' x y)  == 'edge' y x -- transpose . transpose == id--- transpose . 'path'      == 'path'    . 'reverse'--- transpose . 'circuit'   == 'circuit' . 'reverse'--- transpose . 'clique'    == 'clique'  . 'reverse' -- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' -- @ transpose :: IntAdjacencyMap -> IntAdjacencyMap@@ -542,7 +545,7 @@ -- be evaluated. -- -- @--- induce (const True)  x      == x+-- induce (const True ) x      == x -- induce (const False) x      == 'empty' -- induce (/= x)               == 'removeVertex' x -- induce p . induce q         == induce (\\x -> p x && q x)

@@ -1,14 +1,14 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.IntAdjacencyMap.Internal--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : unstable -- -- This module exposes the implementation of adjacency maps. The API is unstable--- and unsafe. Where possible use non-internal module--- "Algebra.Graph.IntAdjacencyMap" instead.+-- and unsafe, and is exposed only for documentation. You should use the+-- non-internal module "Algebra.Graph.IntAdjacencyMap" instead. ----------------------------------------------------------------------------- module Algebra.Graph.IntAdjacencyMap.Internal (     -- * Adjacency map implementation@@ -20,6 +20,7 @@  import Data.IntMap.Strict (IntMap, keysSet, fromSet) import Data.IntSet (IntSet)+import Data.List  import Algebra.Graph.Class @@ -44,7 +45,7 @@ show (1 + 2     :: IntAdjacencyMap Int) == "vertices [1,2]" show (1 * 2     :: IntAdjacencyMap Int) == "edge 1 2" show (1 * 2 * 3 :: IntAdjacencyMap Int) == "edges [(1,2),(1,3),(2,3)]"-show (1 * 2 + 3 :: IntAdjacencyMap Int) == "graph [1,2,3] [(1,2)]"@+show (1 * 2 + 3 :: IntAdjacencyMap Int) == "overlay (vertex 3) (edge 1 2)"@  The 'Eq' instance satisfies all axioms of algebraic graphs: @@ -106,22 +107,22 @@  instance Show IntAdjacencyMap where     show (AM m _)-        | m == IntMap.empty = "empty"-        | es == []          = if IntSet.size vs > 1 then "vertices " ++ show (IntSet.toAscList vs)-                                                    else "vertex "   ++ show v-        | vs == referred    = if length es > 1 then "edges " ++ show es-                                               else "edge "  ++ show e ++ " " ++ show f-        | otherwise         = "graph " ++ show (IntSet.toAscList vs) ++ " " ++ show es+        | null vs    = "empty"+        | null es    = vshow vs+        | vs == used = eshow es+        | otherwise  = "overlay (" ++ vshow (vs \\ used) ++ ") (" ++ eshow es ++ ")"       where-        vs       = keysSet m-        es       = internalEdgeList m-        v        = head $ IntSet.toList vs-        (e, f)   = head es-        referred = referredToVertexSet m+        vs             = IntSet.toAscList (keysSet m)+        es             = internalEdgeList m+        vshow [x]      = "vertex "   ++ show x+        vshow xs       = "vertices " ++ show xs+        eshow [(x, y)] = "edge "     ++ show x ++ " " ++ show y+        eshow xs       = "edges "    ++ show xs+        used           = IntSet.toAscList (referredToVertexSet m)  instance Graph IntAdjacencyMap where     type Vertex IntAdjacencyMap = Int-    empty       = mkAM $ IntMap.empty+    empty       = mkAM   IntMap.empty     vertex x    = mkAM $ IntMap.singleton x IntSet.empty     overlay x y = mkAM $ IntMap.unionWith IntSet.union (adjacencyMap x) (adjacencyMap y)     connect x y = mkAM $ IntMap.unionsWith IntSet.union [ adjacencyMap x, adjacencyMap y,

@@ -0,0 +1,123 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Internal+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- __Alga__ is a library for algebraic construction and manipulation of graphs+-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the+-- motivation behind the library, the underlying theory, and implementation details.+--+-- This module defines various internal utilities and data structures used+-- throughout the library, such as lists with fast concatenation. The API+-- is unstable and unsafe, and is exposed only for documentation.+-----------------------------------------------------------------------------+module Algebra.Graph.Internal (+    -- * General data structures+    List (..),++    -- * Data structures for graph traversal+    Focus, focus, Context (..), context+  ) where++import Prelude ()+import Prelude.Compat++import Data.Foldable+import Data.Semigroup++import Algebra.Graph.Class (ToGraph(..))++import qualified GHC.Exts as Exts++-- | An abstract list data type with /O(1)/ time concatenation (the current+-- implementation uses difference lists). Here @a@ is the type of list elements.+-- 'List' @a@ is a 'Monoid': 'mempty' corresponds to the empty list and two lists+-- can be concatenated with 'mappend' (or operator 'Data.Monoid.<>'). Singleton+-- lists can be constructed using the function 'pure' from the 'Applicative'+-- instance. 'List' @a@ is also an instance of 'IsList', therefore you can use+-- list literals, e.g. @[1,4]@ @::@ 'List' @Int@ is the same as 'pure' @1@+-- 'Data.Monoid.<>' 'pure' @4@; note that this requires the @OverloadedLists@+-- GHC extension. To extract plain Haskell lists you can use the 'toList'+-- function from the 'Foldable' instance.+newtype List a = List (Endo [a]) deriving (Monoid, Semigroup)++instance Show a => Show (List a) where+    show = show . toList++instance Eq a => Eq (List a) where+    x == y = toList x == toList y++instance Ord a => Ord (List a) where+    compare x y = compare (toList x) (toList y)++-- TODO: Add rewrite rules? fromList . toList == toList . fromList == id+instance Exts.IsList (List a) where+    type Item (List a) = a+    fromList        = List . Endo . (<>)+    toList (List x) = appEndo x []++instance Foldable List where+    foldMap f = foldMap f . Exts.toList+#if MIN_VERSION_base(4,8,0)+    toList    = Exts.toList+#endif++instance Functor List where+    fmap f = Exts.fromList . map f . toList++instance Applicative List where+    pure    = List . Endo . (:)+    f <*> x = Exts.fromList (toList f <*> toList x)++instance Monad List where+    return  = pure+    x >>= f = Exts.fromList (toList x >>= toList . f)++-- | Focus on the empty graph.+emptyFocus :: Focus a+emptyFocus = Focus False mempty mempty mempty++-- | Focus on the graph with a single vertex, given a predicate indicating+-- whether the vertex is of interest.+vertexFocus :: (a -> Bool) -> a -> Focus a+vertexFocus f x = Focus (f x) mempty mempty (pure x)++-- | Overlay two foci.+overlayFoci :: Focus a -> Focus a -> Focus a+overlayFoci x y = Focus (ok x || ok y) (is x <> is y) (os x <> os y) (vs x <> vs y)++-- | Connect two foci.+connectFoci :: Focus a -> Focus a -> Focus a+connectFoci x y = Focus (ok x || ok y) (xs <> is y) (os x <> ys) (vs x <> vs y)+  where+    xs = if ok y then vs x else is x+    ys = if ok x then vs y else os y++-- | The context of a subgraph comprises the input and output vertices outside+-- the subgraph that are connected to the vertices inside the subgraph.+data Context a = Context { inputs :: [a], outputs :: [a] }++-- | Extract the context from a graph 'Focus'. Returns @Nothing@ if the focus+-- could not be obtained.+context :: ToGraph g => (ToVertex g -> Bool) -> g -> Maybe (Context (ToVertex g))+context p g | ok f      = Just $ Context (toList $ is f) (toList $ os f)+            | otherwise = Nothing+  where+    f = focus p g++-- | The /focus/ of a graph expression is a flattened represenentation of the+-- subgraph under focus, its context, as well as the list of all encountered+-- vertices. See 'Algebra.Graph.removeEdge' for a use-case example.+data Focus a = Focus+    { ok :: Bool     -- ^ True if focus on the specified subgraph is obtained.+    , is :: List a   -- ^ Inputs into the focused subgraph.+    , os :: List a   -- ^ Outputs out of the focused subgraph.+    , vs :: List a } -- ^ All vertices (leaves) of the graph expression.++-- | 'Focus' on a specified subgraph.+focus :: ToGraph g => (ToVertex g -> Bool) -> g -> Focus (ToVertex g)+focus f = foldg emptyFocus (vertexFocus f) overlayFoci connectFoci

@@ -0,0 +1,755 @@+{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.NonEmpty+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- __Alga__ is a library for algebraic construction and manipulation of graphs+-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the+-- motivation behind the library, the underlying theory, and implementation details.+--+-- This module defines the data type 'NonEmptyGraph' for graphs that are known+-- to be non-empty at compile time. The naming convention generally follows that+-- of "Data.List.NonEmpty": we use suffix @1@ to indicate the functions whose+-- interface must be changed compared to "Algebra.Graph", e.g. 'vertices1'.+--+-----------------------------------------------------------------------------+module Algebra.Graph.NonEmpty (+    -- * Algebraic data type for non-empty graphs+    NonEmptyGraph (..), toNonEmptyGraph,++    -- * Basic graph construction primitives+    vertex, edge, overlay, overlay1, connect, vertices1, edges1, overlays1,+    connects1,++    -- * Graph folding+    foldg1,++    -- * Relations on graphs+    isSubgraphOf, (===),++    -- * Graph properties+    size, hasVertex, hasEdge, vertexCount, edgeCount, vertexList1, edgeList,+    vertexSet, vertexIntSet, edgeSet,++    -- * Standard families of graphs+    path1, circuit1, clique1, biclique1, star, starTranspose, tree, mesh1, torus1,++    -- * Graph transformation+    removeVertex1, removeEdge, replaceVertex, mergeVertices, splitVertex1,+    transpose, induce1, simplify,++    -- * Graph composition+    box+  ) where++import Prelude ()+import Prelude.Compat++#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++import Control.DeepSeq (NFData (..))+import Control.Monad.Compat+import Data.List.NonEmpty (NonEmpty (..))++import Algebra.Graph.Internal++import qualified Algebra.Graph                    as G+import qualified Algebra.Graph.AdjacencyMap       as AM+import qualified Algebra.Graph.Class              as C+import qualified Algebra.Graph.HigherKinded.Class as H+import qualified Algebra.Graph.IntAdjacencyMap    as IAM+import qualified Algebra.Graph.Relation           as R+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++{-| The 'NonEmptyGraph' data type is a deep embedding of the core graph+construction primitives 'vertex', 'overlay' and 'connect'. As one can guess from+the name, the empty graph cannot be represented using this data type. See module+"Algebra.Graph" for a graph data type that allows for the construction of the+empty graph.++We define a 'Num' instance as a convenient notation for working with graphs:++    > 0           == Vertex 0+    > 1 + 2       == Overlay (Vertex 1) (Vertex 2)+    > 1 * 2       == Connect (Vertex 1) (Vertex 2)+    > 1 + 2 * 3   == Overlay (Vertex 1) (Connect (Vertex 2) (Vertex 3))+    > 1 * (2 + 3) == Connect (Vertex 1) (Overlay (Vertex 2) (Vertex 3))++Note that the 'signum' method of the 'Num' type class cannot be implemented.++The 'Eq' instance is currently implemented using the 'AM.AdjacencyMap' as the+/canonical graph representation/ and satisfies the following laws of algebraic+graphs:++    * 'overlay' is commutative, associative and idempotent:++        >       x + y == y + x+        > x + (y + z) == (x + y) + z+        >       x + x == x++    * 'connect' is associative:++        > x * (y * z) == (x * y) * z++    * 'connect' distributes over 'overlay':++        > x * (y + z) == x * y + x * z+        > (x + y) * z == x * z + y * z++    * 'connect' can be decomposed:++        > x * y * z == x * y + x * z + y * z++    * 'connect' satisfies absorption and saturation:++        > x * y + x + y == x * y+        >     x * x * x == x * x++When specifying the time and memory complexity of graph algorithms, /n/ will+denote the number of vertices in the graph, /m/ will denote the number of+edges in the graph, and /s/ will denote the /size/ of the corresponding+'NonEmptyGraph' expression, defined as the number of vertex leaves. For example,+if @g@ is a 'NonEmptyGraph' then /n/, /m/ and /s/ can be computed as follows:++@n == 'vertexCount' g+m == 'edgeCount' g+s == 'size' g@++The 'size' of any graph is positive and coincides with the result of 'length'+method of the 'Foldable' type class. We define 'size' only for the consistency+with the API of other graph representations, such as "Algebra.Graph".++Converting a 'NonEmptyGraph' to the corresponding 'AM.AdjacencyMap' takes+/O(s + m * log(m))/ time and /O(s + m)/ memory. This is also the complexity of+the graph equality test, because it is currently implemented by converting graph+expressions to canonical representations based on adjacency maps.+-}+data NonEmptyGraph a = Vertex a+                     | Overlay (NonEmptyGraph a) (NonEmptyGraph a)+                     | Connect (NonEmptyGraph a) (NonEmptyGraph a)+                     deriving (Foldable, Functor, Show, Traversable)++instance NFData a => NFData (NonEmptyGraph a) where+    rnf (Vertex  x  ) = rnf x+    rnf (Overlay x y) = rnf x `seq` rnf y+    rnf (Connect x y) = rnf x `seq` rnf y++instance C.ToGraph (NonEmptyGraph a) where+    type ToVertex (NonEmptyGraph a) = a+    foldg _ = foldg1++instance H.ToGraph NonEmptyGraph where+    toGraph = foldg1 H.vertex H.overlay H.connect++instance Num a => Num (NonEmptyGraph a) where+    fromInteger = Vertex . fromInteger+    (+)         = Overlay+    (*)         = Connect+    signum      = error "NonEmptyGraph.signum cannot be implemented."+    abs         = id+    negate      = id++instance Ord a => Eq (NonEmptyGraph a) where+    x == y = C.toGraph x == (C.toGraph y :: AM.AdjacencyMap a)++instance Applicative NonEmptyGraph where+    pure  = Vertex+    (<*>) = ap++instance Monad NonEmptyGraph where+    return  = pure+    g >>= f = foldg1 f Overlay Connect g++-- | Convert a 'G.Graph' into 'NonEmptyGraph'. Returns 'Nothing' if the argument+-- is 'G.empty'.+-- Complexity: /O(s)/ time, memory and size.+--+-- @+-- toNonEmptyGraph 'G.empty'       == Nothing+-- toNonEmptyGraph ('C.toGraph' x) == Just (x :: NonEmptyGraph a)+-- @+toNonEmptyGraph :: G.Graph a -> Maybe (NonEmptyGraph a)+toNonEmptyGraph = G.foldg Nothing (Just . Vertex) (go Overlay) (go Connect)+  where+    go _ Nothing  y        = y+    go _ x        Nothing  = x+    go f (Just x) (Just y) = Just (f x y)++-- | Construct the graph comprising /a single isolated vertex/. An alias for the+-- constructor 'Vertex'.+-- Complexity: /O(1)/ time, memory and size.+--+-- @+-- 'hasVertex' x (vertex x) == True+-- 'vertexCount' (vertex x) == 1+-- 'edgeCount'   (vertex x) == 0+-- 'size'        (vertex x) == 1+-- @+vertex :: a -> NonEmptyGraph a+vertex = Vertex++-- | Construct the graph comprising /a single edge/.+-- Complexity: /O(1)/ time, memory and size.+--+-- @+-- edge x y               == 'connect' ('vertex' x) ('vertex' y)+-- 'hasEdge' x y (edge x y) == True+-- 'edgeCount'   (edge x y) == 1+-- 'vertexCount' (edge 1 1) == 1+-- 'vertexCount' (edge 1 2) == 2+-- @+edge :: a -> a -> NonEmptyGraph a+edge u v = connect (vertex u) (vertex v)++-- | /Overlay/ two graphs. An alias for the constructor 'Overlay'. This is a+-- commutative, associative and idempotent operation.+-- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size.+--+-- @+-- 'hasVertex' z (overlay x y) == 'hasVertex' z x || 'hasVertex' z y+-- 'vertexCount' (overlay x y) >= 'vertexCount' x+-- 'vertexCount' (overlay x y) <= 'vertexCount' x + 'vertexCount' y+-- 'edgeCount'   (overlay x y) >= 'edgeCount' x+-- 'edgeCount'   (overlay x y) <= 'edgeCount' x   + 'edgeCount' y+-- 'size'        (overlay x y) == 'size' x        + 'size' y+-- 'vertexCount' (overlay 1 2) == 2+-- 'edgeCount'   (overlay 1 2) == 0+-- @+overlay :: NonEmptyGraph a -> NonEmptyGraph a -> NonEmptyGraph a+overlay = Overlay++-- | Overlay a possibly empty graph with a non-empty graph. If the first+-- argument is 'G.empty', the function returns the second argument; otherwise+-- it is semantically the same as 'overlay'.+-- Complexity: /O(s1)/ time and memory, and /O(s1 + s2)/ size.+--+-- @+--                overlay1 'G.empty' x == x+-- x /= 'G.empty' ==> overlay1 x     y == overlay (fromJust $ toNonEmptyGraph x) y+-- @+overlay1 :: G.Graph a -> NonEmptyGraph a -> NonEmptyGraph a+overlay1 = maybe id overlay . toNonEmptyGraph++-- | /Connect/ two graphs. An alias for the constructor 'Connect'. This is an+-- associative operation, which distributes over 'overlay' and obeys the+-- decomposition axiom.+-- Complexity: /O(1)/ time and memory, /O(s1 + s2)/ size. 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)/.+--+-- @+-- 'hasVertex' z (connect x y) == 'hasVertex' z x || 'hasVertex' z y+-- 'vertexCount' (connect x y) >= 'vertexCount' x+-- 'vertexCount' (connect x y) <= 'vertexCount' x + 'vertexCount' y+-- 'edgeCount'   (connect x y) >= 'edgeCount' x+-- 'edgeCount'   (connect x y) >= 'edgeCount' y+-- 'edgeCount'   (connect x y) >= 'vertexCount' x * 'vertexCount' y+-- 'edgeCount'   (connect x y) <= 'vertexCount' x * 'vertexCount' y + 'edgeCount' x + 'edgeCount' y+-- 'size'        (connect x y) == 'size' x        + 'size' y+-- 'vertexCount' (connect 1 2) == 2+-- 'edgeCount'   (connect 1 2) == 1+-- @+connect :: NonEmptyGraph a -> NonEmptyGraph a -> NonEmptyGraph a+connect = Connect++-- | Construct the graph comprising a given list of isolated vertices.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- vertices1 (x ':|' [])     == 'vertex' x+-- 'hasVertex' x . vertices1 == 'elem' x+-- 'vertexCount' . vertices1 == 'length' . 'Data.List.NonEmpty.nub'+-- 'vertexSet'   . vertices1 == Set.'Set.fromList' . 'Data.List.NonEmpty.toList'+-- @+vertices1 :: NonEmpty a -> NonEmptyGraph a+vertices1 = overlays1 . fmap vertex++-- | Construct the graph from a list of edges.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- edges1 ((x,y) ':|' []) == 'edge' x y+-- 'edgeCount' . edges1   == 'Data.List.NonEmpty.length' . 'Data.List.NonEmpty.nub'+-- @+edges1 :: NonEmpty (a, a) -> NonEmptyGraph a+edges1 = overlays1 . fmap (uncurry edge)++-- | Overlay a given list of graphs.+-- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length+-- of the given list, and /S/ is the sum of sizes of the graphs in the list.+--+-- @+-- overlays1 (x ':|' [] ) == x+-- overlays1 (x ':|' [y]) == 'overlay' x y+-- @+overlays1 :: NonEmpty (NonEmptyGraph a) -> NonEmptyGraph a+overlays1 (x :| xs) = case xs of []     -> x+                                 (y:ys) -> overlay x (overlays1 $ y :| ys)++-- | Connect a given list of graphs.+-- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length+-- of the given list, and /S/ is the sum of sizes of the graphs in the list.+--+-- @+-- connects1 (x ':|' [] ) == x+-- connects1 (x ':|' [y]) == 'connect' x y+-- @+connects1 :: NonEmpty (NonEmptyGraph a) -> NonEmptyGraph a+connects1 (x :| xs) = case xs of []     -> x+                                 (y:ys) -> connect x (connects1 $ y :| ys)++-- | Generalised graph folding: recursively collapse a 'NonEmptyGraph' by+-- applying the provided functions to the leaves and internal nodes of the+-- expression. The order of arguments is: vertex, overlay and connect.+-- Complexity: /O(s)/ applications of given functions. As an example, the+-- complexity of 'size' is /O(s)/, since all functions have cost /O(1)/.+--+-- @+-- foldg1 (const 1) (+)  (+)  == 'size'+-- foldg1 (==x)     (||) (||) == 'hasVertex' x+-- @+foldg1 :: (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> NonEmptyGraph a -> b+foldg1 v o c = go+  where+    go (Vertex  x  ) = v x+    go (Overlay x y) = o (go x) (go y)+    go (Connect x y) = c (go x) (go y)++-- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the+-- first graph is a /subgraph/ of the second.+-- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a+-- graph can be quadratic with respect to the expression size /s/.+--+-- @+-- isSubgraphOf x             ('overlay' x y) == True+-- isSubgraphOf ('overlay' x y) ('connect' x y) == True+-- isSubgraphOf ('path1' xs)    ('circuit1' xs) == True+-- @+isSubgraphOf :: Ord a => NonEmptyGraph a -> NonEmptyGraph a -> Bool+isSubgraphOf x y = overlay x y == y++-- | Structural equality on graph expressions.+-- Complexity: /O(s)/ time.+--+-- @+--     x === x     == True+-- x + y === x + y == True+-- 1 + 2 === 2 + 1 == False+-- x + y === x * y == False+-- @+(===) :: Eq a => NonEmptyGraph a -> NonEmptyGraph a -> Bool+(Vertex  x1   ) === (Vertex  x2   ) = x1 ==  x2+(Overlay x1 y1) === (Overlay x2 y2) = x1 === x2 && y1 === y2+(Connect x1 y1) === (Connect x2 y2) = x1 === x2 && y1 === y2+_               === _               = False++infix 4 ===++-- | The /size/ of a graph, i.e. the number of leaves of the expression.+-- Complexity: /O(s)/ time.+--+-- @+-- size ('vertex' x)    == 1+-- size ('overlay' x y) == size x + size y+-- size ('connect' x y) == size x + size y+-- size x             >= 1+-- size x             >= 'vertexCount' x+-- @+size :: NonEmptyGraph a -> Int+size = foldg1 (const 1) (+) (+)++-- | Check if a graph contains a given vertex. A convenient alias for `elem`.+-- Complexity: /O(s)/ time.+--+-- @+-- hasVertex x ('vertex' x) == True+-- hasVertex 1 ('vertex' 2) == False+-- @+hasVertex :: Eq a => a -> NonEmptyGraph a -> Bool+hasVertex v = foldg1 (==v) (||) (||)++-- | Check if a graph contains a given edge.+-- Complexity: /O(s)/ time.+--+-- @+-- hasEdge x y ('vertex' z)       == False+-- hasEdge x y ('edge' x y)       == True+-- hasEdge x y . 'removeEdge' x y == const False+-- hasEdge x y                  == 'elem' (x,y) . 'edgeList'+-- @+hasEdge :: Ord a => a -> a -> NonEmptyGraph a -> Bool+hasEdge u v = G.hasEdge u v . H.toGraph++-- | The number of vertices in a graph.+-- Complexity: /O(s * log(n))/ time.+--+-- @+-- vertexCount ('vertex' x) == 1+-- vertexCount x          >= 1+-- vertexCount            == 'length' . 'vertexList1'+-- @+vertexCount :: Ord a => NonEmptyGraph a -> Int+vertexCount = length . vertexList1++-- | The number of edges in a graph.+-- Complexity: /O(s + m * log(m))/ time. Note that the number of edges /m/ of a+-- graph can be quadratic with respect to the expression size /s/.+--+-- @+-- edgeCount ('vertex' x) == 0+-- edgeCount ('edge' x y) == 1+-- edgeCount            == 'length' . 'edgeList'+-- @+edgeCount :: Ord a => NonEmptyGraph a -> Int+edgeCount = AM.edgeCount . C.toGraph++-- | The sorted list of vertices of a given graph.+-- Complexity: /O(s * log(n))/ time and /O(n)/ memory.+--+-- @+-- vertexList1 ('vertex' x)  == x ':|' []+-- vertexList1 . 'vertices1' == 'Data.List.NonEmpty.nub' . 'Data.List.NonEmpty.sort'+-- @+vertexList1 :: Ord a => NonEmptyGraph a -> NonEmpty a+vertexList1 = NonEmpty.fromList . G.vertexList . H.toGraph++-- | The sorted list of edges of a graph.+-- Complexity: /O(s + m * log(m))/ time and /O(m)/ memory. Note that the number of+-- edges /m/ of a graph can be quadratic with respect to the expression size /s/.+--+-- @+-- edgeList ('vertex' x)     == []+-- edgeList ('edge' x y)     == [(x,y)]+-- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)]+-- edgeList . 'edges1'       == 'Data.List.nub' . 'Data.List.sort' . 'Data.List.NonEmpty.toList'+-- edgeList . 'transpose'    == 'Data.List.sort' . map 'Data.Tuple.swap' . edgeList+-- @+edgeList :: Ord a => NonEmptyGraph a -> [(a, a)]+edgeList = AM.edgeList . C.toGraph++-- | The set of vertices of a given graph.+-- Complexity: /O(s * log(n))/ time and /O(n)/ memory.+--+-- @+-- vertexSet . 'vertex'    == Set.'Set.singleton'+-- vertexSet . 'vertices1' == Set.'Set.fromList' . 'Data.List.NonEmpty.toList'+-- vertexSet . 'clique1'   == Set.'Set.fromList' . 'Data.List.NonEmpty.toList'+-- @+vertexSet :: Ord a => NonEmptyGraph a -> Set.Set a+vertexSet = AM.vertexSet . C.toGraph++-- | The set of vertices of a given graph. Like 'vertexSet' but specialised for+-- graphs with vertices of type 'Int'.+-- Complexity: /O(s * log(n))/ time and /O(n)/ memory.+--+-- @+-- vertexIntSet . 'vertex'    == IntSet.'IntSet.singleton'+-- vertexIntSet . 'vertices1' == IntSet.'IntSet.fromList' . 'Data.List.NonEmpty.toList'+-- vertexIntSet . 'clique1'   == IntSet.'IntSet.fromList' . 'Data.List.NonEmpty.toList'+-- @+vertexIntSet :: NonEmptyGraph Int -> IntSet.IntSet+vertexIntSet = IAM.vertexIntSet . C.toGraph++-- | The set of edges of a given graph.+-- Complexity: /O(s * log(m))/ time and /O(m)/ memory.+--+-- @+-- edgeSet ('vertex' x) == Set.'Set.empty'+-- edgeSet ('edge' x y) == Set.'Set.singleton' (x,y)+-- edgeSet . 'edges1'   == Set.'Set.fromList' . 'Data.List.NonEmpty.toList'+-- @+edgeSet :: Ord a => NonEmptyGraph a -> Set.Set (a, a)+edgeSet = R.edgeSet . C.toGraph++-- | The /path/ on a list of vertices.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- path1 (x ':|' [] ) == 'vertex' x+-- path1 (x ':|' [y]) == 'edge' x y+-- path1 . 'Data.List.NonEmpty.reverse'  == 'transpose' . path1+-- @+path1 :: NonEmpty a -> NonEmptyGraph a+path1 (x :| []    ) = vertex x+path1 (x :| (y:ys)) = edges1 ((x, y) :| zip (y:ys) ys)++-- | The /circuit/ on a list of vertices.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- circuit1 (x ':|' [] ) == 'edge' x x+-- circuit1 (x ':|' [y]) == 'edges1' ((x,y) ':|' [(y,x)])+-- circuit1 . 'Data.List.NonEmpty.reverse'  == 'transpose' . circuit1+-- @+circuit1 :: NonEmpty a -> NonEmptyGraph a+circuit1 (x :| xs) = path1 (x :| xs ++ [x])++-- | The /clique/ on a list of vertices.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- clique1 (x ':|' []   ) == 'vertex' x+-- clique1 (x ':|' [y]  ) == 'edge' x y+-- clique1 (x ':|' [y,z]) == 'edges1' ((x,y) ':|' [(x,z), (y,z)])+-- clique1 (xs '<>' ys)   == 'connect' (clique1 xs) (clique1 ys)+-- clique1 . 'Data.List.NonEmpty.reverse'    == 'transpose' . clique1+-- @+clique1 :: NonEmpty a -> NonEmptyGraph a+clique1 = connects1 . fmap vertex++-- | The /biclique/ on two lists of vertices.+-- Complexity: /O(L1 + L2)/ time, memory and size, where /L1/ and /L2/ are the+-- lengths of the given lists.+--+-- @+-- biclique1 (x1 ':|' [x2]) (y1 ':|' [y2]) == 'edges1' ((x1,y1) ':|' [(x1,y2), (x2,y1), (x2,y2)])+-- biclique1 xs            ys          == 'connect' ('vertices1' xs) ('vertices1' ys)+-- @+biclique1 :: NonEmpty a -> NonEmpty a -> NonEmptyGraph a+biclique1 xs ys = connect (vertices1 xs) (vertices1 ys)++-- | The /star/ formed by a centre vertex connected to a list of leaves.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- star x []    == 'vertex' x+-- star x [y]   == 'edge' x y+-- star x [y,z] == 'edges1' ((x,y) ':|' [(x,z)])+-- @+star :: a -> [a] -> NonEmptyGraph a+star x []     = vertex x+star x (y:ys) = connect (vertex x) (vertices1 $ y :| ys)++-- | The /star transpose/ formed by a list of leaves connected to a centre vertex.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- starTranspose x []    == 'vertex' x+-- starTranspose x [y]   == 'edge' y x+-- starTranspose x [y,z] == 'edges1' ((y,x) ':|' [(z,x)])+-- starTranspose x ys    == 'transpose' ('star' x ys)+-- @+starTranspose :: a -> [a] -> NonEmptyGraph a+starTranspose x []     = vertex x+starTranspose x (y:ys) = connect (vertices1 $ y :| ys) (vertex x)++-- | The /tree graph/ constructed from a given 'Tree.Tree' data structure.+-- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the+-- given tree (i.e. the number of vertices in the tree).+--+-- @+-- tree (Node x [])                                         == 'vertex' x+-- tree (Node x [Node y [Node z []]])                       == 'path1' (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 []]]) == 'edges1' ((1,2) ':|' [(1,3), (3,4), (3,5)])+-- @+tree :: Tree.Tree a -> NonEmptyGraph a+tree (Tree.Node x f) = overlays1 $ star x (map Tree.rootLabel f) :| map tree f++-- | Construct a /mesh graph/ from two lists of vertices.+-- Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the+-- lengths of the given lists.+--+-- @+-- mesh1 (x ':|' [])    (y ':|' [])    == 'vertex' (x, y)+-- mesh1 xs           ys           == 'box' ('path1' xs) ('path1' ys)+-- mesh1 (1 ':|' [2,3]) (\'a\' ':|' "b") == 'edges1' ('Data.List.NonEmpty.fromList' [ ((1,\'a\'),(1,\'b\')), ((1,\'a\'),(2,\'a\'))+--                                                     , ((1,\'b\'),(2,\'b\')), ((2,\'a\'),(2,\'b\'))+--                                                     , ((2,\'a\'),(3,\'a\')), ((2,\'b\'),(3,\'b\'))+--                                                     , ((3,\'a\'),(3,\'b\')) ])+-- @+mesh1 :: NonEmpty a -> NonEmpty b -> NonEmptyGraph (a, b)+mesh1 xs ys = path1 xs `box` path1 ys++-- | Construct a /torus graph/ from two lists of vertices.+-- Complexity: /O(L1 * L2)/ time, memory and size, where /L1/ and /L2/ are the+-- lengths of the given lists.+--+-- @+-- torus1 (x ':|' [])  (y ':|' [])    == 'edge' (x, y) (x, y)+-- torus1 xs         ys           == 'box' ('circuit1' xs) ('circuit1' ys)+-- torus1 (1 ':|' [2]) (\'a\' ':|' "b") == 'edges1' ('Data.List.NonEmpty.fromList' [ ((1,\'a\'),(1,\'b\')), ((1,\'a\'),(2,\'a\'))+--                                                    , ((1,\'b\'),(1,\'a\')), ((1,\'b\'),(2,\'b\'))+--                                                    , ((2,\'a\'),(1,\'a\')), ((2,\'a\'),(2,\'b\'))+--                                                    , ((2,\'b\'),(1,\'b\')), ((2,\'b\'),(2,\'a\')) ])+-- @+torus1 :: NonEmpty a -> NonEmpty b -> NonEmptyGraph (a, b)+torus1 xs ys = circuit1 xs `box` circuit1 ys++-- | Remove a vertex from a given graph. Returns @Nothing@ if the resulting+-- graph is empty.+-- Complexity: /O(s)/ time, memory and size.+--+-- @+-- removeVertex1 x ('vertex' x)          == Nothing+-- removeVertex1 1 ('vertex' 2)          == Just ('vertex' 2)+-- removeVertex1 x ('edge' x x)          == Nothing+-- removeVertex1 1 ('edge' 1 2)          == Just ('vertex' 2)+-- removeVertex1 x '>=>' removeVertex1 x == removeVertex1 x+-- @+removeVertex1 :: Eq a => a -> NonEmptyGraph a -> Maybe (NonEmptyGraph a)+removeVertex1 x = induce1 (/= x)++-- | Remove an edge from a given graph.+-- Complexity: /O(s)/ time, memory and size.+--+-- @+-- removeEdge x y ('edge' x y)       == 'vertices1' (x ':|' [y])+-- removeEdge x y . removeEdge x y == removeEdge x y+-- removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2+-- removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2+-- 'size' (removeEdge x y z)         <= 3 * 'size' z+-- @+removeEdge :: Eq a => a -> a -> NonEmptyGraph a -> NonEmptyGraph a+removeEdge s t = filterContext s (/=s) (/=t)++-- TODO: Export+-- TODO: Here if @context (==s) g == Just ctx@ then we know for sure that+-- @induce1 (/=s) g == Just subgraph@. Can we exploit this?+filterContext :: Eq a => a -> (a -> Bool) -> (a -> Bool) -> NonEmptyGraph a -> NonEmptyGraph a+filterContext s i o g = maybe g go $ context (==s) g+  where+    go (Context is os) = G.induce (/=s) (C.toGraph g)  `overlay1`+                         starTranspose s (filter i is) `overlay` star s (filter o os)++-- | The function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a+-- given 'NonEmptyGraph'. If @y@ already exists, @x@ and @y@ will be merged.+-- Complexity: /O(s)/ time, memory and size.+--+-- @+-- replaceVertex x x            == id+-- replaceVertex x y ('vertex' x) == 'vertex' y+-- replaceVertex x y            == 'mergeVertices' (== x) y+-- @+replaceVertex :: Eq a => a -> a -> NonEmptyGraph a -> NonEmptyGraph a+replaceVertex u v = fmap $ \w -> if w == u then v else w++-- | Merge vertices satisfying a given predicate into a given vertex.+-- Complexity: /O(s)/ time, memory and size, 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 :: (a -> Bool) -> a -> NonEmptyGraph a -> NonEmptyGraph a+mergeVertices p v = fmap $ \w -> if p w then v else w++-- | Split a vertex into a list of vertices with the same connectivity.+-- Complexity: /O(s + k * L)/ time, memory and size, where /k/ is the number of+-- occurrences of the vertex in the expression and /L/ is the length of the+-- given list.+--+-- @+-- splitVertex1 x (x ':|' [] )               == id+-- splitVertex1 x (y ':|' [] )               == 'replaceVertex' x y+-- splitVertex1 1 (0 ':|' [1]) $ 1 * (2 + 3) == (0 + 1) * (2 + 3)+-- @+splitVertex1 :: Eq a => a -> NonEmpty a -> NonEmptyGraph a -> NonEmptyGraph a+splitVertex1 v us g = g >>= \w -> if w == v then vertices1 us else vertex w++-- | Transpose a given graph.+-- Complexity: /O(s)/ time, memory and size.+--+-- @+-- transpose ('vertex' x)  == 'vertex' x+-- transpose ('edge' x y)  == 'edge' y x+-- transpose . transpose == id+-- transpose ('box' x y)   == 'box' (transpose x) (transpose y)+-- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList'+-- @+transpose :: NonEmptyGraph a -> NonEmptyGraph a+transpose = foldg1 vertex overlay (flip connect)++-- | Construct the /induced subgraph/ of a given graph by removing the+-- vertices that do not satisfy a given predicate. Returns @Nothing@ if the+-- resulting graph is empty.+-- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes+-- /O(1)/ to be evaluated.+--+-- @+-- induce1 (const True ) x == Just x+-- induce1 (const False) x == Nothing+-- induce1 (/= x)          == 'removeVertex1' x+-- induce1 p '>=>' induce1 q == induce1 (\\x -> p x && q x)+-- @+induce1 :: (a -> Bool) -> NonEmptyGraph a -> Maybe (NonEmptyGraph a)+induce1 p = toNonEmptyGraph . G.induce p . C.toGraph++-- | Simplify a graph expression. Semantically, this is the identity function,+-- but it simplifies a given expression according to the laws of the algebra.+-- The function does not compute the simplest possible expression,+-- but uses heuristics to obtain useful simplifications in reasonable time.+-- Complexity: the function performs /O(s)/ graph comparisons. It is guaranteed+-- that the size of the result does not exceed the size of the given expression.+--+-- @+-- simplify              == id+-- 'size' (simplify x)     <= 'size' x+-- simplify 1           '===' 1+-- simplify (1 + 1)     '===' 1+-- simplify (1 + 2 + 1) '===' 1 + 2+-- simplify (1 * 1 * 1) '===' 1 * 1+-- @+simplify :: Ord a => NonEmptyGraph a -> NonEmptyGraph a+simplify = foldg1 Vertex (simple Overlay) (simple Connect)++simple :: Eq g => (g -> g -> g) -> g -> g -> g+simple op x y+    | x == z    = x+    | y == z    = y+    | otherwise = z+  where+    z = op x y++-- | Compute the /Cartesian product/ of graphs.+-- Complexity: /O(s1 * s2)/ time, memory and size, where /s1/ and /s2/ are the+-- sizes of the given graphs.+--+-- @+-- box ('path1' $ 'Data.List.NonEmpty.fromList' [0,1]) ('path1' $ 'Data.List.NonEmpty.fromList' "ab") == 'edges1' ('Data.List.NonEmpty.fromList' [ ((0,\'a\'), (0,\'b\'))+--                                                                          , ((0,\'a\'), (1,\'a\'))+--                                                                          , ((0,\'b\'), (1,\'b\'))+--                                                                          , ((1,\'a\'), (1,\'b\')) ])+-- @+-- Up to an isomorphism between the resulting vertex types, this operation+-- is /commutative/, /associative/, /distributes/ over 'overlay', and has+-- singleton graphs as /identities/. Below @~~@ stands for the equality up to an+-- isomorphism, e.g. @(x, ()) ~~ x@.+--+-- @+-- box x y               ~~ box y x+-- box x (box y z)       ~~ box (box x y) z+-- box x ('overlay' y z)   == 'overlay' (box x y) (box x z)+-- box x ('vertex' ())     ~~ x+-- 'transpose'   (box x y) == box ('transpose' x) ('transpose' y)+-- 'vertexCount' (box x y) == 'vertexCount' x * 'vertexCount' y+-- 'edgeCount'   (box x y) <= 'vertexCount' x * 'edgeCount' y + 'edgeCount' x * 'vertexCount' y+-- @+box :: NonEmptyGraph a -> NonEmptyGraph b -> NonEmptyGraph (a, b)+box x y = overlays1 xs `overlay` overlays1 ys+  where+    xs = fmap (\b -> fmap (,b) x) $ toNonEmpty y+    ys = fmap (\a -> fmap (a,) y) $ toNonEmpty x++-- Shall we export this? I suggest to wait for Foldable1 type class instead.+toNonEmpty :: NonEmptyGraph a -> NonEmpty a+toNonEmpty = foldg1 (:| []) (<>) (<>)

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -20,7 +20,7 @@      -- * Basic graph construction primitives     empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,-    graph, fromAdjacencyList,+    fromAdjacencyList,      -- * Relations on graphs     isSubgraphOf,@@ -30,7 +30,7 @@     vertexSet, vertexIntSet, edgeSet, preSet, postSet,      -- * Standard families of graphs-    path, circuit, clique, biclique, star, tree, forest,+    path, circuit, clique, biclique, star, starTranspose, tree, forest,      -- * Graph transformation     removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, induce,@@ -39,6 +39,9 @@     compose, reflexiveClosure, symmetricClosure, transitiveClosure, preorderClosure   ) where +import Prelude ()+import Prelude.Compat+ import Data.Tuple  import Algebra.Graph.Relation.Internal@@ -66,7 +69,6 @@ -- @ -- 'isEmpty'     (vertex x) == False -- 'hasVertex' x (vertex x) == True--- 'hasVertex' 1 (vertex 2) == False -- 'vertexCount' (vertex x) == 1 -- 'edgeCount'   (vertex x) == 0 -- @@@ -86,7 +88,7 @@ edge :: Ord a => a -> a -> Relation a edge = C.edge --- | /Overlay/ two graphs. This is an idempotent, commutative and associative+-- | /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. --@@ -104,7 +106,7 @@ overlay = C.overlay  -- | /Connect/ two graphs. This is an associative operation with the identity--- 'empty', which distributes over the overlay and obeys the decomposition axiom.+-- '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)/.@@ -156,6 +158,7 @@ -- 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@@ -168,25 +171,12 @@ -- connects []        == 'empty' -- connects [x]       == x -- connects [x,y]     == 'connect' x y+-- connects           == 'foldr' 'connect' 'empty' -- 'isEmpty' . connects == 'all' 'isEmpty' -- @ connects :: Ord a => [Relation a] -> Relation a connects = C.connects --- | Construct the graph from given lists of vertices /V/ and edges /E/.--- The resulting graph contains the vertices /V/ as well as all the vertices--- referred to by the edges /E/.--- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory.------ @--- graph []  []      == 'empty'--- graph [x] []      == 'vertex' x--- graph []  [(x,y)] == 'edge' x y--- graph vs  es      == 'overlay' ('vertices' vs) ('edges' es)--- @-graph :: Ord a => [a] -> [(a, a)] -> Relation a-graph = C.graph- -- | Construct a graph from an adjacency list. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. --@@ -199,7 +189,7 @@ fromAdjacencyList :: Ord a => [(a, [a])] -> Relation a fromAdjacencyList as = Relation (Set.fromList vs) (Set.fromList es)   where-    vs = concatMap (\(x, ys) -> x : ys) as+    vs = concatMap (uncurry (:)) as     es = [ (x, y) | (x, ys) <- as, y <- ys ]  -- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the@@ -235,6 +225,7 @@ -- @ -- 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@@ -338,7 +329,7 @@ edgeSet :: Relation a -> Set.Set (a, a) edgeSet = relation --- | The /preset/ of an element @x@ is the set of elements that are related to+-- | The /preset/ (here 'preSet') of an element @x@ is the set of elements that are related to -- it on the /left/, i.e. @preSet x == { a | aRx }@. In the context of directed -- graphs, this corresponds to the set of /direct predecessors/ of vertex @x@. -- Complexity: /O(n + m)/ time and /O(n)/ memory.@@ -352,7 +343,7 @@ preSet :: Ord a => a -> Relation a -> Set.Set a preSet x = Set.mapMonotonic fst . Set.filter ((== x) . snd) . relation --- | The /postset/ of an element @x@ is the set of elements that are related to+-- | The /postset/ (here 'postSet') of an element @x@ is the set of elements that are related to -- it on the /right/, i.e. @postSet x == { a | xRa }@. In the context of directed -- graphs, this corresponds to the set of /direct successors/ of vertex @x@. -- Complexity: /O(n + m)/ time and /O(n)/ memory.@@ -404,7 +395,7 @@ clique :: Ord a => [a] -> Relation a clique = C.clique --- | The /biclique/ on a list of vertices.+-- | The /biclique/ on two lists of vertices. -- Complexity: /O(n * log(n) + m)/ time and /O(n + m)/ memory. -- -- @@@ -420,18 +411,33 @@     x = Set.fromList xs     y = Set.fromList ys --- | The /star/ formed by a centre vertex and a list of leaves.+-- | 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 = C.star --- | The /tree graph/ constructed from a given 'Tree' data structure.+-- | The /star transpose/ formed by a list of leaves connected to a centre vertex.+-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the+-- given list.+--+-- @+-- starTranspose x []    == 'vertex' x+-- starTranspose x [y]   == 'edge' y x+-- starTranspose x [y,z] == 'edges' [(y,x), (z,x)]+-- starTranspose x ys    == 'connect' ('vertices' ys) ('vertex' x)+-- starTranspose x ys    == 'transpose' ('star' x ys)+-- @+starTranspose :: Ord a => a -> [a] -> Relation a+starTranspose = C.starTranspose++-- | The /tree graph/ constructed from a given 'Tree.Tree' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. -- -- @@@ -443,7 +449,7 @@ tree :: Ord a => Tree.Tree a -> Relation a tree = C.tree --- | The /forest graph/ constructed from a given 'Forest' data structure.+-- | The /forest graph/ constructed from a given 'Tree.Forest' data structure. -- Complexity: /O((n + m) * log(n))/ time and /O(n + m)/ memory. -- -- @@@ -460,6 +466,9 @@ -- -- @ -- 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@@ -492,7 +501,7 @@ 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 with a given vertex.+-- | 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. --@@ -513,9 +522,6 @@ -- transpose ('vertex' x)  == 'vertex' x -- transpose ('edge' x y)  == 'edge' y x -- transpose . transpose == id--- transpose . 'path'      == 'path'    . 'reverse'--- transpose . 'circuit'   == 'circuit' . 'reverse'--- transpose . 'clique'    == 'clique'  . 'reverse' -- 'edgeList' . transpose  == 'Data.List.sort' . map 'Data.Tuple.swap' . 'edgeList' -- @ transpose :: Ord a => Relation a -> Relation a@@ -542,7 +548,7 @@ -- be evaluated. -- -- @--- induce (const True)  x      == x+-- induce (const True ) x      == x -- induce (const False) x      == 'empty' -- induce (/= x)               == 'removeVertex' x -- induce p . induce q         == induce (\\x -> p x && q x)@@ -593,7 +599,7 @@ -- symmetricClosure ('edge' x y) == 'edges' [(x, y), (y, x)] -- @ symmetricClosure :: Ord a => Relation a -> Relation a-symmetricClosure (Relation d r) = Relation d $ r `Set.union` (Set.map swap r)+symmetricClosure (Relation d r) = Relation d $ r `Set.union` Set.map swap r  -- | Compute the /transitive closure/ of a 'Relation'. -- Complexity: /O(n * m * log(n) * log(m))/ time.

@@ -1,14 +1,14 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation.Internal--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : unstable -- -- This module exposes the implementation of the 'Relation' data type. The API--- is unstable and unsafe. Where possible use the non-internal module--- "Algebra.Graph.Relation" instead.+-- is unstable and unsafe, and is exposed only for documentation. You should+-- use the non-internal module "Algebra.Graph.Relation" instead. ----------------------------------------------------------------------------- module Algebra.Graph.Relation.Internal (     -- * Binary relation implementation@@ -37,7 +37,7 @@ show (1 + 2     :: Relation Int) == "vertices [1,2]" show (1 * 2     :: Relation Int) == "edge 1 2" show (1 * 2 * 3 :: Relation Int) == "edges [(1,2),(1,3),(2,3)]"-show (1 * 2 + 3 :: Relation Int) == "graph [1,2,3] [(1,2)]"@+show (1 * 2 + 3 :: Relation Int) == "overlay (vertex 3) (edge 1 2)"@  The 'Eq' instance satisfies all axioms of algebraic graphs: @@ -90,18 +90,17 @@  instance (Ord a, Show a) => Show (Relation a) where     show (Relation d r)-        | vs == []      = "empty"-        | es == []      = if Set.size d > 1 then "vertices " ++ show vs-                                            else "vertex "   ++ show v-        | d == referred = if Set.size r > 1 then "edges " ++ show es-                                            else "edge "  ++ show e ++ " " ++ show f-        | otherwise     = "graph " ++ show vs ++ " " ++ show es+        | Set.null d = "empty"+        | Set.null r = vshow (Set.toAscList d)+        | d == used  = eshow (Set.toAscList r)+        | otherwise  = "overlay (" ++ vshow (Set.toAscList $ Set.difference d used)+                    ++ ") (" ++ eshow (Set.toAscList r) ++ ")"       where-        vs       = Set.toAscList d-        es       = Set.toAscList r-        v        = head vs-        (e, f)   = head es-        referred = referredToVertexSet r+        vshow [x]      = "vertex "   ++ show x+        vshow xs       = "vertices " ++ show xs+        eshow [(x, y)] = "edge "     ++ show x ++ " " ++ show y+        eshow xs       = "edges "    ++ show xs+        used           = referredToVertexSet r  instance Ord a => Graph (Relation a) where     type Vertex (Relation a) = a@@ -125,7 +124,7 @@  instance ToGraph (Relation a) where     type ToVertex (Relation a) = a-    toGraph (Relation d r) = graph (Set.toList d) (Set.toList r)+    toGraph (Relation d r) = vertices (Set.toList d) `overlay` edges (Set.toList r)  -- | Check if the internal representation of a relation is consistent, i.e. if all -- pairs of elements in the 'relation' refer to existing elements in the 'domain'.

@@ -1,16 +1,16 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation.InternalDerived--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : unstable -- -- This module exposes the implementation of derived binary relation data types.--- The API is unstable and unsafe. Where possible use the non-internal modules--- "Algebra.Graph.Relation.Reflexive", "Algebra.Graph.Relation.Symmetric",--- "Algebra.Graph.Relation.Transitive" and "Algebra.Graph.Relation.Preorder"--- instead.+-- The API is unstable and unsafe, and is exposed only for documentation. You+-- should use the non-internal modules "Algebra.Graph.Relation.Reflexive",+-- "Algebra.Graph.Relation.Symmetric", "Algebra.Graph.Relation.Transitive" and+-- "Algebra.Graph.Relation.Preorder" instead. ----------------------------------------------------------------------------- module Algebra.Graph.Relation.InternalDerived (     -- * Implementation of derived binary relations

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation.Preorder--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation.Reflexive--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation.Symmetric--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Relation.Transitive--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental

@@ -5,7 +5,7 @@     module Test.QuickCheck,     module Test.QuickCheck.Function, -    GraphTestsuite, axioms, theorems, undirectedAxioms, reflexiveAxioms,+    GraphTestsuite, (//), axioms, theorems, undirectedAxioms, reflexiveAxioms,     transitiveAxioms, preorderAxioms, test,     ) where @@ -47,9 +47,9 @@ infixl 6 + infixl 7 * -type GraphTestsuite g = (Eq g, Graph g) => g -> g -> g -> Property+type GraphTestsuite g = g -> g -> g -> Property -axioms :: GraphTestsuite g+axioms :: (Eq g, Graph g) => GraphTestsuite g axioms x y z = conjoin     [       x + y == y + x                      // "Overlay commutativity"     , x + (y + z) == (x + y) + z                // "Overlay associativity"@@ -60,7 +60,7 @@     , (x + y) * z == x * z + y * z              // "Right distributivity"     ,   x * y * z == x * y + x * z + y * z      // "Decomposition" ] -theorems :: GraphTestsuite g+theorems :: (Eq g, Graph g) => GraphTestsuite g theorems x y z = conjoin     [     x + empty == x                        // "Overlay identity"     ,         x + x == x                        // "Overlay idempotence"@@ -72,23 +72,23 @@     ,             x <= x + y                    // "Overlay order"     ,         x + y <= x * y                    // "Overlay-connect order" ] -undirectedAxioms :: GraphTestsuite g+undirectedAxioms :: (Eq g, Graph g) => GraphTestsuite g undirectedAxioms x y z = conjoin     [ axioms x y z     , x * y == y * x                            // "Connect commutativity" ] -reflexiveAxioms :: (Arbitrary (Vertex g), Show (Vertex g)) => GraphTestsuite g+reflexiveAxioms :: (Eq g, Graph g, Arbitrary (Vertex g), Show (Vertex g)) => GraphTestsuite g reflexiveAxioms x y z = conjoin     [ axioms x y z     , forAll arbitrary (\v -> vertex v `asTypeOf` x == vertex v * vertex v)                                                 // "Vertex self-loop" ] -transitiveAxioms :: GraphTestsuite g+transitiveAxioms :: (Eq g, Graph g) => GraphTestsuite g transitiveAxioms x y z = conjoin     [ axioms x y z     , y == empty || x * y * z == x * y + y * z  // "Closure" ] -preorderAxioms :: (Arbitrary (Vertex g), Show (Vertex g)) => GraphTestsuite g+preorderAxioms :: (Eq g, Graph g, Arbitrary (Vertex g), Show (Vertex g)) => GraphTestsuite g preorderAxioms x y z = conjoin     [ axioms x y z     , forAll arbitrary (\v -> vertex v `asTypeOf` x == vertex v * vertex v)

@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.API--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -18,9 +18,10 @@ import Data.Set (Set) import Data.Tree -import Algebra.Graph.Class+import Algebra.Graph.Class hiding (toGraph)  import qualified Algebra.Graph.AdjacencyMap    as AdjacencyMap+import qualified Algebra.Graph.Class           as Class import qualified Algebra.Graph.Fold            as Fold import qualified Algebra.Graph                 as Graph import qualified Algebra.Graph.IntAdjacencyMap as IntAdjacencyMap@@ -39,10 +40,10 @@     overlays          = notImplemented     connects          :: [g] -> g     connects          = notImplemented-    graph             :: [Vertex g] -> [(Vertex g, Vertex g)] -> g-    graph             = notImplemented     fromAdjacencyList :: [(Vertex g, [Vertex g])] -> g     fromAdjacencyList = notImplemented+    toGraph           :: (Graph h, Vertex g ~ Vertex h) => g -> h+    toGraph           = notImplemented     foldg             :: r -> (Vertex g -> r) -> (r -> r -> r) -> (r -> r -> r) -> g -> r     foldg             = notImplemented     isSubgraphOf      :: g -> g -> Bool@@ -89,6 +90,8 @@     biclique          = notImplemented     star              :: Vertex g -> [Vertex g] -> g     star              = notImplemented+    starTranspose     :: Vertex g -> [Vertex g] -> g+    starTranspose     = notImplemented     tree              :: Tree (Vertex g) -> g     tree              = notImplemented     forest            :: Forest (Vertex g) -> g@@ -141,7 +144,6 @@     edges             = AdjacencyMap.edges     overlays          = AdjacencyMap.overlays     connects          = AdjacencyMap.connects-    graph             = AdjacencyMap.graph     fromAdjacencyList = AdjacencyMap.fromAdjacencyList     isSubgraphOf      = AdjacencyMap.isSubgraphOf     isEmpty           = AdjacencyMap.isEmpty@@ -161,6 +163,7 @@     clique            = AdjacencyMap.clique     biclique          = AdjacencyMap.biclique     star              = AdjacencyMap.star+    starTranspose     = AdjacencyMap.starTranspose     tree              = AdjacencyMap.tree     forest            = AdjacencyMap.forest     removeVertex      = AdjacencyMap.removeVertex@@ -182,7 +185,7 @@     edges         = Fold.edges     overlays      = Fold.overlays     connects      = Fold.connects-    graph         = Fold.graph+    toGraph       = Class.toGraph     foldg         = Fold.foldg     isSubgraphOf  = Fold.isSubgraphOf     isEmpty       = Fold.isEmpty@@ -201,6 +204,7 @@     clique        = Fold.clique     biclique      = Fold.biclique     star          = Fold.star+    starTranspose = Fold.starTranspose     tree          = Fold.tree     forest        = Fold.forest     mesh          = Fold.mesh@@ -224,7 +228,7 @@     edges         = Graph.edges     overlays      = Graph.overlays     connects      = Graph.connects-    graph         = Graph.graph+    toGraph       = Class.toGraph     foldg         = Graph.foldg     isSubgraphOf  = Graph.isSubgraphOf     (===)         = (Graph.===)@@ -244,6 +248,7 @@     clique        = Graph.clique     biclique      = Graph.biclique     star          = Graph.star+    starTranspose = Graph.starTranspose     tree          = Graph.tree     forest        = Graph.forest     mesh          = Graph.mesh@@ -267,7 +272,6 @@     edges             = IntAdjacencyMap.edges     overlays          = IntAdjacencyMap.overlays     connects          = IntAdjacencyMap.connects-    graph             = IntAdjacencyMap.graph     fromAdjacencyList = IntAdjacencyMap.fromAdjacencyList     isSubgraphOf      = IntAdjacencyMap.isSubgraphOf     isEmpty           = IntAdjacencyMap.isEmpty@@ -287,6 +291,7 @@     clique            = IntAdjacencyMap.clique     biclique          = IntAdjacencyMap.biclique     star              = IntAdjacencyMap.star+    starTranspose     = IntAdjacencyMap.starTranspose     tree              = IntAdjacencyMap.tree     forest            = IntAdjacencyMap.forest     removeVertex      = IntAdjacencyMap.removeVertex@@ -308,7 +313,6 @@     edges             = Relation.edges     overlays          = Relation.overlays     connects          = Relation.connects-    graph             = Relation.graph     fromAdjacencyList = Relation.fromAdjacencyList     isSubgraphOf      = Relation.isSubgraphOf     isEmpty           = Relation.isEmpty@@ -320,7 +324,7 @@     edgeList          = Relation.edgeList     preSet            = Relation.preSet     postSet           = Relation.postSet-    adjacencyList     = AdjacencyMap.adjacencyList . toGraph+    adjacencyList     = AdjacencyMap.adjacencyList . Class.toGraph     vertexSet         = Relation.vertexSet     vertexIntSet      = IntSet.fromAscList . Set.toAscList . Relation.vertexSet     edgeSet           = Relation.edgeSet@@ -329,6 +333,7 @@     clique            = Relation.clique     biclique          = Relation.biclique     star              = Relation.star+    starTranspose     = Relation.starTranspose     tree              = Relation.tree     forest            = Relation.forest     removeVertex      = Relation.removeVertex

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.AdjacencyMap--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -29,7 +29,7 @@ testAdjacencyMap :: IO () testAdjacencyMap = do     putStrLn "\n============ AdjacencyMap ============"-    test "Axioms of graphs" $ (axioms :: GraphTestsuite AI)+    test "Axioms of graphs" (axioms :: GraphTestsuite AI)      test "Consistency of arbitraryAdjacencyMap" $ \(m :: AI) ->         consistent m

@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Arbitrary--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -14,6 +14,9 @@     arbitraryGraph, arbitraryRelation, arbitraryAdjacencyMap, arbitraryIntAdjacencyMap   ) where +import Prelude ()+import Prelude.Compat+ import Control.Monad import Data.Tree import Test.QuickCheck@@ -26,9 +29,10 @@ import Algebra.Graph.Relation.Internal import Algebra.Graph.Relation.InternalDerived -import qualified Algebra.Graph.Class           as C import qualified Algebra.Graph.AdjacencyMap    as AdjacencyMap+import qualified Algebra.Graph.Class           as C import qualified Algebra.Graph.IntAdjacencyMap as IntAdjacencyMap+import qualified Algebra.Graph.NonEmpty        as NE import qualified Algebra.Graph.Relation        as Relation  -- | Generate an arbitrary 'Graph' value of a specified size.@@ -39,8 +43,8 @@     expr 1 = C.vertex <$> arbitrary     expr n = do         left <- choose (0, n)-        oneof [ C.overlay <$> (expr left) <*> (expr $ n - left)-              , C.connect <$> (expr left) <*> (expr $ n - left) ]+        oneof [ C.overlay <$> expr left <*> expr (n - left)+              , C.connect <$> expr left <*> expr (n - left) ]  instance Arbitrary a => Arbitrary (Graph a) where     arbitrary = arbitraryGraph@@ -51,6 +55,26 @@                         ++ [Overlay x' y' | (x', y') <- shrink (x, y) ]     shrink (Connect x y) = [Empty, x, y, Overlay x y]                         ++ [Connect x' y' | (x', y') <- shrink (x, y) ]++-- | Generate an arbitrary 'NonEmptyGraph' value of a specified size.+arbitraryNonEmptyGraph :: Arbitrary a => Gen (NE.NonEmptyGraph a)+arbitraryNonEmptyGraph = sized expr+  where+    expr 0 = NE.vertex <$> arbitrary -- can't generate non-empty graph of size 0+    expr 1 = NE.vertex <$> arbitrary+    expr n = do+        left <- choose (1, n)+        oneof [ NE.overlay <$> expr left <*> expr (n - left)+              , NE.connect <$> expr left <*> expr (n - left) ]++instance Arbitrary a => Arbitrary (NE.NonEmptyGraph a) where+    arbitrary = arbitraryNonEmptyGraph++    shrink (NE.Vertex    _) = []+    shrink (NE.Overlay x y) = [x, y]+                           ++ [NE.Overlay x' y' | (x', y') <- shrink (x, y) ]+    shrink (NE.Connect x y) = [x, y, NE.Overlay x y]+                           ++ [NE.Connect x' y' | (x', y') <- shrink (x, y) ]  -- | Generate an arbitrary 'Relation'. arbitraryRelation :: (Arbitrary a, Ord a) => Gen (Relation a)

@@ -1,8 +1,8 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP, OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Export--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -14,9 +14,13 @@     testExport   ) where -import Prelude-import Data.Monoid+import Prelude ()+import Prelude.Compat +#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif+ import Algebra.Graph (Graph, circuit) import Algebra.Graph.Export hiding (unlines) import Algebra.Graph.Export.Dot (Attribute (..))@@ -79,7 +83,7 @@      putStrLn "\n============ Export.indent ============"     test "indent 0        == id" $ \(x :: String) ->-         (indent 0) (literal x) == literal x+          indent 0 (literal x) == literal x      test "indent 1 mempty == \" \"" $           indent 1 mempty == (" " :: Doc String)

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Fold--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -29,11 +29,11 @@ testFold :: IO () testFold = do     putStrLn "\n============ Fold ============"-    test "Axioms of graphs"   $ (axioms   :: GraphTestsuite F)+    test "Axioms of graphs" (axioms :: GraphTestsuite F)      testShow            t     testBasicPrimitives t-    testFoldg           h+    testToGraph         h     testIsSubgraphOf    t     testSize            t     testProperties      t@@ -53,9 +53,9 @@     test "mesh xs     ys   == box (path xs) (path ys)" $ \(xs :: [Int]) (ys :: [Int]) ->           mesh xs     ys   == (box (path xs) (path ys) :: Fold (Int, Int)) -    test ("mesh [1..3] \"ab\" == <correct result>") $-         (mesh [1..3] "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))-                                                         , ((2,'a'),(3,'a')), ((2,'b'),(3,'b')), ((3,'a'),(3,'b')) ]+    test "mesh [1..3] \"ab\" == <correct result>" $+         (mesh [1..3]  "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))+                                                          , ((2,'a'),(3,'a')), ((2,'b'),(3,'b')), ((3,'a'),(3,'b')) ]      putStrLn "\n============ Fold.torus ============"     test "torus xs    []   == empty" $ \xs ->@@ -70,9 +70,9 @@     test "torus xs    ys   == box (circuit xs) (circuit ys)" $ \(xs :: [Int]) (ys :: [Int]) ->           torus xs    ys   == (box (circuit xs) (circuit ys) :: Fold (Int, Int)) -    test ("torus [1,2] \"ab\" == <correct result>") $-         (torus [1,2] "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))-                                                         , ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2,'a')) ]+    test "torus [1,2] \"ab\" == <correct result>" $+         (torus [1,2]  "ab" :: Fold (Int, Char)) == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))+                                                          , ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2,'a')) ]      putStrLn "\n============ Fold.deBruijn ============"     test "          deBruijn 0 xs               == edge [] []" $ \(xs :: [Int]) ->@@ -107,21 +107,21 @@     putStrLn "\n============ Fold.box ============"     let unit = fmap $ \(a, ()) -> a         comm = fmap $ \(a,  b) -> (b, a)-    test "box x y             ~~ box y x" $ mapSize (min 10) $ \(x :: F) (y :: F) ->-          comm (box x y)      == (box y x :: Fold (Int, Int))+    test "box x y               ~~ box y x" $ mapSize (min 10) $ \(x :: F) (y :: F) ->+          comm (box x y)        == (box y x :: Fold (Int, Int)) -    test "box x (overlay y z) == overlay (box x y) (box x z)" $ mapSize (min 10) $ \(x :: F) (y :: F) z ->-          box x (overlay y z) == (overlay (box x y) (box x z) :: Fold (Int, Int))+    test "box x (overlay y z)   == overlay (box x y) (box x z)" $ mapSize (min 10) $ \(x :: F) (y :: F) z ->+          box x (overlay y z)   == (overlay (box x y) (box x z) :: Fold (Int, Int)) -    test "box x (vertex ())   ~~ x" $ mapSize (min 10) $ \(x :: F) ->-     unit(box x (vertex ()))  == x+    test "box x (vertex ())     ~~ x" $ mapSize (min 10) $ \(x :: F) ->+     unit(box x (vertex ()))    == x -    test "box x empty         ~~ empty" $ mapSize (min 10) $ \(x :: F) ->-     unit(box x empty)        == empty+    test "box x empty           ~~ empty" $ mapSize (min 10) $ \(x :: F) ->+     unit(box x empty)          == empty      let assoc = fmap $ \(a, (b, c)) -> ((a, b), c)-    test "box x (box y z)     ~~ box (box x y) z" $ mapSize (min 10) $ \(x :: F) (y :: F) (z :: F) ->-      assoc (box x (box y z)) == (box (box x y) z :: Fold ((Int, Int), Int))+    test "box x (box y z)       ~~ box (box x y) z" $ mapSize (min 10) $ \(x :: F) (y :: F) (z :: F) ->+      assoc (box x (box y z))   == (box (box x y) z :: Fold ((Int, Int), Int))      test "transpose   (box x y) == box (transpose x) (transpose y)" $ mapSize (min 10) $ \(x :: F) (y :: F) ->           transpose   (box x y) == (box (transpose x) (transpose y) :: Fold (Int, Int))

@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Generic--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -12,20 +12,27 @@ module Algebra.Graph.Test.Generic (     -- * Generic tests     Testsuite, testsuite, HTestsuite, hTestsuite, testShow, testFromAdjacencyList,-    testBasicPrimitives, testFoldg, testIsSubgraphOf, testSize, testProperties,+    testBasicPrimitives, testToGraph, testIsSubgraphOf, testSize, testProperties,     testAdjacencyList, testPreSet, testPostSet, testPostIntSet, testGraphFamilies,     testTransformations, testDfsForest, testDfsForestFrom, testDfs, testTopSort,     testIsTopSort, testSplitVertex, testBind, testSimplify   ) where -import Data.Foldable-import Data.List (nub, sort)+import Prelude ()+import Prelude.Compat++import Control.Monad (when)+import Data.Orphans ()++import Data.Foldable (toList)+import Data.List (nub) import Data.Tree import Data.Tuple  import Algebra.Graph.Class (Graph (..)) import Algebra.Graph.Test import Algebra.Graph.Test.API+import Algebra.Graph.Relation (Relation)  import qualified Data.Set    as Set import qualified Data.IntSet as IntSet@@ -56,8 +63,7 @@                               , testVertices                               , testEdges                               , testOverlays-                              , testConnects-                              , testGraph ]+                              , testConnects ]  testProperties :: Testsuite -> IO () testProperties = mconcat [ testIsEmpty@@ -77,6 +83,7 @@                             , testClique                             , testBiclique                             , testStar+                            , testStarTranspose                             , testTree                             , testForest ] @@ -92,23 +99,23 @@ testShow :: Testsuite -> IO () testShow (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "Show ============"-    test "show (empty     :: IntAdjacencyMap) == \"empty\"" $-          show % empty                        == "empty"+    test "show (empty    ) == \"empty\"" $+          show % empty     ==  "empty" -    test "show (1         :: IntAdjacencyMap) == \"vertex 1\"" $-          show % 1                            == "vertex 1"+    test "show (1        ) == \"vertex 1\"" $+          show % 1         ==  "vertex 1" -    test "show (1 + 2     :: IntAdjacencyMap) == \"vertices [1,2]\"" $-          show % (1 + 2)                      == "vertices [1,2]"+    test "show (1 + 2    ) == \"vertices [1,2]\"" $+          show % (1 + 2)   ==  "vertices [1,2]" -    test "show (1 * 2     :: IntAdjacencyMap) == \"edge 1 2\"" $-          show % (1 * 2)                      == "edge 1 2"+    test "show (1 * 2    ) == \"edge 1 2\"" $+          show % (1 * 2)   ==  "edge 1 2" -    test "show (1 * 2 * 3 :: IntAdjacencyMap) == \"edges [(1,2),(1,3),(2,3)]\"" $-          show % (1 * 2 * 3)                  == "edges [(1,2),(1,3),(2,3)]"+    test "show (1 * 2 * 3) == \"edges [(1,2),(1,3),(2,3)]\"" $+          show % (1 * 2 * 3) == "edges [(1,2),(1,3),(2,3)]" -    test "show (1 * 2 + 3 :: IntAdjacencyMap) == \"graph [1,2,3] [(1,2)]\"" $-          show % (1 * 2 + 3)                  == "graph [1,2,3] [(1,2)]"+    test "show (1 * 2 + 3) == \"overlay (vertex 3) (edge 1 2)\"" $+          show % (1 * 2 + 3) == "overlay (vertex 3) (edge 1 2)"  testEmpty :: Testsuite -> IO () testEmpty (Testsuite prefix (%)) = do@@ -134,9 +141,6 @@     test "hasVertex x (vertex x) == True" $ \x ->           hasVertex x % vertex x == True -    test "hasVertex 1 (vertex 2) == False" $-          hasVertex 1 % vertex 2 == False-     test "vertexCount (vertex x) == 1" $ \x ->           vertexCount % vertex x == 1 @@ -147,46 +151,46 @@ testEdge (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)+          edge x y               == connect (vertex x) % vertex y      test "hasEdge x y (edge x y) == True" $ \x y ->-          hasEdge x y % (edge x y) == True+          hasEdge x y % edge x y == True      test "edgeCount   (edge x y) == 1" $ \x y ->-          edgeCount % (edge x y) == 1+          edgeCount %  edge x y  == 1      test "vertexCount (edge 1 1) == 1" $-          vertexCount % (edge 1 1) == 1+          vertexCount % edge 1 1 == 1      test "vertexCount (edge 1 2) == 2" $-          vertexCount % (edge 1 2) == 2+          vertexCount % edge 1 2 == 2  testOverlay :: Testsuite -> IO () testOverlay (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "overlay ============"     test "isEmpty     (overlay x y) == isEmpty   x   && isEmpty   y" $ \x y ->-          isEmpty   % (overlay x y) == (isEmpty   x   && isEmpty   y)+          isEmpty   %  overlay x y  == (isEmpty  x   && isEmpty   y)      test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \x y z ->-          hasVertex z % (overlay x y) == (hasVertex z x || hasVertex z y)+          hasVertex z % overlay x y == (hasVertex z x || hasVertex z y)      test "vertexCount (overlay x y) >= vertexCount x" $ \x y ->-          vertexCount % (overlay x y) >= vertexCount x+          vertexCount % overlay x y >= vertexCount x      test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \x y ->-          vertexCount % (overlay x y) <= vertexCount x + vertexCount y+          vertexCount % overlay x y <= vertexCount x + vertexCount y      test "edgeCount   (overlay x y) >= edgeCount x" $ \x y ->-          edgeCount % (overlay x y) >= edgeCount x+          edgeCount %  overlay x y  >= edgeCount x      test "edgeCount   (overlay x y) <= edgeCount x   + edgeCount y" $ \x y ->-          edgeCount % (overlay x y) <= edgeCount x   + edgeCount y+          edgeCount %  overlay x y  <= edgeCount x   + edgeCount y      test "vertexCount (overlay 1 2) == 2" $-          vertexCount % (overlay 1 2) == 2+          vertexCount % overlay 1 2 == 2      test "edgeCount   (overlay 1 2) == 0" $-          edgeCount % (overlay 1 2) == 0+          edgeCount %  overlay 1 2  == 0  testConnect :: Testsuite -> IO () testConnect (Testsuite prefix (%)) = do@@ -263,6 +267,9 @@     test "overlays [x,y]     == overlay x y" $ \x y ->           overlays [x,y]     == id % overlay x y +    test "overlays           == foldr overlay empty" $ mapSize (min 10) $ \xs ->+          overlays xs        == id % foldr overlay empty xs+     test "isEmpty . overlays == all isEmpty" $ mapSize (min 10) $ \xs ->           isEmpty % overlays xs == all isEmpty xs @@ -278,24 +285,12 @@     test "connects [x,y]     == connect x y" $ \x y ->           connects [x,y]     == id % connect x y +    test "connects           == foldr connect empty" $ mapSize (min 10) $ \xs ->+          connects xs        == id % foldr connect empty xs+     test "isEmpty . connects == all isEmpty" $ mapSize (min 10) $ \xs ->           isEmpty % connects xs == all isEmpty xs -testGraph :: Testsuite -> IO ()-testGraph (Testsuite prefix (%)) = do-    putStrLn $ "\n============ " ++ prefix ++ "graph ============"-    test "graph []  []      == empty" $-          graph []  []      == id % empty--    test "graph [x] []      == vertex x" $ \x ->-          graph [x] []      == id % vertex x--    test "graph []  [(x,y)] == edge x y" $ \x y ->-          graph []  [(x,y)] == id % edge x y--    test "graph vs  es      == overlay (vertices vs) (edges es)" $ \vs es ->-          graph vs  es      == overlay (vertices vs) % edges es- testFromAdjacencyList :: Testsuite -> IO () testFromAdjacencyList (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "fromAdjacencyList ============"@@ -314,8 +309,18 @@     test "overlay (fromAdjacencyList xs) (fromAdjacencyList ys) == fromAdjacencyList (xs ++ ys)" $ \xs ys ->           overlay (fromAdjacencyList xs) % fromAdjacencyList ys == fromAdjacencyList (xs ++ ys) -testFoldg :: HTestsuite -> IO ()-testFoldg (HTestsuite prefix (%)) = do+testToGraph :: HTestsuite -> IO ()+testToGraph (HTestsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "toGraph ============"+    test "      toGraph (g     :: Graph a  ) :: Graph a       == g" $ \g ->+                toGraph % g                                   == g++    test "show (toGraph (1 * 2 :: Graph Int) :: Relation Int) == \"edge 1 2\"" $+          show (toGraph % (1 * 2)            :: Relation Int) == "edge 1 2"++    test "\ntoGraph == foldg empty vertex overlay connect" $ \x ->+          toGraph % x == id % foldg empty vertex overlay connect x+     putStrLn $ "\n============ " ++ prefix ++ "foldg ============"     test "foldg empty vertex        overlay connect        == id" $ \x ->           foldg empty vertex        overlay connect x      == id % x@@ -399,8 +404,11 @@           hasVertex x % empty          == False      test "hasVertex x (vertex x)       == True" $ \x ->-          hasVertex x % vertex x     == True+          hasVertex x % vertex x       == True +    test "hasVertex 1 (vertex 2)       == False" $+          hasVertex 1 % vertex 2       == False+     test "hasVertex x . removeVertex x == const False" $ \x y ->          (hasVertex x . removeVertex x) y == const False % y @@ -625,7 +633,7 @@           clique [x,y,z]    == id % edges [(x,y), (x,z), (y,z)]      test "clique (xs ++ ys) == connect (clique xs) (clique ys)" $ \xs ys ->-          clique (xs ++ ys) == connect (clique xs) % (clique ys)+          clique (xs ++ ys) == connect (clique xs) % clique ys  testBiclique :: Testsuite -> IO () testBiclique (Testsuite prefix (%)) = do@@ -639,11 +647,11 @@     test "biclique []      [y]     == vertex y" $ \y ->           biclique []      [y]     == id % vertex y -    test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \(x1) x2 y1 y2 ->+    test "biclique [x1,x2] [y1,y2] == edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]" $ \x1 x2 y1 y2 ->           biclique [x1,x2] [y1,y2] == id % edges [(x1,y1), (x1,y2), (x2,y1), (x2,y2)]      test "biclique xs      ys      == connect (vertices xs) (vertices ys)" $ \xs ys ->-          biclique xs      ys      == connect (vertices xs) % (vertices ys)+          biclique xs      ys      == connect (vertices xs) % vertices ys  testStar :: Testsuite -> IO () testStar (Testsuite prefix (%)) = do@@ -657,6 +665,27 @@     test "star x [y,z] == edges [(x,y), (x,z)]" $ \x y z ->           star x [y,z] == id % edges [(x,y), (x,z)] +    test "star x ys    == connect (vertex x) (vertices ys)" $ \x ys ->+          star x ys    == connect (vertex x) % (vertices ys)++testStarTranspose :: Testsuite -> IO ()+testStarTranspose (Testsuite prefix (%)) = do+    putStrLn $ "\n============ " ++ prefix ++ "starTranspose ============"+    test "starTranspose x []    == vertex x" $ \x ->+          starTranspose x []    == id % vertex x++    test "starTranspose x [y]   == edge y x" $ \x y ->+          starTranspose x [y]   == id % edge y x++    test "starTranspose x [y,z] == edges [(y,x), (z,x)]" $ \x y z ->+          starTranspose x [y,z] == id % edges [(y,x), (z,x)]++    test "starTranspose x ys    == connect (vertices ys) (vertex x)" $ \x ys ->+          starTranspose x ys    == connect (vertices ys) % (vertex x)++    test "starTranspose x ys    == transpose (star x ys)" $ \x ys ->+          starTranspose x ys    == transpose % (star x ys)+ testTree :: Testsuite -> IO () testTree (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "tree ============"@@ -685,7 +714,7 @@           forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == id % edges [(1,2), (1,3), (4,5)]      test "forest                                                     == overlays . map tree" $ \x ->-         (forest x)                                                  == id % (overlays . map tree) x+          forest x                                                   == id % (overlays . map tree) x  testRemoveVertex :: Testsuite -> IO () testRemoveVertex (Testsuite prefix (%)) = do@@ -693,6 +722,15 @@     test "removeVertex x (vertex x)       == empty" $ \x ->           removeVertex x % vertex x       == empty +    test "removeVertex 1 (vertex 2)       == vertex 2" $+          removeVertex 1 % (vertex 2)     == vertex 2++    test "removeVertex x (edge x x)       == empty" $ \x ->+          removeVertex x % (edge x x)     == empty++    test "removeVertex 1 (edge 1 2)       == vertex 2" $+          removeVertex 1 % (edge 1 2)     == vertex 2+     test "removeVertex x . removeVertex x == removeVertex x" $ \x y ->          (removeVertex x . removeVertex x) y == removeVertex x % y @@ -714,6 +752,11 @@     test "removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2" $           removeEdge 1 2 % (1 * 1 * 2 * 2) == 1 * 1 + 2 * 2 +    -- TODO: Ouch. Generic tests are becoming awkward. We need a better way.+    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+ testReplaceVertex :: Testsuite -> IO () testReplaceVertex (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "replaceVertex ============"@@ -748,25 +791,16 @@           transpose % empty     == empty      test "transpose (vertex x)  == vertex x" $ \x ->-          transpose % (vertex x) == vertex x+          transpose % vertex x  == vertex x      test "transpose (edge x y)  == edge y x" $ \x y ->-          transpose % (edge x y) == edge y x+          transpose % edge x y  == edge y x -    test "transpose . transpose == id" $ \x ->+    test "transpose . transpose == id" $ mapSize (min 10) $ \x ->          (transpose . transpose) % x == x -    test "transpose . path      == path    . reverse" $ \xs ->-          transpose % (path xs) == (path . reverse) xs--    test "transpose . circuit   == circuit . reverse" $ \xs ->-          transpose % (circuit xs) == (circuit . reverse) xs--    test "transpose . clique    == clique  . reverse" $ \xs ->-          transpose % (clique xs) == (clique . reverse) xs-     test "edgeList . transpose  == sort . map swap . edgeList" $ \x ->-          edgeList % (transpose x) == (sort . map swap . edgeList) x+          edgeList % transpose x == (sort . map swap . edgeList) x  testGmap :: Testsuite -> IO () testGmap (Testsuite prefix (%)) = do@@ -789,8 +823,8 @@ testInduce :: Testsuite -> IO () testInduce (Testsuite prefix (%)) = do     putStrLn $ "\n============ " ++ prefix ++ "induce ============"-    test "induce (const True)  x      == x" $ \x ->-          induce (const True) % x     == x+    test "induce (const True ) x      == x" $ \x ->+          induce (const True ) % x    == x      test "induce (const False) x      == empty" $ \x ->           induce (const False) % x    == empty@@ -829,7 +863,7 @@           bind (vertex x) f    == id % f x      test "bind (edge x y) f    == connect (f x) (f y)" $ \(apply -> f) x y ->-          bind (edge x y) f    == connect (f x) % (f y)+          bind (edge x y) f    == connect (f x) % f y      test "bind (vertices xs) f == overlays (map f xs)" $ mapSize (min 10) $ \xs (apply -> f) ->           bind (vertices xs) f == id % overlays (map f xs)@@ -869,10 +903,10 @@           isSubgraphOf (forest $ dfsForest x) % x == True      test "dfsForest . forest . dfsForest        == dfsForest" $ \x ->-          dfsForest % (forest $ dfsForest x)    == dfsForest % x+          dfsForest % forest (dfsForest x)      == dfsForest % x      test "dfsForest (vertices vs)               == map (\\v -> Node v []) (nub $ sort vs)" $ \vs ->-          dfsForest % (vertices vs)             == map (\v -> Node v []) (nub $ sort vs)+          dfsForest % vertices vs               == map (\v -> Node v []) (nub $ sort vs)      test "dfsForest $ 3 * (1 + 4) * (1 + 5)     == <correct result>" $           dfsForest % (3 * (1 + 4) * (1 + 5))   == [ Node { rootLabel = 1@@ -907,7 +941,7 @@           dfsForestFrom (vertexList x) % x             == dfsForest % x      test "dfsForestFrom vs             (vertices vs)   == map (\\v -> Node v []) (nub vs)" $ \vs ->-          dfsForestFrom vs           % (vertices vs)   == map (\v -> Node v []) (nub vs)+          dfsForestFrom vs           %  vertices vs    == map (\v -> Node v []) (nub vs)      test "dfsForestFrom []             x               == []" $ \x ->           dfsForestFrom []           % x               == []

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Graph--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -24,16 +24,16 @@ h :: HTestsuite h = hTestsuite "Graph." empty -type G  = Graph Int+type G = Graph Int  testGraph :: IO () testGraph = do     putStrLn "\n============ Graph ============"-    test "Axioms of graphs"   $ (axioms   :: GraphTestsuite G)-    test "Theorems of graphs" $ (theorems :: GraphTestsuite G)+    test "Axioms of graphs"   (axioms   :: GraphTestsuite G)+    test "Theorems of graphs" (theorems :: GraphTestsuite G)      testBasicPrimitives t-    testFoldg           h+    testToGraph         h     testIsSubgraphOf    t     testSize            t     testProperties      t@@ -69,8 +69,8 @@     test "mesh xs     ys   == box (path xs) (path ys)" $ \(xs :: [Int]) (ys :: [Int]) ->           mesh xs     ys   == box (path xs) (path ys) -    test ("mesh [1..3] \"ab\" == <correct result>") $-         mesh [1..3] "ab"  == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))+    test "mesh [1..3] \"ab\" == <correct result>" $+          mesh [1..3]  "ab"  == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))                                     , ((2,'a'),(3,'a')), ((2,'b'),(3,'b')), ((3,'a'),(3 :: Int,'b')) ]      putStrLn "\n============ Graph.torus ============"@@ -86,9 +86,9 @@     test "torus xs    ys   == box (circuit xs) (circuit ys)" $ \(xs :: [Int]) (ys :: [Int]) ->           torus xs    ys   == box (circuit xs) (circuit ys) -    test ("torus [1,2] \"ab\" == <correct result>") $-         torus [1,2] "ab"  == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))-                                    , ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2 :: Int,'a')) ]+    test "torus [1,2] \"ab\" == <correct result>" $+          torus [1,2]  "ab"  == edges [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a')), ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))+                                      , ((2,'a'),(1,'a')), ((2,'a'),(2,'b')), ((2,'b'),(1,'b')), ((2,'b'),(2 :: Int,'a')) ]      putStrLn "\n============ Graph.deBruijn ============"     test "          deBruijn 0 xs               == edge [] []" $ \(xs :: [Int]) ->@@ -108,7 +108,7 @@                                                          , ("10","00"), ("10","01"), ("11","10"), ("11","11") ]      test "          transpose   (deBruijn n xs) == fmap reverse $ deBruijn n xs" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->-                    transpose   (deBruijn n xs) == (fmap reverse $ deBruijn n xs)+                    transpose   (deBruijn n xs) == fmap reverse (deBruijn n xs)      test "          vertexCount (deBruijn n xs) == (length $ nub xs)^n" $ mapSize (min 5) $ \(NonNegative n) (xs :: [Int]) ->                     vertexCount (deBruijn n xs) == (length $ nubOrd xs)^n

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.IntAdjacencyMap--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -27,7 +27,7 @@ testIntAdjacencyMap :: IO () testIntAdjacencyMap = do     putStrLn "\n============ IntAdjacencyMap ============"-    test "Axioms of graphs" $ (axioms :: GraphTestsuite IntAdjacencyMap)+    test "Axioms of graphs" (axioms :: GraphTestsuite IntAdjacencyMap)      test "Consistency of arbitraryAdjacencyMap" $ \m ->         consistent m

@@ -0,0 +1,33 @@+{-# LANGUAGE CPP, OverloadedLists #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Test.Internal+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- Testsuite for "Algebra.Graph.Internal".+-----------------------------------------------------------------------------+module Algebra.Graph.Test.Internal (+    -- * Testsuite+    testInternal+  ) where++import Prelude ()+import Prelude.Compat++#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++import Control.Applicative (pure)++import Algebra.Graph.Internal+import Algebra.Graph.Test++testInternal :: IO ()+testInternal = do+    putStrLn "\n============ Internal.List ============"+    test "pure 1 <> pure 4 == [1, 4]" $+          pure 1 <> pure 4 == ([1, 4] :: List Int)

@@ -0,0 +1,635 @@+{-# LANGUAGE CPP, ViewPatterns #-}+-----------------------------------------------------------------------------+-- |+-- Module     : Algebra.Graph.Test.NonEmptyGraph+-- Copyright  : (c) Andrey Mokhov 2016-2018+-- License    : MIT (see the file LICENSE)+-- Maintainer : andrey.mokhov@gmail.com+-- Stability  : experimental+--+-- Testsuite for "Algebra.Graph.NonEmpty".+-----------------------------------------------------------------------------+module Algebra.Graph.Test.NonEmptyGraph (+    -- * Testsuite+    testGraphNonEmpty+  ) where++import Prelude ()+import Prelude.Compat++#if !MIN_VERSION_base(4,11,0)+import Data.Semigroup+#endif++import Control.Monad+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe+import Data.Tree+import Data.Tuple++import Algebra.Graph.NonEmpty+import Algebra.Graph.Test hiding (axioms, theorems)++import qualified Algebra.Graph       as G+import qualified Algebra.Graph.Class as C+import qualified Data.List.NonEmpty  as NonEmpty+import qualified Data.Set            as Set+import qualified Data.IntSet         as IntSet++type G = NonEmptyGraph Int++axioms :: G -> G -> G -> Property+axioms x y z = conjoin+    [       x + y == y + x                      // "Overlay commutativity"+    , x + (y + z) == (x + y) + z                // "Overlay associativity"+    , x * (y * z) == (x * y) * z                // "Connect associativity"+    , x * (y + z) == x * y + x * z              // "Left distributivity"+    , (x + y) * z == x * z + y * z              // "Right distributivity"+    ,   x * y * z == x * y + x * z + y * z      // "Decomposition" ]++theorems :: G -> G -> Property+theorems x y = conjoin+    [         x + x == x                        // "Overlay idempotence"+    , x + y + x * y == x * y                    // "Absorption"+    ,         x * x == x * x * x                // "Connect saturation"+    ,             x <= x + y                    // "Overlay order"+    ,         x + y <= x * y                    // "Overlay-connect order" ]+  where+    (<=) = isSubgraphOf+    infixl 4 <=++testGraphNonEmpty :: IO ()+testGraphNonEmpty = do+    putStrLn "\n============ Graph.NonEmpty ============"+    test "Axioms of non-empty graphs"   axioms+    test "Theorems of non-empty graphs" theorems++    putStrLn $ "\n============ Functor (NonEmptyGraph a) ============"+    test "fmap f (vertex x) == vertex (f x)" $ \(apply -> f) (x :: Int) ->+          fmap f (vertex x) == vertex (f x :: Int)++    test "fmap f (edge x y) == edge (f x) (f y)" $ \(apply -> f) (x :: Int) y ->+          fmap f (edge x y) == edge (f x) (f y :: Int)++    test "fmap id           == id" $ \(x :: G) ->+          fmap id x         == x++    test "fmap f . fmap g   == fmap (f . g)" $ \(apply -> f) (apply -> g) (x :: G) ->+         (fmap f . fmap g) x == (fmap (f . (g :: Int -> Int)) x :: G)++    putStrLn $ "\n============ Monad (NonEmptyGraph a) ============"+    test "(vertex x >>= f)     == f x" $ \(apply -> f) (x :: Int) ->+          (vertex x >>= f)     == (f x :: G)++    test "(edge x y >>= f)     == connect (f x) (f y)" $ \(apply -> f) (x :: Int) y ->+          (edge x y >>= f)     == connect (f x) (f y :: G)++    test "(vertices1 xs >>= f) == overlays1 (fmap f xs)" $ mapSize (min 10) $ \(xs' :: NonEmptyList Int) (apply -> f) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (vertices1 xs >>= f) == (overlays1 (fmap f xs) :: G)++    test "(x >>= vertex)       == x" $ \(x :: G) ->+          (x >>= vertex)       == x++    test "((x >>= f) >>= g)    == (x >>= (\\y -> (f y) >>= g))" $ mapSize (min 10) $ \(x :: G) (apply -> f) (apply -> g) ->+          ((x >>= f) >>= g)    == (x >>= (\(y :: Int) -> (f y) >>= (g :: Int -> G)))++    putStrLn $ "\n============ Graph.NonEmpty.toNonEmptyGraph ============"+    test "toNonEmptyGraph empty       == Nothing" $+          toNonEmptyGraph (G.empty :: G.Graph Int) == Nothing++    test "toNonEmptyGraph (toGraph x) == Just (x :: NonEmptyGraph a)" $ \x ->+          toNonEmptyGraph (C.toGraph x) == Just (x :: NonEmptyGraph Int)++    putStrLn $ "\n============ Graph.NonEmpty.vertex ============"+    test "hasVertex x (vertex x) == True" $ \(x :: Int) ->+          hasVertex x (vertex x) == True++    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->+          vertexCount (vertex x) == 1++    test "edgeCount   (vertex x) == 0" $ \(x :: Int) ->+          edgeCount   (vertex x) == 0++    test "size        (vertex x) == 1" $ \(x :: Int) ->+          size        (vertex x) == 1++    putStrLn $ "\n============ Graph.NonEmpty.edge ============"+    test "edge x y               == connect (vertex x) (vertex y)" $ \(x :: Int) y ->+          edge x y               == connect (vertex x) (vertex y)++    test "hasEdge x y (edge x y) == True" $ \(x :: Int) y ->+          hasEdge x y (edge x y) == True++    test "edgeCount   (edge x y) == 1" $ \(x :: Int) y ->+          edgeCount   (edge x y) == 1++    test "vertexCount (edge 1 1) == 1" $+          vertexCount (edge 1 1 :: G) == 1++    test "vertexCount (edge 1 2) == 2" $+          vertexCount (edge 1 2 :: G) == 2++    putStrLn $ "\n============ Graph.NonEmpty.overlay ============"+    test "hasVertex z (overlay x y) == hasVertex z x || hasVertex z y" $ \(x :: G) y z ->+          hasVertex z (overlay x y) == hasVertex z x || hasVertex z y++    test "vertexCount (overlay x y) >= vertexCount x" $ \(x :: G) y ->+          vertexCount (overlay x y) >= vertexCount x++    test "vertexCount (overlay x y) <= vertexCount x + vertexCount y" $ \(x :: G) y ->+          vertexCount (overlay x y) <= vertexCount x + vertexCount y++    test "edgeCount   (overlay x y) >= edgeCount x" $ \(x :: G) y ->+          edgeCount   (overlay x y) >= edgeCount x++    test "edgeCount   (overlay x y) <= edgeCount x   + edgeCount y" $ \(x :: G) y ->+          edgeCount   (overlay x y) <= edgeCount x   + edgeCount y++    test "size        (overlay x y) == size x        + size y" $ \(x :: G) y ->+          size        (overlay x y) == size x        + size y++    test "vertexCount (overlay 1 2) == 2" $+          vertexCount (overlay 1 2 :: G) == 2++    test "edgeCount   (overlay 1 2) == 0" $+          edgeCount   (overlay 1 2 :: G) == 0++    putStrLn $ "\n============ Graph.NonEmpty.overlay1 ============"+    test "               overlay1 empty x == x" $ \(x :: G) ->+                         overlay1 G.empty x == x++    test "x /= empty ==> overlay1 x     y == overlay (fromJust $ toNonEmptyGraph x) y" $ \(x :: G.Graph Int) (y :: G) ->+          x /= G.empty ==> overlay1 x   y == overlay (fromJust $ toNonEmptyGraph x) y+++    putStrLn $ "\n============ Graph.NonEmpty.connect ============"+    test "hasVertex z (connect x y) == hasVertex z x || hasVertex z y" $ \(x :: G) y z ->+          hasVertex z (connect x y) == hasVertex z x || hasVertex z y++    test "vertexCount (connect x y) >= vertexCount x" $ \(x :: G) y ->+          vertexCount (connect x y) >= vertexCount x++    test "vertexCount (connect x y) <= vertexCount x + vertexCount y" $ \(x :: G) y ->+          vertexCount (connect x y) <= vertexCount x + vertexCount y++    test "edgeCount   (connect x y) >= edgeCount x" $ \(x :: G) y ->+          edgeCount   (connect x y) >= edgeCount x++    test "edgeCount   (connect x y) >= edgeCount y" $ \(x :: G) y ->+          edgeCount   (connect x y) >= edgeCount y++    test "edgeCount   (connect x y) >= vertexCount x * vertexCount y" $ \(x :: G) y ->+          edgeCount   (connect x y) >= vertexCount x * vertexCount y++    test "edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y" $ \(x :: G) y ->+          edgeCount   (connect x y) <= vertexCount x * vertexCount y + edgeCount x + edgeCount y++    test "size        (connect x y) == size x        + size y" $ \(x :: G) y ->+          size        (connect x y) == size x        + size y++    test "vertexCount (connect 1 2) == 2" $+          vertexCount (connect 1 2 :: G) == 2++    test "edgeCount   (connect 1 2) == 1" $+          edgeCount   (connect 1 2 :: G) == 1++    putStrLn $ "\n============ Graph.NonEmpty.vertices1 ============"+    test "vertices1 (x :| [])     == vertex x" $ \(x :: Int) ->+          vertices1 (x :| [])     == vertex x++    test "hasVertex x . vertices1 == elem x" $ \(x :: Int) (xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (hasVertex x . vertices1) xs == elem x (NonEmpty.toList xs)++    test "vertexCount . vertices1 == length . nub" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (vertexCount . vertices1) xs == (NonEmpty.length . NonEmpty.nub) xs++    test "vertexSet   . vertices1 == Set.fromList . toList" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (vertexSet   . vertices1) xs == (Set.fromList . NonEmpty.toList) xs++    putStrLn $ "\n============ Graph.NonEmpty.edges1 ============"+    test "edges1 ((x,y) :| []) == edge x y" $ \(x :: Int) y ->+          edges1 ((x,y) :| []) == edge x y++    test "edgeCount . edges1   == length . nub" $ \(xs' :: NonEmptyList (Int, Int)) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (edgeCount . edges1) xs == (NonEmpty.length . NonEmpty.nub) xs++    putStrLn $ "\n============ Graph.NonEmpty.overlays1 ============"+    test "overlays1 (x :| [] ) == x" $ \(x :: G) ->+          overlays1 (x :| [] ) == x++    test "overlays1 (x :| [y]) == overlay x y" $ \(x :: G) y ->+          overlays1 (x :| [y]) == overlay x y++    putStrLn $ "\n============ Graph.NonEmpty.connects1 ============"+    test "connects1 (x :| [] ) == x" $ \(x :: G) ->+          connects1 (x :| [] ) == x++    test "connects1 (x :| [y]) == connect x y" $ \(x :: G) y ->+          connects1 (x :| [y]) == connect x y++    putStrLn $ "\n============ Graph.NonEmpty.foldg1 ============"+    test "foldg1 (const 1) (+)  (+)  == size" $ \(x :: G) ->+          foldg1 (const 1) (+)  (+) x == size x++    test "foldg1 (==x)     (||) (||) == hasVertex x" $ \(x :: Int) y ->+          foldg1 (==x)     (||) (||) y == hasVertex x y++    putStrLn $ "\n============ Graph.NonEmpty.isSubgraphOf ============"+    test "isSubgraphOf x             (overlay x y) == True" $ \(x :: G) y ->+          isSubgraphOf x             (overlay x y) == True++    test "isSubgraphOf (overlay x y) (connect x y) == True" $ \(x :: G) y ->+          isSubgraphOf (overlay x y) (connect x y) == True++    test "isSubgraphOf (path1 xs)    (circuit1 xs) == True" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in isSubgraphOf (path1 xs)    (circuit1 xs) == True++    putStrLn "\n============ Graph.NonEmpty.(===) ============"+    test "    x === x      == True" $ \(x :: G) ->+             (x === x)     == True++    test "x + y === x + y  == True" $ \(x :: G) y ->+         (x + y === x + y) == True++    test "1 + 2 === 2 + 1  == False" $+         (1 + 2 === 2 + (1 :: G)) == False++    test "x + y === x * y  == False" $ \(x :: G) y ->+         (x + y === x * y) == False++    putStrLn $ "\n============ Graph.NonEmpty.size ============"+    test "size (vertex x)    == 1" $ \(x :: Int) ->+          size (vertex x)    == 1++    test "size (overlay x y) == size x + size y" $ \(x :: G) y ->+          size (overlay x y) == size x + size y++    test "size (connect x y) == size x + size y" $ \(x :: G) y ->+          size (connect x y) == size x + size y++    test "size x             >= 1" $ \(x :: G) ->+          size x             >= 1++    test "size x             >= vertexCount x" $ \(x :: G) ->+          size x             >= vertexCount x++    putStrLn $ "\n============ Graph.NonEmpty.hasVertex ============"+    test "hasVertex x (vertex x) == True" $ \(x :: Int) ->+          hasVertex x (vertex x) == True++    test "hasVertex 1 (vertex 2) == False" $+          hasVertex 1 (vertex 2 :: G) == False++    putStrLn $ "\n============ Graph.NonEmpty.hasEdge ============"+    test "hasEdge x y (vertex z)       == False" $ \(x :: Int) y z ->+          hasEdge x y (vertex z)       == False++    test "hasEdge x y (edge x y)       == True" $ \(x :: Int) y ->+          hasEdge x y (edge x y)       == True++    test "hasEdge x y . removeEdge x y == const False" $ \(x :: Int) y z ->+         (hasEdge x y . removeEdge x y) z == False++    test "hasEdge x y                  == elem (x,y) . edgeList" $ \(x :: Int) y z -> do+        (u, v) <- elements ((x, y) : edgeList z)+        return $ hasEdge u v z == elem (u, v) (edgeList z)++    putStrLn $ "\n============ Graph.NonEmpty.vertexCount ============"+    test "vertexCount (vertex x) == 1" $ \(x :: Int) ->+          vertexCount (vertex x) == 1++    test "vertexCount x          >= 1" $ \(x :: G) ->+          vertexCount x          >= 1++    test "vertexCount            == length . vertexList1" $ \(x :: G) ->+          vertexCount x          == (NonEmpty.length . vertexList1) x++    putStrLn $ "\n============ Graph.NonEmpty.edgeCount ============"+    test "edgeCount (vertex x) == 0" $ \(x :: Int) ->+          edgeCount (vertex x) == 0++    test "edgeCount (edge x y) == 1" $ \(x :: Int) y ->+          edgeCount (edge x y) == 1++    test "edgeCount            == length . edgeList" $ \(x :: G) ->+          edgeCount x          == (length . edgeList) x++    putStrLn $ "\n============ Graph.NonEmpty.vertexList1 ============"+    test "vertexList1 (vertex x)  == x :| []" $ \(x :: Int) ->+          vertexList1 (vertex x)  == x :| []++    test "vertexList1 . vertices1 == nub . sort" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (vertexList1 . vertices1) xs == (NonEmpty.nub . NonEmpty.sort) xs++    putStrLn $ "\n============ Graph.NonEmpty.edgeList ============"+    test "edgeList (vertex x)     == []" $ \(x :: Int) ->+          edgeList (vertex x)     == []++    test "edgeList (edge x y)     == [(x,y)]" $ \(x :: Int) y ->+          edgeList (edge x y)     == [(x,y)]++    test "edgeList (star 2 [3,1]) == [(2,1), (2,3)]" $+          edgeList (star 2 [3,1]) == [(2,1), (2,3 :: Int)]++    test "edgeList . edges1       == nub . sort . toList" $ \(xs' :: NonEmptyList (Int, Int)) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (edgeList . edges1) xs   == (nubOrd . sort . NonEmpty.toList) xs++    test "edgeList . transpose    == sort . map swap . edgeList" $ \(x :: G) ->+         (edgeList . transpose) x == (sort . map swap . edgeList) x++    putStrLn $ "\n============ Graph.NonEmpty.vertexSet ============"+    test "vertexSet . vertex    == Set.singleton" $ \(x :: Int) ->+         (vertexSet . vertex) x == Set.singleton x++    test "vertexSet . vertices1 == Set.fromList . toList" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (vertexSet . vertices1) xs == (Set.fromList . NonEmpty.toList) xs++    test "vertexSet . clique1   == Set.fromList . toList" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (vertexSet . clique1) xs == (Set.fromList . NonEmpty.toList) xs++    putStrLn $ "\n============ Graph.NonEmpty.vertexIntSet ============"+    test "vertexIntSet . vertex    == IntSet.singleton" $ \(x :: Int) ->+         (vertexIntSet . vertex) x == IntSet.singleton x++    test "vertexIntSet . vertices1 == IntSet.fromList . toList" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (vertexIntSet . vertices1) xs == (IntSet.fromList . NonEmpty.toList) xs++    test "vertexIntSet . clique1   == IntSet.fromList . toList" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (vertexIntSet . clique1) xs == (IntSet.fromList . NonEmpty.toList) xs++    putStrLn $ "\n============ Graph.NonEmpty.edgeSet ============"+    test "edgeSet (vertex x) == Set.empty" $ \(x :: Int) ->+          edgeSet (vertex x) == Set.empty++    test "edgeSet (edge x y) == Set.singleton (x,y)" $ \(x :: Int) y ->+          edgeSet (edge x y) == Set.singleton (x,y)++    test "edgeSet . edges1   == Set.fromList . toList" $ \(xs' :: NonEmptyList (Int, Int)) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (edgeSet . edges1) xs == (Set.fromList . NonEmpty.toList) xs++    putStrLn $ "\n============ Graph.NonEmpty.path1 ============"+    test "path1 (x :| [] ) == vertex x" $ \(x :: Int) ->+          path1 (x :| [] ) == vertex x++    test "path1 (x :| [y]) == edge x y" $ \(x :: Int) y ->+          path1 (x :| [y]) == edge x y++    test "path1 . reverse  == transpose . path1" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (path1 . NonEmpty.reverse) xs == (transpose . path1) xs++    putStrLn $ "\n============ Graph.NonEmpty.circuit1 ============"+    test "circuit1 (x :| [] ) == edge x x" $ \(x :: Int) ->+          circuit1 (x :| [] ) == edge x x++    test "circuit1 (x :| [y]) == edges1 ((x,y) :| [(y,x)])" $ \(x :: Int) y ->+          circuit1 (x :| [y]) == edges1 ((x,y) :| [(y,x)])++    test "circuit1 . reverse  == transpose . circuit1" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (circuit1 . NonEmpty.reverse) xs == (transpose . circuit1) xs++    putStrLn $ "\n============ Graph.NonEmpty.clique1 ============"+    test "clique1 (x :| []   ) == vertex x" $ \(x :: Int) ->+          clique1 (x :| []   ) == vertex x++    test "clique1 (x :| [y]  ) == edge x y" $ \(x :: Int) y ->+          clique1 (x :| [y]  ) == edge x y++    test "clique1 (x :| [y,z]) == edges1 ((x,y) :| [(x,z), (y,z)])" $ \(x :: Int) y z ->+          clique1 (x :| [y,z]) == edges1 ((x,y) :| [(x,z), (y,z)])++    test "clique1 (xs <> ys)   == connect (clique1 xs) (clique1 ys)" $ \(xs' :: NonEmptyList Int) ys' ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+            ys = NonEmpty.fromList (getNonEmpty ys')+        in clique1 (xs <> ys)   == connect (clique1 xs) (clique1 ys)++    test "clique1 . reverse    == transpose . clique1" $ \(xs' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+        in (clique1 . NonEmpty.reverse) xs == (transpose . clique1) xs++    putStrLn $ "\n============ Graph.NonEmpty.biclique1 ============"+    test "biclique1 (x1 :| [x2]) (y1 :| [y2]) == edges1 ((x1,y1) :| [(x1,y2), (x2,y1), (x2,y2)])" $ \(x1 :: Int) x2 y1 y2 ->+          biclique1 (x1 :| [x2]) (y1 :| [y2]) == edges1 ((x1,y1) :| [(x1,y2), (x2,y1), (x2,y2)])++    test "biclique1 xs            ys          == connect (vertices1 xs) (vertices1 ys)" $ \(xs' :: NonEmptyList Int) ys' ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+            ys = NonEmpty.fromList (getNonEmpty ys')+        in biclique1 xs            ys          == connect (vertices1 xs) (vertices1 ys)++    putStrLn $ "\n============ Graph.NonEmpty.star ============"+    test "star x []    == vertex x" $ \(x :: Int) ->+          star x []    == vertex x++    test "star x [y]   == edge x y" $ \(x :: Int) y ->+          star x [y]   == edge x y++    test "star x [y,z] == edges1 ((x,y) :| [(x,z)])" $ \(x :: Int) y z ->+          star x [y,z] == edges1 ((x,y) :| [(x,z)])++    putStrLn $ "\n============ Graph.NonEmpty.starTranspose ============"+    test "starTranspose x []    == vertex x" $ \(x :: Int) ->+          starTranspose x []    == vertex x++    test "starTranspose x [y]   == edge y x" $ \(x :: Int) y ->+          starTranspose x [y]   == edge y x++    test "starTranspose x [y,z] == edges1 ((y,x) :| [(z,x)])" $ \(x :: Int) y z ->+          starTranspose x [y,z] == edges1 ((y,x) :| [(z,x)])++    test "starTranspose x ys    == transpose (star x ys)" $ \(x :: Int) ys ->+          starTranspose x ys    == transpose (star x ys)++    putStrLn $ "\n============ Graph.NonEmpty.tree ============"+    test "tree (Node x [])                                         == vertex x" $ \(x :: Int) ->+          tree (Node x [])                                         == vertex x++    test "tree (Node x [Node y [Node z []]])                       == path1 (x :| [y,z])" $ \(x :: Int) y z ->+          tree (Node x [Node y [Node z []]])                       == path1 (x :| [y,z])++    test "tree (Node x [Node y [], Node z []])                     == star x [y,z]" $ \(x :: Int) y z ->+          tree (Node x [Node y [], Node z []])                     == star x [y,z]++    test "tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges1 ((1,2) :| [(1,3), (3,4), (3,5)])" $+          tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == edges1 ((1,2) :| [(1,3), (3,4), (3,5 :: Int)])++    putStrLn $ "\n============ Graph.NonEmpty.mesh1 ============"+    test "mesh1 (x :| [])    (y :| [])    == vertex (x, y)" $ \(x :: Int) (y :: Int) ->+          mesh1 (x :| [])    (y :| [])    == vertex (x, y)++    test "mesh1 xs           ys           == box (path1 xs) (path1 ys)" $ \(xs' :: NonEmptyList Int) (ys' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+            ys = NonEmpty.fromList (getNonEmpty ys')+        in mesh1 xs           ys           == box (path1 xs) (path1 ys)++    test "mesh1 (1 :| [2,3]) ('a' :| \"b\") == <correct result>" $+          mesh1 (1 :| [2,3]) ('a' :| "b") == edges1 (NonEmpty.fromList [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a'))+                                                                      , ((1,'b'),(2,'b')), ((2,'a'),(2,'b'))+                                                                      , ((2,'a'),(3,'a')), ((2,'b'),(3,'b'))+                                                                      , ((3,'a'),(3 :: Int,'b')) ])++    putStrLn $ "\n============ Graph.NonEmpty.torus1 ============"+    test "torus1 (x :| [])  (y :| [])    == edge (x, y) (x, y)" $ \(x :: Int) (y :: Int) ->+          torus1 (x :| [])  (y :| [])    == edge (x, y) (x, y)++    test "torus1 xs         ys           == box (circuit1 xs) (circuit1 ys)" $ \(xs' :: NonEmptyList Int) (ys' :: NonEmptyList Int) ->+        let xs = NonEmpty.fromList (getNonEmpty xs')+            ys = NonEmpty.fromList (getNonEmpty ys')+        in torus1 xs         ys           == box (circuit1 xs) (circuit1 ys)++    test "torus1 (1 :| [2]) ('a' :| \"b\") == <correct result>" $+          torus1 (1 :| [2]) ('a' :| "b") == edges1 (NonEmpty.fromList [ ((1,'a'),(1,'b')), ((1,'a'),(2,'a'))+                                                   , ((1,'b'),(1,'a')), ((1,'b'),(2,'b'))+                                                   , ((2,'a'),(1,'a')), ((2,'a'),(2,'b'))+                                                   , ((2,'b'),(1,'b')), ((2,'b'),(2 :: Int,'a')) ])++    putStrLn $ "\n============ Graph.NonEmpty.removeVertex1 ============"+    test "removeVertex1 x (vertex x)          == Nothing" $ \(x :: Int) ->+          removeVertex1 x (vertex x)          == Nothing++    test "removeVertex1 1 (vertex 2)          == Just (vertex 2)" $+          removeVertex1 1 (vertex 2)          == Just (vertex 2 :: G)++    test "removeVertex1 x (edge x x)          == Nothing" $ \(x :: Int) ->+          removeVertex1 x (edge x x)          == Nothing++    test "removeVertex1 1 (edge 1 2)          == Just (vertex 2)" $+          removeVertex1 1 (edge 1 2)          == Just (vertex 2 :: G)++    test "removeVertex1 x >=> removeVertex1 x == removeVertex1 x" $ \(x :: Int) y ->+         (removeVertex1 x >=> removeVertex1 x) y == removeVertex1 x y++    putStrLn $ "\n============ Graph.NonEmpty.removeEdge ============"+    test "removeEdge x y (edge x y)       == vertices1 (x :| [y])" $ \(x :: Int) y ->+          removeEdge x y (edge x y)       == vertices1 (x :| [y])++    test "removeEdge x y . removeEdge x y == removeEdge x y" $ \(x :: Int) y z ->+         (removeEdge x y . removeEdge x y) z == removeEdge x y z++    test "removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * 2" $+          removeEdge 1 1 (1 * 1 * 2 * 2)  == 1 * 2 * (2 :: NonEmptyGraph Int)++    test "removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * 2" $+          removeEdge 1 2 (1 * 1 * 2 * 2)  == 1 * 1 + 2 * (2 :: NonEmptyGraph Int)++    test "size (removeEdge x y z)         <= 3 * size z" $ \(x :: Int) y z ->+          size (removeEdge x y z)         <= 3 * size z++    putStrLn $ "\n============ Graph.NonEmpty.replaceVertex ============"+    test "replaceVertex x x            == id" $ \(x :: Int) y ->+          replaceVertex x x y          == y++    test "replaceVertex x y (vertex x) == vertex y" $ \(x :: Int) y ->+          replaceVertex x y (vertex x) == vertex y++    test "replaceVertex x y            == mergeVertices (== x) y" $ \(x :: Int) y z ->+          replaceVertex x y z          == mergeVertices (== x) y z++    putStrLn $ "\n============ Graph.NonEmpty.mergeVertices ============"+    test "mergeVertices (const False) x    == id" $ \(x :: Int) y ->+          mergeVertices (const False) x y  == y++    test "mergeVertices (== x) y           == replaceVertex x y" $ \(x :: Int) y z ->+          mergeVertices (== x) y z         == replaceVertex x y z++    test "mergeVertices even 1 (0 * 2)     == 1 * 1" $+          mergeVertices even 1 (0 * 2)     == (1 * 1 :: G)++    test "mergeVertices odd  1 (3 + 4 * 5) == 4 * 1" $+          mergeVertices odd  1 (3 + 4 * 5) == (4 * 1 :: G)++    putStrLn $ "\n============ Graph.NonEmpty.splitVertex1 ============"+    test "splitVertex1 x (x :| [] )               == id" $ \x (y :: G) ->+          splitVertex1 x (x :| [] ) y             == y++    test "splitVertex1 x (y :| [] )               == replaceVertex x y" $ \x y (z :: G) ->+          splitVertex1 x (y :| [] ) z             == replaceVertex x y z++    test "splitVertex1 1 (0 :| [1]) $ 1 * (2 + 3) == (0 + 1) * (2 + 3)" $+          splitVertex1 1 (0 :| [1]) (1 * (2 + 3)) == (0 + 1) * (2 + 3 :: G)++    putStrLn $ "\n============ Graph.NonEmpty.transpose ============"+    test "transpose (vertex x)  == vertex x" $ \(x :: Int) ->+          transpose (vertex x)  == vertex x++    test "transpose (edge x y)  == edge y x" $ \(x :: Int) y ->+          transpose (edge x y)  == edge y x++    test "transpose . transpose == id" $ \(x :: G) ->+         (transpose . transpose) x == x++    test "transpose (box x y)   == box (transpose x) (transpose y)" $ mapSize (min 10) $ \(x :: G) (y :: G) ->+          transpose (box x y)   == box (transpose x) (transpose y)++    test "edgeList . transpose  == sort . map swap . edgeList" $ \(x :: G) ->+         (edgeList . transpose) x == (sort . map swap . edgeList) x++    putStrLn $ "\n============ Graph.NonEmpty.induce1 ============"+    test "induce1 (const True ) x == Just x" $ \(x :: G) ->+          induce1 (const True ) x == Just x++    test "induce1 (const False) x == Nothing" $ \(x :: G) ->+          induce1 (const False) x == Nothing++    test "induce1 (/= x)          == removeVertex1 x" $ \(x :: Int) y ->+          induce1 (/= x) y        == removeVertex1 x y++    test "induce1 p >=> induce1 q == induce1 (\\x -> p x && q x)" $ \(apply -> p) (apply -> q) (y :: G) ->+         (induce1 p >=> induce1 q) y == induce1 (\x -> p x && q x) y++    putStrLn $ "\n============ Graph.NonEmpty.simplify ============"+    test "simplify              == id" $ \(x :: G) ->+          simplify x            == x++    test "size (simplify x)     <= size x" $ \(x :: G) ->+          size (simplify x)     <= size x++    test "simplify 1           === 1" $+          simplify 1           === (1 :: G)++    test "simplify (1 + 1)     === 1" $+          simplify (1 + 1)     === (1 :: G)++    test "simplify (1 + 2 + 1) === 1 + 2" $+          simplify (1 + 2 + 1) === (1 + 2 :: G)++    test "simplify (1 * 1 * 1) === 1 * 1" $+          simplify (1 * 1 * 1) === (1 * 1 :: G)++    putStrLn "\n============ Graph.NonEmpty.box ============"+    let unit = fmap $ \(a, ()) -> a+        comm = fmap $ \(a,  b) -> (b, a)+    test "box x y               ~~ box y x" $ mapSize (min 10) $ \(x :: G) (y :: G) ->+          comm (box x y)        == box y x++    test "box x (overlay y z)   == overlay (box x y) (box x z)" $ mapSize (min 10) $ \(x :: G) (y :: G) z ->+          box x (overlay y z)   == overlay (box x y) (box x z)++    test "box x (vertex ())     ~~ x" $ mapSize (min 10) $ \(x :: G) ->+     unit(box x (vertex ()))    == x++    let assoc = fmap $ \(a, (b, c)) -> ((a, b), c)+    test "box x (box y z)       ~~ box (box x y) z" $ mapSize (min 5) $ \(x :: G) (y :: G) (z :: G) ->+      assoc (box x (box y z))   == box (box x y) z++    test "transpose   (box x y) == box (transpose x) (transpose y)" $ mapSize (min 10) $ \(x :: G) (y :: G) ->+          transpose   (box x y) == box (transpose x) (transpose y)++    test "vertexCount (box x y) == vertexCount x * vertexCount y" $ mapSize (min 10) $ \(x :: G) (y :: G) ->+          vertexCount (box x y) == vertexCount x * vertexCount y++    test "edgeCount   (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y" $ mapSize (min 10) $ \(x :: G) (y :: G) ->+          edgeCount   (box x y) <= vertexCount x * edgeCount y + edgeCount x * vertexCount y

@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module     : Algebra.Graph.Test.Relation--- Copyright  : (c) Andrey Mokhov 2016-2017+-- Copyright  : (c) Andrey Mokhov 2016-2018 -- License    : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability  : experimental@@ -36,7 +36,7 @@ testRelation :: IO () testRelation = do     putStrLn "\n============ Relation ============"-    test "Axioms of graphs" $ sizeLimit $ (axioms :: GraphTestsuite RI)+    test "Axioms of graphs" $ sizeLimit (axioms :: GraphTestsuite RI)      test "Consistency of arbitraryRelation" $ \(m :: RI) ->         consistent m@@ -100,7 +100,7 @@           transitiveClosure (vertex x)      == vertex x      test "transitiveClosure (path $ nub xs) == clique (nub $ xs)" $ \(xs :: [Int]) ->-          transitiveClosure (path $ nubOrd xs) == clique (nubOrd $ xs)+          transitiveClosure (path $ nubOrd xs) == clique (nubOrd xs)      putStrLn "\n============ Relation.preorderClosure ============"     test "preorderClosure empty           == empty" $@@ -122,7 +122,7 @@      putStrLn "\n============ SymmetricRelation.neighbours ============"     test "neighbours x empty      == Set.empty" $ \(x :: Int) ->-          neighbours x C.empty      == Set.empty+          neighbours x C.empty    == Set.empty      test "neighbours x (vertex x) == Set.empty" $ \(x :: Int) ->           neighbours x (C.vertex x) == Set.empty

@@ -3,6 +3,8 @@ import Algebra.Graph.Test.Fold import Algebra.Graph.Test.Graph import Algebra.Graph.Test.IntAdjacencyMap+import Algebra.Graph.Test.Internal+import Algebra.Graph.Test.NonEmptyGraph import Algebra.Graph.Test.Relation  main :: IO ()@@ -11,5 +13,7 @@     testExport     testFold     testGraph+    testGraphNonEmpty     testIntAdjacencyMap+    testInternal     testRelation