diff --git a/algebraic-graphs.cabal b/algebraic-graphs.cabal index ab6f3fa6a..a015d9358 100644 --- a/algebraic-graphs.cabal +++ b/algebraic-graphs.cabal @@ -49,9 +49,7 @@ description: and - can be used for polymorphic construction and manipulation of graphs. Also see - - that defines the Boehm-Berarducci encoding of algebraic graphs. + can be used for polymorphic construction and manipulation of graphs. . 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 @@ -77,7 +75,6 @@ library Algebra.Graph.Class, Algebra.Graph.Export, Algebra.Graph.Export.Dot, - Algebra.Graph.Fold, Algebra.Graph.HigherKinded.Class, Algebra.Graph.Internal, Algebra.Graph.Label, @@ -137,7 +134,6 @@ test-suite test-alga Algebra.Graph.Test.AdjacencyMap, Algebra.Graph.Test.Arbitrary, Algebra.Graph.Test.Export, - Algebra.Graph.Test.Fold, Algebra.Graph.Test.Generic, Algebra.Graph.Test.Graph, Algebra.Graph.Test.Internal, diff --git a/src/Algebra/Graph/Class.hs b/src/Algebra/Graph/Class.hs index f6a83eec9..505a36d51 100644 --- a/src/Algebra/Graph/Class.hs +++ b/src/Algebra/Graph/Class.hs @@ -15,8 +15,7 @@ -- implemented fully polymorphically and require the use of an intermediate data -- type are not included. For example, to compute the number of vertices in a -- 'Graph' expression you will need to use a concrete data type, such as --- "Algebra.Graph.Fold". Other useful 'Graph' instances are defined in --- "Algebra.Graph", "Algebra.Graph.AdjacencyMap" and "Algebra.Graph.Relation". +-- "Algebra.Graph.Graph" or "Algebra.Graph.AdjacencyMap". -- -- See "Algebra.Graph.HigherKinded.Class" for the higher-kinded version of the -- core graph type class. @@ -58,7 +57,6 @@ import qualified Algebra.Graph as G import qualified Algebra.Graph.AdjacencyMap as AM import qualified Algebra.Graph.Labelled as LG import qualified Algebra.Graph.Labelled.AdjacencyMap as LAM -import qualified Algebra.Graph.Fold as F import qualified Algebra.Graph.AdjacencyIntMap as AIM import qualified Algebra.Graph.Relation as R import qualified Algebra.Graph.Relation.Symmetric as RS @@ -136,13 +134,6 @@ instance Ord a => Graph (AM.AdjacencyMap a) where overlay = AM.overlay connect = AM.connect -instance Graph (F.Fold a) where - type Vertex (F.Fold a) = a - empty = F.empty - vertex = F.vertex - overlay = F.overlay - connect = F.connect - instance Graph AIM.AdjacencyIntMap where type Vertex AIM.AdjacencyIntMap = Int empty = AIM.empty diff --git a/src/Algebra/Graph/Fold.hs b/src/Algebra/Graph/Fold.hs deleted file mode 100644 index 0eac9c3b5..000000000 --- a/src/Algebra/Graph/Fold.hs +++ /dev/null @@ -1,736 +0,0 @@ -{-# LANGUAGE RankNTypes #-} ------------------------------------------------------------------------------ --- | --- Module : Algebra.Graph.Fold --- 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 for the --- motivation behind the library, the underlying theory, and implementation details. --- --- This module defines the 'Fold' data type -- the Boehm-Berarducci encoding of --- algebraic graphs, which is used for generalised graph folding and for the --- implementation of polymorphic graph construction and transformation algorithms. --- 'Fold' is an instance of type classes defined in modules "Algebra.Graph.Class" --- and "Algebra.Graph.HigherKinded.Class", which can be used for polymorphic --- graph construction and manipulation. ------------------------------------------------------------------------------ -module Algebra.Graph.Fold ( - -- * Boehm-Berarducci encoding of algebraic graphs - Fold, - - -- * Basic graph construction primitives - empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects, - - -- * Graph folding - foldg, - - -- * Relations on graphs - isSubgraphOf, - - -- * Graph properties - isEmpty, size, hasVertex, hasEdge, vertexCount, edgeCount, vertexList, - edgeList, vertexSet, edgeSet, adjacencyList, - - -- * Standard families of graphs - path, circuit, clique, biclique, star, stars, - - -- * Graph transformation - removeVertex, removeEdge, transpose, induce, simplify, - ) where - -import Prelude () -import Prelude.Compat - -import Control.Applicative (Alternative) -import Control.Monad.Compat (MonadPlus (..), ap) -import Data.Function - -import Control.DeepSeq (NFData (..)) - -import Algebra.Graph.ToGraph (ToGraph, ToVertex, toGraph) - -import qualified Algebra.Graph as G -import qualified Algebra.Graph.AdjacencyMap as AM -import qualified Algebra.Graph.ToGraph as T -import qualified Control.Applicative as Ap -import qualified Data.Set as Set - -{-| 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: - - > 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:__ the 'Num' instance does not satisfy several "customary laws" of 'Num', -which dictate that 'fromInteger' @0@ and 'fromInteger' @1@ should act as -additive and multiplicative identities, and 'negate' as additive inverse. -Nevertheless, overloading 'fromInteger', '+' and '*' is very convenient when -working with algebraic graphs; we hope that in future Haskell's Prelude will -provide a more fine-grained class hierarchy for algebraic structures, which we -would be able to utilise without violating any laws. - -The 'Show' instance is defined using basic graph construction primitives: - -@show (empty :: Fold Int) == "empty" -show (1 :: Fold Int) == "vertex 1" -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) == "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: - - * 'overlay' is commutative and associative: - - > x + y == y + x - > x + (y + z) == (x + y) + z - - * 'connect' is associative and has 'empty' as the identity: - - > x * empty == x - > empty * x == x - > 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 - -The following useful theorems can be proved from the above set of axioms. - - * 'overlay' has 'empty' as the identity and is idempotent: - - > x + empty == x - > empty + x == x - > x + x == x - - * Absorption and saturation of 'connect': - - > 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 -graph expression. For example, if g is a 'Fold' then /n/, /m/ and /s/ can be -computed as follows: - -@n == 'vertexCount' g -m == 'edgeCount' g -s == 'size' g@ - -Note that 'size' counts all leaves of the expression: - -@'vertexCount' 'empty' == 0 -'size' 'empty' == 1 -'vertexCount' ('vertex' x) == 1 -'size' ('vertex' x) == 1 -'vertexCount' ('empty' + 'empty') == 0 -'size' ('empty' + 'empty') == 2@ - -Converting a 'Fold' 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. - -The total order on graphs is defined using /size-lexicographic/ comparison: - -* Compare the number of vertices. In case of a tie, continue. -* Compare the sets of vertices. In case of a tie, continue. -* Compare the number of edges. In case of a tie, continue. -* Compare the sets of edges. - -Here are a few examples: - -@'vertex' 1 < 'vertex' 2 -'vertex' 3 < 'edge' 1 2 -'vertex' 1 < 'edge' 1 1 -'edge' 1 1 < 'edge' 1 2 -'edge' 1 2 < 'edge' 1 1 + 'edge' 2 2 -'edge' 1 2 < 'edge' 1 3@ - -Note that the resulting order refines the 'isSubgraphOf' relation and is -compatible with 'overlay' and 'connect' operations: - -@'isSubgraphOf' x y ==> x <= y@ - -@'empty' <= x -x <= x + y -x + y <= x * y@ --} -newtype Fold a = Fold { runFold :: forall b. b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> b } - -instance (Ord a, Show a) => Show (Fold a) where - showsPrec p = showsPrec p . foldg AM.empty AM.vertex AM.overlay AM.connect - -instance Ord a => Eq (Fold a) where - x == y = T.toAdjacencyMap x == T.toAdjacencyMap y - -instance Ord a => Ord (Fold a) where - compare x y = compare (T.toAdjacencyMap x) (T.toAdjacencyMap y) - -instance NFData a => NFData (Fold a) where - rnf = foldg () rnf seq seq - --- | __Note:__ this does not satisfy the usual ring laws; see 'Fold' for more --- details. -instance Num a => Num (Fold a) where - fromInteger = vertex . fromInteger - (+) = overlay - (*) = connect - signum = const empty - abs = id - negate = id - -instance Functor Fold where - fmap f = foldg empty (vertex . f) overlay connect - -instance Applicative Fold where - pure = vertex - (<*>) = ap - -instance Alternative Fold where - empty = empty - (<|>) = overlay - -instance MonadPlus Fold where - mzero = empty - mplus = overlay - -instance Monad Fold where - return = vertex - g >>=f = foldg empty f overlay connect g - -instance ToGraph (Fold a) where - type ToVertex (Fold a) = a - foldg = foldg - --- | Construct the /empty graph/. --- Complexity: /O(1)/ time, memory and size. --- --- @ --- 'isEmpty' empty == True --- 'hasVertex' x empty == False --- 'vertexCount' empty == 0 --- 'edgeCount' empty == 0 --- 'size' empty == 1 --- @ -empty :: Fold a -empty = Fold $ \e _ _ _ -> e -{-# NOINLINE [1] empty #-} - --- | Construct the graph comprising /a single isolated vertex/. --- Complexity: /O(1)/ time, memory and size. --- --- @ --- 'isEmpty' (vertex x) == False --- 'hasVertex' x (vertex x) == True --- 'vertexCount' (vertex x) == 1 --- 'edgeCount' (vertex x) == 0 --- 'size' (vertex x) == 1 --- @ -vertex :: a -> Fold a -vertex x = Fold $ \_ v _ _ -> v x -{-# NOINLINE [1] 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 -> Fold a -edge x y = Fold $ \_ v _ c -> v x `c` v y - --- | /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. --- --- @ --- 'isEmpty' (overlay x y) == 'isEmpty' x && 'isEmpty' y --- '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 :: Fold a -> Fold a -> Fold a -overlay x y = Fold $ \e v o c -> runFold x e v o c `o` runFold y e v o c -{-# NOINLINE [1] overlay #-} - --- | /Connect/ two graphs. This is an 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)/. --- --- @ --- 'isEmpty' (connect x y) == 'isEmpty' x && 'isEmpty' y --- '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 :: Fold a -> Fold a -> Fold a -connect x y = Fold $ \e v o c -> runFold x e v o c `c` runFold y e v o c -{-# NOINLINE [1] 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. --- --- @ --- vertices [] == 'empty' --- vertices [x] == 'vertex' x --- 'hasVertex' x . vertices == 'elem' x --- 'vertexCount' . vertices == 'length' . 'Data.List.nub' --- 'vertexSet' . vertices == Set.'Set.fromList' --- @ -vertices :: [a] -> Fold a -vertices = overlays . map vertex -{-# NOINLINE [1] vertices #-} - --- | Construct the graph from a list of edges. --- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the --- given list. --- --- @ --- edges [] == 'empty' --- edges [(x,y)] == 'edge' x y --- 'edgeCount' . edges == 'length' . 'Data.List.nub' --- @ -edges :: [(a, a)] -> Fold a -edges es = Fold $ \e v o c -> foldr (flip o . uncurry (c `on` v)) e es - --- | 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. --- --- @ --- overlays [] == 'empty' --- overlays [x] == x --- overlays [x,y] == 'overlay' x y --- overlays == 'foldr' 'overlay' 'empty' --- 'isEmpty' . overlays == 'all' 'isEmpty' --- @ -overlays :: [Fold a] -> Fold a -overlays = foldr overlay empty -{-# INLINE [2] overlays #-} - --- | 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. --- --- @ --- connects [] == 'empty' --- connects [x] == x --- connects [x,y] == 'connect' x y --- connects == 'foldr' 'connect' 'empty' --- 'isEmpty' . connects == 'all' 'isEmpty' --- @ -connects :: [Fold a] -> Fold a -connects = foldr connect empty -{-# INLINE [2] connects #-} - --- | 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. --- Complexity: /O(s)/ applications of given functions. As an example, the --- complexity of 'size' is /O(s)/, since all functions have cost /O(1)/. --- --- @ --- foldg 'empty' 'vertex' 'overlay' 'connect' == id --- foldg 'empty' 'vertex' 'overlay' ('flip' 'connect') == 'transpose' --- foldg 1 ('const' 1) (+) (+) == 'size' --- foldg True ('const' False) (&&) (&&) == 'isEmpty' --- foldg False (== x) (||) (||) == 'hasVertex' x --- @ -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 - --- | 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 'empty' x == True --- isSubgraphOf ('vertex' x) 'empty' == False --- isSubgraphOf x ('overlay' x y) == True --- isSubgraphOf ('overlay' x y) ('connect' x y) == True --- isSubgraphOf ('path' xs) ('circuit' xs) == True --- isSubgraphOf x y ==> x <= y --- @ -isSubgraphOf :: Ord a => Fold a -> Fold a -> Bool -isSubgraphOf x y = overlay x y == y - --- | Check if a graph is empty. A convenient alias for 'null'. --- Complexity: /O(s)/ time. --- --- @ --- isEmpty 'empty' == True --- isEmpty ('overlay' 'empty' 'empty') == True --- isEmpty ('vertex' x) == False --- isEmpty ('removeVertex' x $ 'vertex' x) == True --- isEmpty ('removeEdge' x y $ 'edge' x y) == False --- @ -isEmpty :: Fold a -> Bool -isEmpty = T.isEmpty - --- | The /size/ of a graph, i.e. the number of leaves of the expression --- including 'empty' leaves. --- Complexity: /O(s)/ time. --- --- @ --- size 'empty' == 1 --- 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 :: Fold a -> Int -size = T.size - --- | Check if a graph contains a given vertex. --- Complexity: /O(s)/ time. --- --- @ --- 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 -hasVertex = T.hasVertex - --- | Check if a graph contains a given edge. --- Complexity: /O(s)/ time. --- --- @ --- hasEdge x y 'empty' == False --- 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 :: Eq a => a -> a -> Fold a -> Bool -hasEdge = T.hasEdge - --- | The number of vertices in a graph. --- Complexity: /O(s * log(n))/ time. --- --- @ --- vertexCount 'empty' == 0 --- vertexCount ('vertex' x) == 1 --- vertexCount == 'length' . 'vertexList' --- vertexCount x \< vertexCount y ==> x \< y --- @ -vertexCount :: Ord a => Fold a -> Int -vertexCount = T.vertexCount - --- | 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 'empty' == 0 --- edgeCount ('vertex' x) == 0 --- edgeCount ('edge' x y) == 1 --- edgeCount == 'length' . 'edgeList' --- @ -edgeCount :: Ord a => Fold a -> Int -edgeCount = T.edgeCount - --- | The sorted list of vertices of a given graph. --- Complexity: /O(s * log(n))/ time and /O(n)/ memory. --- --- @ --- vertexList 'empty' == [] --- vertexList ('vertex' x) == [x] --- vertexList . 'vertices' == 'Data.List.nub' . 'Data.List.sort' --- @ -vertexList :: Ord a => Fold a -> [a] -vertexList = T.vertexList - --- | 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 'empty' == [] --- edgeList ('vertex' x) == [] --- edgeList ('edge' x y) == [(x,y)] --- edgeList ('star' 2 [3,1]) == [(2,1), (2,3)] --- edgeList . 'edges' == 'Data.List.nub' . 'Data.List.sort' --- edgeList . 'transpose' == 'Data.List.sort' . 'map' 'Data.Tuple.swap' . edgeList --- @ -edgeList :: Ord a => Fold a -> [(a, a)] -edgeList = T.edgeList - --- | The set of vertices of a given graph. --- Complexity: /O(s * log(n))/ time and /O(n)/ memory. --- --- @ --- vertexSet 'empty' == Set.'Set.empty' --- vertexSet . 'vertex' == Set.'Set.singleton' --- vertexSet . 'vertices' == Set.'Set.fromList' --- @ -vertexSet :: Ord a => Fold a -> Set.Set a -vertexSet = T.vertexSet - --- | The set of edges of a given graph. --- Complexity: /O(s * log(m))/ time and /O(m)/ memory. --- --- @ --- edgeSet 'empty' == Set.'Set.empty' --- edgeSet ('vertex' x) == Set.'Set.empty' --- edgeSet ('edge' x y) == Set.'Set.singleton' (x,y) --- edgeSet . 'edges' == Set.'Set.fromList' --- @ -edgeSet :: Ord a => Fold a -> Set.Set (a, a) -edgeSet = T.edgeSet - --- | The sorted /adjacency list/ of 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/. --- --- @ --- adjacencyList 'empty' == [] --- adjacencyList ('vertex' x) == [(x, [])] --- adjacencyList ('edge' 1 2) == [(1, [2]), (2, [])] --- adjacencyList ('star' 2 [3,1]) == [(1, []), (2, [1,3]), (3, [])] --- 'stars' . adjacencyList == id --- @ -adjacencyList :: Ord a => Fold a -> [(a, [a])] -adjacencyList = T.adjacencyList - --- | The /path/ on a list of vertices. --- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the --- given list. --- --- @ --- path [] == 'empty' --- path [x] == 'vertex' x --- path [x,y] == 'edge' x y --- path . 'reverse' == 'transpose' . path --- @ -path :: [a] -> Fold a -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 --- given list. --- --- @ --- circuit [] == 'empty' --- circuit [x] == 'edge' x x --- circuit [x,y] == 'edges' [(x,y), (y,x)] --- circuit . 'reverse' == 'transpose' . circuit --- @ -circuit :: [a] -> Fold a -circuit [] = empty -circuit (x:xs) = path $ [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. --- --- @ --- clique [] == 'empty' --- clique [x] == 'vertex' x --- clique [x,y] == 'edge' x y --- clique [x,y,z] == 'edges' [(x,y), (x,z), (y,z)] --- clique (xs ++ ys) == 'connect' (clique xs) (clique ys) --- clique . 'reverse' == 'transpose' . clique --- @ -clique :: [a] -> Fold a -clique = connects . map vertex -{-# NOINLINE [1] clique #-} - --- | 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. --- --- @ --- biclique [] [] == 'empty' --- biclique [x] [] == 'vertex' x --- biclique [] [y] == 'vertex' y --- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] --- biclique xs ys == 'connect' ('vertices' xs) ('vertices' ys) --- @ -biclique :: [a] -> [a] -> Fold a -biclique xs [] = vertices xs -biclique [] ys = vertices ys -biclique xs ys = connect (vertices xs) (vertices 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] == 'edges' [(x,y), (x,z)] --- star x ys == 'connect' ('vertex' x) ('vertices' ys) --- @ -star :: a -> [a] -> Fold a -star x [] = vertex x -star x ys = connect (vertex x) (vertices ys) -{-# INLINE star #-} - --- | The /stars/ formed by overlaying a list of 'star's. An inverse of --- 'adjacencyList'. --- Complexity: /O(L)/ time, memory and size, where /L/ is the total size of the --- input. --- --- @ --- stars [] == 'empty' --- stars [(x, [])] == 'vertex' x --- stars [(x, [y])] == 'edge' x y --- stars [(x, ys)] == 'star' x ys --- stars == 'overlays' . 'map' ('uncurry' 'star') --- stars . 'adjacencyList' == id --- 'overlay' (stars xs) (stars ys) == stars (xs ++ ys) --- @ -stars :: [(a, [a])] -> Fold a -stars = overlays . map (uncurry star) -{-# INLINE stars #-} - --- | Remove a vertex from a given graph. --- Complexity: /O(s)/ time, memory and size. --- --- @ --- 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 -> Fold a -> Fold a -removeVertex v = induce (/= v) - --- | Remove an edge from a given graph. --- 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 . '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 -> Fold a -> Fold a -removeEdge s t = filterContext s (/=s) (/=t) - --- TODO: Export --- Filter vertices in a subgraph context. -filterContext :: Eq a => a -> (a -> Bool) -> (a -> Bool) -> Fold a -> Fold a -filterContext s i o g = maybe g go $ G.context (==s) (toGraph g) - where - go (G.Context is os) = induce (/=s) g `overlay` transpose (star s (filter i is)) - `overlay` star s (filter o os) - --- | Transpose a given graph. --- Complexity: /O(s)/ time, memory and size. --- --- @ --- transpose 'empty' == 'empty' --- 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 :: Fold a -> Fold a -transpose = foldg empty vertex overlay (flip connect) -{-# NOINLINE [1] transpose #-} - -{-# RULES -"transpose/empty" transpose empty = empty -"transpose/vertex" forall x. transpose (vertex x) = vertex x -"transpose/overlay" forall g1 g2. transpose (overlay g1 g2) = overlay (transpose g1) (transpose g2) -"transpose/connect" forall g1 g2. transpose (connect g1 g2) = connect (transpose g2) (transpose g1) - -"transpose/overlays" forall xs. transpose (overlays xs) = overlays (map transpose xs) -"transpose/connects" forall xs. transpose (connects xs) = connects (reverse (map transpose xs)) - -"transpose/vertices" forall xs. transpose (vertices xs) = vertices xs -"transpose/clique" forall xs. transpose (clique xs) = clique (reverse xs) - #-} - --- | Construct the /induced subgraph/ of a given graph by removing the --- vertices that do not satisfy a given predicate. --- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes --- /O(1)/ to be evaluated. --- --- @ --- induce ('const' True ) x == x --- induce ('const' False) x == 'empty' --- induce (/= x) == 'removeVertex' x --- induce p . induce q == induce (\\x -> p x && q x) --- 'isSubgraphOf' (induce p x) x == True --- @ -induce :: (a -> Bool) -> Fold a -> Fold a -induce p = 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 --- 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. --- Below the operator @~>@ denotes the /is simplified to/ relation. --- --- @ --- simplify == id --- 'size' (simplify x) <= 'size' x --- simplify 'empty' ~> 'empty' --- simplify 1 ~> 1 --- simplify (1 + 1) ~> 1 --- simplify (1 + 2 + 1) ~> 1 + 2 --- simplify (1 * 1 * 1) ~> 1 * 1 --- @ -simplify :: Ord a => Fold a -> Fold a -simplify = foldg empty 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 diff --git a/src/Algebra/Graph/HigherKinded/Class.hs b/src/Algebra/Graph/HigherKinded/Class.hs index 736e207d7..d3afe529a 100644 --- a/src/Algebra/Graph/HigherKinded/Class.hs +++ b/src/Algebra/Graph/HigherKinded/Class.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.HigherKinded.Class --- Copyright : (c) Andrey Mokhov 2016-2018 +-- Copyright : (c) Andrey Mokhov 2016-2019 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental @@ -59,8 +59,7 @@ import Control.Applicative (Alternative(empty, (<|>))) import Control.Monad.Compat (MonadPlus, mfilter) import Data.Tree -import qualified Algebra.Graph as G -import qualified Algebra.Graph.Fold as F +import qualified Algebra.Graph as G {-| The core type class for constructing algebraic graphs is defined by introducing @@ -128,9 +127,6 @@ class MonadPlus g => Graph g where instance Graph G.Graph where connect = G.connect -instance Graph F.Fold where - connect = F.connect - -- | Construct the graph comprising a single isolated vertex. An alias for 'pure'. vertex :: Graph g => a -> g a vertex = pure diff --git a/src/Algebra/Graph/ToGraph.hs b/src/Algebra/Graph/ToGraph.hs index 1c772bdeb..03f27b46c 100644 --- a/src/Algebra/Graph/ToGraph.hs +++ b/src/Algebra/Graph/ToGraph.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.ToGraph --- Copyright : (c) Andrey Mokhov 2016-2018 +-- Copyright : (c) Andrey Mokhov 2016-2019 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental @@ -41,7 +41,13 @@ -- of 'foldMap' and 'Data.Foldable.toList' violate this requirement, for example -- @[1] ++ [1] /= [1]@, and are therefore disallowed. ----------------------------------------------------------------------------- -module Algebra.Graph.ToGraph (ToGraph (..)) where +module Algebra.Graph.ToGraph ( + -- * Type class + ToGraph (..), + + -- * Derived functions + adjacencyMap, adjacencyIntMap, adjacencyMapTranspose, adjacencyIntMapTranspose + ) where import Prelude () import Prelude.Compat @@ -104,19 +110,6 @@ class ToGraph t where isEmpty :: t -> Bool isEmpty = foldg True (const False) (&&) (&&) - -- | The /size/ of a graph, i.e. the number of leaves of the expression - -- including 'empty' leaves. - -- - -- __Note:__ The default implementation of this function violates the - -- requirement that the four arguments of 'foldg' should satisfy the laws - -- of algebraic graphs, since @1 + 1 /= 1@. Use this function with care. - -- - -- @ - -- size == 'foldg' 1 ('const' 1) (+) (+) - -- @ - size :: t -> Int - size = foldg 1 (const 1) (+) (+) - -- | Check if a graph contains a given vertex. -- -- @ @@ -234,44 +227,6 @@ class ToGraph t where adjacencyList :: Ord (ToVertex t) => t -> [(ToVertex t, [ToVertex t])] adjacencyList = AM.adjacencyList . toAdjacencyMap - -- | The /adjacency map/ of a graph: each vertex is associated with a set - -- of its /direct successors/. - -- - -- @ - -- adjacencyMap == Algebra.Graph.AdjacencyMap.'Algebra.Graph.AdjacencyMap.adjacencyMap' . 'toAdjacencyMap' - -- @ - adjacencyMap :: Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t)) - adjacencyMap = AM.adjacencyMap . toAdjacencyMap - - -- | The /adjacency map/ of a graph: each vertex is associated with a set - -- of its /direct successors/. Like 'adjacencyMap' but specialised for - -- graphs with vertices of type 'Int'. - -- - -- @ - -- adjacencyIntMap == Algebra.Graph.AdjacencyIntMap.'Algebra.Graph.AdjacencyIntMap.adjacencyIntMap' . 'toAdjacencyIntMap' - -- @ - adjacencyIntMap :: ToVertex t ~ Int => t -> IntMap IntSet - adjacencyIntMap = AIM.adjacencyIntMap . toAdjacencyIntMap - - -- | The transposed /adjacency map/ of a graph: each vertex is associated - -- with a set of its /direct predecessors/. - -- - -- @ - -- adjacencyMapTranspose == Algebra.Graph.AdjacencyMap.'Algebra.Graph.AdjacencyMap.adjacencyMap' . 'toAdjacencyMapTranspose' - -- @ - adjacencyMapTranspose :: Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t)) - adjacencyMapTranspose = AM.adjacencyMap . toAdjacencyMapTranspose - - -- | The transposed /adjacency map/ of a graph: each vertex is associated - -- with a set of its /direct predecessors/. Like 'adjacencyMapTranspose' but - -- specialised for graphs with vertices of type 'Int'. - -- - -- @ - -- adjacencyIntMapTranspose == Algebra.Graph.AdjacencyIntMap.'Algebra.Graph.AdjacencyIntMap.adjacencyIntMap' . 'toAdjacencyIntMapTranspose' - -- @ - adjacencyIntMapTranspose :: ToVertex t ~ Int => t -> IntMap IntSet - adjacencyIntMapTranspose = AIM.adjacencyIntMap . toAdjacencyIntMapTranspose - -- | Compute the /depth-first search/ forest of a graph that corresponds to -- searching from each of the graph vertices in the 'Ord' @a@ order. -- @@ -405,11 +360,6 @@ instance Ord a => ToGraph (AM.AdjacencyMap a) where adjacencyList = AM.adjacencyList preSet = AM.preSet postSet = AM.postSet - adjacencyMap = AM.adjacencyMap - adjacencyIntMap = IntMap.fromAscList - . map (fmap $ IntSet.fromAscList . Set.toAscList) - . Map.toAscList - . AM.adjacencyMap dfsForest = AM.dfsForest dfsForestFrom = AM.dfsForestFrom dfs = AM.dfs @@ -417,7 +367,11 @@ instance Ord a => ToGraph (AM.AdjacencyMap a) where topSort = AM.topSort isAcyclic = AM.isAcyclic toAdjacencyMap = id - toAdjacencyIntMap = AIM.AM . adjacencyIntMap + toAdjacencyIntMap = AIM.AM + . IntMap.fromAscList + . map (fmap $ IntSet.fromAscList . Set.toAscList) + . Map.toAscList + . AM.adjacencyMap toAdjacencyMapTranspose = AM.transpose . toAdjacencyMap toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap isDfsForestOf = AM.isDfsForestOf @@ -442,18 +396,17 @@ instance ToGraph AIM.AdjacencyIntMap where adjacencyList = AIM.adjacencyList preIntSet = AIM.preIntSet postIntSet = AIM.postIntSet - adjacencyMap = Map.fromAscList - . map (fmap $ Set.fromAscList . IntSet.toAscList) - . IntMap.toAscList - . AIM.adjacencyIntMap dfsForest = AIM.dfsForest dfsForestFrom = AIM.dfsForestFrom dfs = AIM.dfs reachable = AIM.reachable topSort = AIM.topSort isAcyclic = AIM.isAcyclic - adjacencyIntMap = AIM.adjacencyIntMap - toAdjacencyMap = AM.AM . adjacencyMap + toAdjacencyMap = AM.AM + . Map.fromAscList + . map (fmap $ Set.fromAscList . IntSet.toAscList) + . IntMap.toAscList + . AIM.adjacencyIntMap toAdjacencyIntMap = id toAdjacencyMapTranspose = AM.transpose . toAdjacencyMap toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap @@ -513,8 +466,6 @@ instance Ord a => ToGraph (NAM.AdjacencyMap a) where adjacencyList = adjacencyList . NAM.am preSet = NAM.preSet postSet = NAM.postSet - adjacencyMap = adjacencyMap . NAM.am - adjacencyIntMap = adjacencyIntMap . NAM.am dfsForest = dfsForest . NAM.am dfsForestFrom xs = dfsForestFrom xs . NAM.am dfs xs = dfs xs . NAM.am @@ -545,14 +496,14 @@ instance Ord a => ToGraph (R.Relation a) where edgeList = R.edgeList edgeSet = R.edgeSet adjacencyList = R.adjacencyList - adjacencyMap = Map.fromAscList + toAdjacencyMap = AM.AM + . Map.fromAscList . map (fmap Set.fromAscList) . R.adjacencyList - adjacencyIntMap = IntMap.fromAscList + toAdjacencyIntMap = AIM.AM + . IntMap.fromAscList . map (fmap IntSet.fromAscList) . R.adjacencyList - toAdjacencyMap = AM.AM . adjacencyMap - toAdjacencyIntMap = AIM.AM . adjacencyIntMap toAdjacencyMapTranspose = AM.transpose . toAdjacencyMap toAdjacencyIntMapTranspose = AIM.transpose . toAdjacencyIntMap @@ -574,9 +525,45 @@ instance Ord a => ToGraph (SR.Relation a) where edgeList = SR.edgeList edgeSet = SR.edgeSet adjacencyList = SR.adjacencyList - adjacencyMap = adjacencyMap . SR.fromSymmetric - adjacencyIntMap = adjacencyIntMap . SR.fromSymmetric - toAdjacencyMap = AM.AM . adjacencyMap - toAdjacencyIntMap = AIM.AM . adjacencyIntMap + toAdjacencyMap = AM.AM . adjacencyMap . SR.fromSymmetric + toAdjacencyIntMap = AIM.AM . adjacencyIntMap . SR.fromSymmetric toAdjacencyMapTranspose = toAdjacencyMap toAdjacencyIntMapTranspose = toAdjacencyIntMap + +-- | The /adjacency map/ of a graph: each vertex is associated with a set of its +-- /direct successors/. +-- +-- @ +-- adjacencyMap == Algebra.Graph.AdjacencyMap.'Algebra.Graph.AdjacencyMap.adjacencyMap' . 'toAdjacencyMap' +-- @ +adjacencyMap :: ToGraph t => Ord (ToVertex t) => t -> Map (ToVertex t) (Set (ToVertex t)) +adjacencyMap = AM.adjacencyMap . toAdjacencyMap + +-- | The /adjacency map/ of a graph: each vertex is associated with a set of its +-- /direct successors/. Like 'adjacencyMap' but specialised for graphs with +-- vertices of type 'Int'. +-- +-- @ +-- adjacencyIntMap == Algebra.Graph.AdjacencyIntMap.'Algebra.Graph.AdjacencyIntMap.adjacencyIntMap' . 'toAdjacencyIntMap' +-- @ +adjacencyIntMap :: (ToGraph t, ToVertex t ~ Int) => t -> IntMap IntSet +adjacencyIntMap = AIM.adjacencyIntMap . toAdjacencyIntMap + +-- | The transposed /adjacency map/ of a graph: each vertex is associated with a +-- set of its /direct predecessors/. +-- +-- @ +-- adjacencyMapTranspose == Algebra.Graph.AdjacencyMap.'Algebra.Graph.AdjacencyMap.adjacencyMap' . 'toAdjacencyMapTranspose' +-- @ +adjacencyMapTranspose :: (ToGraph t, Ord (ToVertex t)) => t -> Map (ToVertex t) (Set (ToVertex t)) +adjacencyMapTranspose = AM.adjacencyMap . toAdjacencyMapTranspose + +-- | The transposed /adjacency map/ of a graph: each vertex is associated with a +-- set of its /direct predecessors/. Like 'adjacencyMapTranspose' but +-- specialised for graphs with vertices of type 'Int'. +-- +-- @ +-- adjacencyIntMapTranspose == Algebra.Graph.AdjacencyIntMap.'Algebra.Graph.AdjacencyIntMap.adjacencyIntMap' . 'toAdjacencyIntMapTranspose' +-- @ +adjacencyIntMapTranspose :: (ToGraph t, ToVertex t ~ Int) => t -> IntMap IntSet +adjacencyIntMapTranspose = AIM.adjacencyIntMap . toAdjacencyIntMapTranspose diff --git a/test/Algebra/Graph/Test/API.hs b/test/Algebra/Graph/Test/API.hs index 12085ffad..881dc95d4 100644 --- a/test/Algebra/Graph/Test/API.hs +++ b/test/Algebra/Graph/Test/API.hs @@ -1,307 +1,658 @@ -{-# LANGUAGE ConstrainedClassMethods, RankNTypes #-} +{-# LANGUAGE ConstrainedClassMethods, RankNTypes, MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.API --- Copyright : (c) Andrey Mokhov 2016-2018 +-- Copyright : (c) Andrey Mokhov 2016-2019 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental -- --- Graph manipulation API used for generic testing. +-- The complete graph API used for generic testing. ----------------------------------------------------------------------------- module Algebra.Graph.Test.API ( - -- * Graph manipulation API - GraphAPI (..) + -- * Graph API + API (..), Mono (..) ) where +import Data.Coerce import Data.Monoid (Any) +import Data.IntMap (IntMap) import Data.IntSet (IntSet) +import Data.Map (Map) import Data.Set (Set) import Data.Tree +import Test.QuickCheck -import Algebra.Graph.Class (Graph (..)) +import qualified Algebra.Graph as G +import qualified Algebra.Graph.AdjacencyIntMap as AIM +import qualified Algebra.Graph.AdjacencyIntMap.Internal as AIM +import qualified Algebra.Graph.AdjacencyIntMap.Algorithm as AIM +import qualified Algebra.Graph.AdjacencyMap as AM +import qualified Algebra.Graph.AdjacencyMap.Internal as AM +import qualified Algebra.Graph.AdjacencyMap.Algorithm as AM +import qualified Algebra.Graph.Labelled as LG +import qualified Algebra.Graph.Labelled.AdjacencyMap as LAM +import qualified Algebra.Graph.Labelled.AdjacencyMap.Internal as LAM +import qualified Algebra.Graph.Relation as R +import qualified Algebra.Graph.Relation.Internal as R +import qualified Algebra.Graph.Relation.Symmetric as SR +import qualified Algebra.Graph.Relation.Symmetric.Internal as SR +import qualified Algebra.Graph.ToGraph as T -import qualified Algebra.Graph as G -import qualified Algebra.Graph.AdjacencyMap as AM -import qualified Algebra.Graph.Labelled as LG -import qualified Algebra.Graph.Labelled.AdjacencyMap as LAM -import qualified Algebra.Graph.Fold as Fold -import qualified Algebra.Graph.HigherKinded.Class as HClass -import qualified Algebra.Graph.AdjacencyIntMap as AIM -import qualified Algebra.Graph.Relation as R -import qualified Algebra.Graph.Relation.Symmetric as SR +-- | A wrapper for monomorphic data types. We cannot make 'AIM.AdjacencyIntMap' +-- an instance of 'API' directly, but we can if we wrap it into 'Mono'. +newtype Mono g a = Mono { getMono :: g } + deriving (Arbitrary, Eq, Num, Ord) -import qualified Algebra.Graph.AdjacencyMap.Internal as AMI -import qualified Algebra.Graph.AdjacencyIntMap.Internal as AIMI -import qualified Algebra.Graph.Relation.Internal as RI -import qualified Algebra.Graph.Relation.Symmetric.Internal as SRI +instance Show g => Show (Mono g a) where + show = show . getMono -class Graph g => GraphAPI g where - consistent :: g -> Bool - consistent = notImplemented - edge :: Vertex g -> Vertex g -> g - edge = notImplemented - vertices :: [Vertex g] -> g - vertices = notImplemented - edges :: [(Vertex g, Vertex g)] -> g - edges = notImplemented - overlays :: [g] -> g - overlays = notImplemented - connects :: [g] -> g - connects = notImplemented - fromAdjacencySets :: [(Vertex g, Set (Vertex g))] -> g - fromAdjacencySets = notImplemented - fromAdjacencyIntSets :: [(Int, IntSet)] -> g - fromAdjacencyIntSets = notImplemented - isSubgraphOf :: g -> g -> Bool - isSubgraphOf = notImplemented - (===) :: g -> g -> Bool - (===) = notImplemented - neighbours :: Vertex g -> g -> Set (Vertex g) - neighbours = notImplemented - path :: [Vertex g] -> g - path = notImplemented - circuit :: [Vertex g] -> g - circuit = notImplemented - clique :: [Vertex g] -> g - clique = notImplemented - biclique :: [Vertex g] -> [Vertex g] -> g - biclique = notImplemented - star :: Vertex g -> [Vertex g] -> g - star = notImplemented - stars :: [(Vertex g, [Vertex g])] -> g - stars = notImplemented - tree :: Tree (Vertex g) -> g - tree = notImplemented - forest :: Forest (Vertex g) -> g - forest = notImplemented - mesh :: Vertex g ~ (a, b) => [a] -> [b] -> g - mesh = notImplemented - torus :: Vertex g ~ (a, b) => [a] -> [b] -> g - torus = notImplemented - deBruijn :: Vertex g ~ [a] => Int -> [a] -> g - deBruijn = notImplemented - removeVertex :: Vertex g -> g -> g - removeVertex = notImplemented - removeEdge :: Vertex g -> Vertex g -> g -> g - removeEdge = notImplemented - replaceVertex :: Vertex g -> Vertex g -> g -> g - replaceVertex = notImplemented - mergeVertices :: (Vertex g -> Bool) -> Vertex g -> g -> g - mergeVertices = notImplemented - splitVertex :: Vertex g -> [Vertex g] -> g -> g - splitVertex = notImplemented - transpose :: g -> g - transpose = notImplemented - gmap :: Vertex g ~ Int => (Int -> Int) -> g -> g - gmap = notImplemented - induce :: (Vertex g -> Bool) -> g -> g - induce = notImplemented - compose :: g -> g -> g - compose = notImplemented - closure :: g -> g - closure = notImplemented - reflexiveClosure :: g -> g - reflexiveClosure = notImplemented - symmetricClosure :: g -> g - symmetricClosure = notImplemented - transitiveClosure :: g -> g - transitiveClosure = notImplemented - bind :: Vertex g ~ Int => g -> (Int -> g) -> g - bind = notImplemented - simplify :: g -> g - simplify = notImplemented - box :: forall a b f. (Vertex (f a) ~ a, Vertex (f b) ~ b, Vertex (f (a, b)) ~ (a, b), g ~ f (a, b)) => f a -> f b -> f (a, b) - box = notImplemented +-- TODO: Add missing API entries for Acyclic, NonEmpty and Symmetric graphs. +-- | The complete graph API specialised to vertices of type 'Int'. A graph data +-- type, such as 'G.Graph', typically implements only a part of the whole API. +class API g where + empty :: g Int + empty = notImplemented + vertex :: Int -> g Int + vertex = notImplemented + edge :: Int -> Int -> g Int + edge = notImplemented + overlay :: g Int -> g Int -> g Int + overlay = notImplemented + connect :: g Int -> g Int -> g Int + connect = notImplemented + vertices :: [Int] -> g Int + vertices = notImplemented + edges :: [(Int, Int)] -> g Int + edges = notImplemented + overlays :: [g Int] -> g Int + overlays = notImplemented + connects :: [g Int] -> g Int + connects = notImplemented + toGraph :: g Int -> G.Graph Int + toGraph = notImplemented + foldg :: b -> (Int -> b) -> (b -> b -> b) -> (b -> b -> b) -> g Int -> b + foldg = notImplemented + isSubgraphOf :: g Int -> g Int -> Bool + isSubgraphOf = notImplemented + (===) :: g Int -> g Int -> Bool + (===) = notImplemented + isEmpty :: g Int -> Bool + isEmpty = notImplemented + size :: g Int -> Int + size = notImplemented + hasVertex :: Int -> g Int -> Bool + hasVertex = notImplemented + hasEdge :: Int -> Int -> g Int -> Bool + hasEdge = notImplemented + vertexCount :: g Int -> Int + vertexCount = notImplemented + edgeCount :: g Int -> Int + edgeCount = notImplemented + vertexList :: g Int -> [Int] + vertexList = notImplemented + edgeList :: g Int -> [(Int, Int)] + edgeList = notImplemented + vertexSet :: g Int -> Set Int + vertexSet = notImplemented + vertexIntSet :: g Int -> IntSet + vertexIntSet = notImplemented + edgeSet :: g Int -> Set (Int, Int) + edgeSet = notImplemented + preSet :: Int -> g Int -> Set Int + preSet = notImplemented + preIntSet :: Int -> g Int -> IntSet + preIntSet = notImplemented + postSet :: Int -> g Int -> Set Int + postSet = notImplemented + postIntSet :: Int -> g Int -> IntSet + postIntSet = notImplemented + neighbours :: Int -> g Int -> Set Int + neighbours = notImplemented + adjacencyList :: g Int -> [(Int, [Int])] + adjacencyList = notImplemented + adjacencyMap :: g Int -> Map Int (Set Int) + adjacencyMap = notImplemented + adjacencyIntMap :: g Int -> IntMap IntSet + adjacencyIntMap = notImplemented + adjacencyMapTranspose :: g Int -> Map Int (Set Int) + adjacencyMapTranspose = notImplemented + adjacencyIntMapTranspose :: g Int -> IntMap IntSet + adjacencyIntMapTranspose = notImplemented + dfsForest :: g Int -> Forest Int + dfsForest = notImplemented + dfsForestFrom :: [Int] -> g Int -> Forest Int + dfsForestFrom = notImplemented + dfs :: [Int] -> g Int -> [Int] + dfs = notImplemented + reachable :: Int -> g Int -> [Int] + reachable = notImplemented + topSort :: g Int -> Maybe [Int] + topSort = notImplemented + isAcyclic :: g Int -> Bool + isAcyclic = notImplemented + toAdjacencyMap :: g Int -> AM.AdjacencyMap Int + toAdjacencyMap = notImplemented + toAdjacencyIntMap :: g Int -> AIM.AdjacencyIntMap + toAdjacencyIntMap = notImplemented + toAdjacencyMapTranspose :: g Int -> AM.AdjacencyMap Int + toAdjacencyMapTranspose = notImplemented + toAdjacencyIntMapTranspose :: g Int -> AIM.AdjacencyIntMap + toAdjacencyIntMapTranspose = notImplemented + isDfsForestOf :: Forest Int -> g Int -> Bool + isDfsForestOf = notImplemented + isTopSortOf :: [Int] -> g Int -> Bool + isTopSortOf = notImplemented + path :: [Int] -> g Int + path = notImplemented + circuit :: [Int] -> g Int + circuit = notImplemented + clique :: [Int] -> g Int + clique = notImplemented + biclique :: [Int] -> [Int] -> g Int + biclique = notImplemented + star :: Int -> [Int] -> g Int + star = notImplemented + stars :: [(Int, [Int])] -> g Int + stars = notImplemented + tree :: Tree (Int) -> g Int + tree = notImplemented + forest :: Forest (Int) -> g Int + forest = notImplemented + mesh :: [Int] -> [Int] -> g (Int, Int) + mesh = notImplemented + torus :: [Int] -> [Int] -> g (Int, Int) + torus = notImplemented + deBruijn :: Int -> [Int] -> g [Int] + deBruijn = notImplemented + removeVertex :: Int -> g Int -> g Int + removeVertex = notImplemented + removeEdge :: Int -> Int -> g Int -> g Int + removeEdge = notImplemented + replaceVertex :: Int -> Int -> g Int -> g Int + replaceVertex = notImplemented + mergeVertices :: (Int -> Bool) -> Int -> g Int -> g Int + mergeVertices = notImplemented + splitVertex :: Int -> [Int] -> g Int -> g Int + splitVertex = notImplemented + transpose :: g Int -> g Int + transpose = notImplemented + gmap :: (Int -> Int) -> g Int -> g Int + gmap = notImplemented + gmapPoly :: (Ord a, Ord b) => (a -> b) -> g a -> g b + gmapPoly = notImplemented + bind :: g Int -> (Int -> g Int) -> g Int + bind = notImplemented + induce :: (Int -> Bool) -> g Int -> g Int + induce = notImplemented + simplify :: g Int -> g Int + simplify = notImplemented + compose :: g Int -> g Int -> g Int + compose = notImplemented + box :: g Int -> g Int -> g (Int, Int) + box = notImplemented + closure :: g Int -> g Int + closure = notImplemented + reflexiveClosure :: g Int -> g Int + reflexiveClosure = notImplemented + symmetricClosure :: g Int -> g Int + symmetricClosure = notImplemented + transitiveClosure :: g Int -> g Int + transitiveClosure = notImplemented + consistent :: g Int -> Bool + consistent = notImplemented + fromAdjacencySets :: [(Int, Set (Int))] -> g Int + fromAdjacencySets = notImplemented + fromAdjacencyIntSets :: [(Int, IntSet)] -> g Int + fromAdjacencyIntSets = notImplemented notImplemented :: a notImplemented = error "Not implemented" -instance Ord a => GraphAPI (AM.AdjacencyMap a) where - consistent = AMI.consistent - edge = AM.edge - vertices = AM.vertices - edges = AM.edges - overlays = AM.overlays - connects = AM.connects - fromAdjacencySets = AM.fromAdjacencySets - isSubgraphOf = AM.isSubgraphOf - path = AM.path - circuit = AM.circuit - clique = AM.clique - biclique = AM.biclique - star = AM.star - stars = AM.stars - tree = AM.tree - forest = AM.forest - removeVertex = AM.removeVertex - removeEdge = AM.removeEdge - replaceVertex = AM.replaceVertex - mergeVertices = AM.mergeVertices - transpose = AM.transpose - gmap = AM.gmap - induce = AM.induce - compose = AM.compose - closure = AM.closure - reflexiveClosure = AM.reflexiveClosure - symmetricClosure = AM.symmetricClosure - transitiveClosure = AM.transitiveClosure +instance API AM.AdjacencyMap where + empty = AM.empty + vertex = AM.vertex + edge = AM.edge + overlay = AM.overlay + connect = AM.connect + vertices = AM.vertices + edges = AM.edges + overlays = AM.overlays + connects = AM.connects + toGraph = T.toGraph + foldg = T.foldg + isSubgraphOf = AM.isSubgraphOf + isEmpty = AM.isEmpty + hasVertex = AM.hasVertex + hasEdge = AM.hasEdge + vertexCount = AM.vertexCount + edgeCount = AM.edgeCount + vertexList = AM.vertexList + edgeList = AM.edgeList + vertexSet = AM.vertexSet + vertexIntSet = T.vertexIntSet + edgeSet = AM.edgeSet + preSet = AM.preSet + preIntSet = T.preIntSet + postSet = AM.postSet + postIntSet = T.postIntSet + adjacencyList = AM.adjacencyList + adjacencyMap = AM.adjacencyMap + adjacencyIntMap = T.adjacencyIntMap + adjacencyMapTranspose = T.adjacencyMapTranspose + adjacencyIntMapTranspose = T.adjacencyIntMapTranspose + dfsForest = AM.dfsForest + dfsForestFrom = AM.dfsForestFrom + dfs = AM.dfs + reachable = AM.reachable + topSort = AM.topSort + isAcyclic = AM.isAcyclic + toAdjacencyMap = T.toAdjacencyMap + toAdjacencyIntMap = T.toAdjacencyIntMap + toAdjacencyMapTranspose = T.toAdjacencyMapTranspose + toAdjacencyIntMapTranspose = T.toAdjacencyIntMapTranspose + isDfsForestOf = AM.isDfsForestOf + isTopSortOf = AM.isTopSortOf + path = AM.path + circuit = AM.circuit + clique = AM.clique + biclique = AM.biclique + star = AM.star + stars = AM.stars + tree = AM.tree + forest = AM.forest + removeVertex = AM.removeVertex + removeEdge = AM.removeEdge + replaceVertex = AM.replaceVertex + mergeVertices = AM.mergeVertices + transpose = AM.transpose + gmap = AM.gmap + gmapPoly = AM.gmap + induce = AM.induce + compose = AM.compose + closure = AM.closure + reflexiveClosure = AM.reflexiveClosure + symmetricClosure = AM.symmetricClosure + transitiveClosure = AM.transitiveClosure + consistent = AM.consistent + fromAdjacencySets = AM.fromAdjacencySets -instance Ord a => GraphAPI (Fold.Fold a) where - edge = Fold.edge - vertices = Fold.vertices - edges = Fold.edges - overlays = Fold.overlays - connects = Fold.connects - isSubgraphOf = Fold.isSubgraphOf - path = Fold.path - circuit = Fold.circuit - clique = Fold.clique - biclique = Fold.biclique - star = Fold.star - stars = Fold.stars - tree = HClass.tree - forest = HClass.forest - mesh = HClass.mesh - torus = HClass.torus - deBruijn = HClass.deBruijn - removeVertex = Fold.removeVertex - removeEdge = Fold.removeEdge - replaceVertex = HClass.replaceVertex - mergeVertices = HClass.mergeVertices - splitVertex = HClass.splitVertex - transpose = Fold.transpose - gmap = fmap - induce = Fold.induce - bind = (>>=) - simplify = Fold.simplify +instance API G.Graph where + empty = G.empty + vertex = G.vertex + edge = G.edge + overlay = G.overlay + connect = G.connect + vertices = G.vertices + edges = G.edges + overlays = G.overlays + connects = G.connects + toGraph = id + foldg = G.foldg + isSubgraphOf = G.isSubgraphOf + (===) = (G.===) + isEmpty = G.isEmpty + size = G.size + hasVertex = G.hasVertex + hasEdge = G.hasEdge + vertexCount = G.vertexCount + edgeCount = G.edgeCount + vertexList = G.vertexList + edgeList = G.edgeList + vertexSet = G.vertexSet + vertexIntSet = T.vertexIntSet + edgeSet = G.edgeSet + preSet = T.preSet + preIntSet = T.preIntSet + postSet = T.postSet + postIntSet = T.postIntSet + adjacencyList = G.adjacencyList + adjacencyMap = T.adjacencyMap + adjacencyIntMap = T.adjacencyIntMap + adjacencyMapTranspose = T.adjacencyMapTranspose + adjacencyIntMapTranspose = T.adjacencyIntMapTranspose + dfsForest = T.dfsForest + dfsForestFrom = T.dfsForestFrom + dfs = T.dfs + reachable = T.reachable + topSort = T.topSort + isAcyclic = T.isAcyclic + toAdjacencyMap = T.toAdjacencyMap + toAdjacencyIntMap = T.toAdjacencyIntMap + toAdjacencyMapTranspose = T.toAdjacencyMapTranspose + toAdjacencyIntMapTranspose = T.toAdjacencyIntMapTranspose + isDfsForestOf = T.isDfsForestOf + isTopSortOf = T.isTopSortOf + path = G.path + circuit = G.circuit + clique = G.clique + biclique = G.biclique + star = G.star + stars = G.stars + tree = G.tree + forest = G.forest + mesh = G.mesh + torus = G.torus + deBruijn = G.deBruijn + removeVertex = G.removeVertex + removeEdge = G.removeEdge + replaceVertex = G.replaceVertex + mergeVertices = G.mergeVertices + splitVertex = G.splitVertex + transpose = G.transpose + gmap = fmap + gmapPoly = fmap + bind = (>>=) + induce = G.induce + simplify = G.simplify + compose = G.compose + box = G.box -instance Ord a => GraphAPI (G.Graph a) where - edge = G.edge - vertices = G.vertices - edges = G.edges - overlays = G.overlays - connects = G.connects - isSubgraphOf = G.isSubgraphOf - (===) = (G.===) - path = G.path - circuit = G.circuit - clique = G.clique - biclique = G.biclique - star = G.star - stars = G.stars - tree = G.tree - forest = G.forest - mesh = G.mesh - torus = G.torus - deBruijn = G.deBruijn - removeVertex = G.removeVertex - removeEdge = G.removeEdge - replaceVertex = G.replaceVertex - mergeVertices = G.mergeVertices - splitVertex = G.splitVertex - transpose = G.transpose - gmap = fmap - induce = G.induce - compose = G.compose - bind = (>>=) - simplify = G.simplify - box = G.box +instance API (Mono AIM.AdjacencyIntMap) where + empty = coerce AIM.empty + vertex = coerce AIM.vertex + edge = coerce AIM.edge + overlay = coerce AIM.overlay + connect = coerce AIM.connect + vertices = coerce AIM.vertices + edges = coerce AIM.edges + overlays = coerce AIM.overlays + connects = coerce AIM.connects + toGraph = T.toGraph . getMono + foldg e v o c = T.foldg e v o c . getMono + isSubgraphOf = coerce AIM.isSubgraphOf + isEmpty = coerce AIM.isEmpty + hasVertex = coerce AIM.hasVertex + hasEdge = coerce AIM.hasEdge + vertexCount = coerce AIM.vertexCount + edgeCount = coerce AIM.edgeCount + vertexList = coerce AIM.vertexList + edgeList = coerce AIM.edgeList + vertexSet = T.vertexSet . getMono + vertexIntSet = coerce AIM.vertexIntSet + edgeSet = coerce AIM.edgeSet + preSet x = T.preSet x . getMono + preIntSet = coerce AIM.preIntSet + postSet x = T.postSet x . getMono + postIntSet = coerce AIM.postIntSet + adjacencyList = coerce AIM.adjacencyList + adjacencyMap = T.adjacencyMap . getMono + adjacencyIntMap = coerce AIM.adjacencyIntMap + adjacencyMapTranspose = T.adjacencyMapTranspose . getMono + adjacencyIntMapTranspose = T.adjacencyIntMapTranspose . getMono + dfsForest = coerce AIM.dfsForest + dfsForestFrom = coerce AIM.dfsForestFrom + dfs = coerce AIM.dfs + reachable = coerce AIM.reachable + topSort = coerce AIM.topSort + isAcyclic = coerce AIM.isAcyclic + toAdjacencyMap = T.toAdjacencyMap . getMono + toAdjacencyIntMap = T.toAdjacencyIntMap . getMono + toAdjacencyMapTranspose = T.toAdjacencyMapTranspose . getMono + toAdjacencyIntMapTranspose = T.toAdjacencyIntMapTranspose . getMono + isDfsForestOf = coerce AIM.isDfsForestOf + isTopSortOf = coerce AIM.isTopSortOf + path = coerce AIM.path + circuit = coerce AIM.circuit + clique = coerce AIM.clique + biclique = coerce AIM.biclique + star = coerce AIM.star + stars = coerce AIM.stars + tree = coerce AIM.tree + forest = coerce AIM.forest + removeVertex = coerce AIM.removeVertex + removeEdge = coerce AIM.removeEdge + replaceVertex = coerce AIM.replaceVertex + mergeVertices = coerce AIM.mergeVertices + transpose = coerce AIM.transpose + gmap = coerce AIM.gmap + induce = coerce AIM.induce + compose = coerce AIM.compose + closure = coerce AIM.closure + reflexiveClosure = coerce AIM.reflexiveClosure + symmetricClosure = coerce AIM.symmetricClosure + transitiveClosure = coerce AIM.transitiveClosure + consistent = coerce AIM.consistent + fromAdjacencyIntSets = coerce AIM.fromAdjacencyIntSets -instance GraphAPI AIM.AdjacencyIntMap where - consistent = AIMI.consistent - edge = AIM.edge - vertices = AIM.vertices - edges = AIM.edges - overlays = AIM.overlays - connects = AIM.connects - fromAdjacencyIntSets = AIM.fromAdjacencyIntSets - isSubgraphOf = AIM.isSubgraphOf - path = AIM.path - circuit = AIM.circuit - clique = AIM.clique - biclique = AIM.biclique - star = AIM.star - stars = AIM.stars - tree = AIM.tree - forest = AIM.forest - removeVertex = AIM.removeVertex - removeEdge = AIM.removeEdge - replaceVertex = AIM.replaceVertex - mergeVertices = AIM.mergeVertices - transpose = AIM.transpose - gmap = AIM.gmap - induce = AIM.induce - compose = AIM.compose - closure = AIM.closure - reflexiveClosure = AIM.reflexiveClosure - symmetricClosure = AIM.symmetricClosure - transitiveClosure = AIM.transitiveClosure +instance API R.Relation where + empty = R.empty + vertex = R.vertex + edge = R.edge + overlay = R.overlay + connect = R.connect + vertices = R.vertices + edges = R.edges + overlays = R.overlays + connects = R.connects + toGraph = T.toGraph + foldg = T.foldg + isSubgraphOf = R.isSubgraphOf + isEmpty = R.isEmpty + hasVertex = R.hasVertex + hasEdge = R.hasEdge + vertexCount = R.vertexCount + edgeCount = R.edgeCount + vertexList = R.vertexList + edgeList = R.edgeList + vertexSet = R.vertexSet + vertexIntSet = T.vertexIntSet + edgeSet = R.edgeSet + preSet = R.preSet + preIntSet = T.preIntSet + postSet = R.postSet + postIntSet = T.postIntSet + adjacencyList = R.adjacencyList + adjacencyMap = T.adjacencyMap + adjacencyIntMap = T.adjacencyIntMap + adjacencyMapTranspose = T.adjacencyMapTranspose + adjacencyIntMapTranspose = T.adjacencyIntMapTranspose + dfsForest = T.dfsForest + dfsForestFrom = T.dfsForestFrom + dfs = T.dfs + reachable = T.reachable + topSort = T.topSort + isAcyclic = T.isAcyclic + toAdjacencyMap = T.toAdjacencyMap + toAdjacencyIntMap = T.toAdjacencyIntMap + toAdjacencyMapTranspose = T.toAdjacencyMapTranspose + toAdjacencyIntMapTranspose = T.toAdjacencyIntMapTranspose + isDfsForestOf = T.isDfsForestOf + isTopSortOf = T.isTopSortOf + path = R.path + circuit = R.circuit + clique = R.clique + biclique = R.biclique + star = R.star + stars = R.stars + tree = R.tree + forest = R.forest + removeVertex = R.removeVertex + removeEdge = R.removeEdge + replaceVertex = R.replaceVertex + mergeVertices = R.mergeVertices + transpose = R.transpose + gmap = R.gmap + gmapPoly = R.gmap + induce = R.induce + compose = R.compose + closure = R.closure + reflexiveClosure = R.reflexiveClosure + symmetricClosure = R.symmetricClosure + transitiveClosure = R.transitiveClosure + consistent = R.consistent -instance Ord a => GraphAPI (R.Relation a) where - consistent = RI.consistent - edge = R.edge - vertices = R.vertices - edges = R.edges - overlays = R.overlays - connects = R.connects - isSubgraphOf = R.isSubgraphOf - path = R.path - circuit = R.circuit - clique = R.clique - biclique = R.biclique - star = R.star - stars = R.stars - tree = R.tree - forest = R.forest - removeVertex = R.removeVertex - removeEdge = R.removeEdge - replaceVertex = R.replaceVertex - mergeVertices = R.mergeVertices - transpose = R.transpose - gmap = R.gmap - induce = R.induce - compose = R.compose - closure = R.closure - reflexiveClosure = R.reflexiveClosure - symmetricClosure = R.symmetricClosure - transitiveClosure = R.transitiveClosure +instance API SR.Relation where + empty = SR.empty + vertex = SR.vertex + edge = SR.edge + overlay = SR.overlay + connect = SR.connect + vertices = SR.vertices + edges = SR.edges + overlays = SR.overlays + connects = SR.connects + toGraph = T.toGraph + foldg = T.foldg + isSubgraphOf = SR.isSubgraphOf + isEmpty = SR.isEmpty + hasVertex = SR.hasVertex + hasEdge = SR.hasEdge + vertexCount = SR.vertexCount + edgeCount = SR.edgeCount + vertexList = SR.vertexList + edgeList = SR.edgeList + vertexSet = SR.vertexSet + vertexIntSet = T.vertexIntSet + edgeSet = SR.edgeSet + preSet = T.preSet + preIntSet = T.preIntSet + postSet = T.postSet + postIntSet = T.postIntSet + neighbours = SR.neighbours + adjacencyList = SR.adjacencyList + adjacencyMap = T.adjacencyMap + adjacencyIntMap = T.adjacencyIntMap + adjacencyMapTranspose = T.adjacencyMapTranspose + adjacencyIntMapTranspose = T.adjacencyIntMapTranspose + dfsForest = T.dfsForest + dfsForestFrom = T.dfsForestFrom + dfs = T.dfs + reachable = T.reachable + topSort = T.topSort + isAcyclic = T.isAcyclic + toAdjacencyMap = T.toAdjacencyMap + toAdjacencyIntMap = T.toAdjacencyIntMap + toAdjacencyMapTranspose = T.toAdjacencyMapTranspose + toAdjacencyIntMapTranspose = T.toAdjacencyIntMapTranspose + isDfsForestOf = T.isDfsForestOf + isTopSortOf = T.isTopSortOf + path = SR.path + circuit = SR.circuit + clique = SR.clique + biclique = SR.biclique + star = SR.star + stars = SR.stars + tree = SR.tree + forest = SR.forest + removeVertex = SR.removeVertex + removeEdge = SR.removeEdge + replaceVertex = SR.replaceVertex + mergeVertices = SR.mergeVertices + transpose = id + gmap = SR.gmap + gmapPoly = SR.gmap + induce = SR.induce + consistent = SR.consistent -instance Ord a => GraphAPI (SR.Relation a) where - consistent = SRI.consistent - edge = SR.edge - vertices = SR.vertices - edges = SR.edges - overlays = SR.overlays - connects = SR.connects - isSubgraphOf = SR.isSubgraphOf - neighbours = SR.neighbours - path = SR.path - circuit = SR.circuit - clique = SR.clique - biclique = SR.biclique - star = SR.star - stars = SR.stars - tree = SR.tree - forest = SR.forest - removeVertex = SR.removeVertex - removeEdge = SR.removeEdge - replaceVertex = SR.replaceVertex - mergeVertices = SR.mergeVertices - transpose = id - gmap = SR.gmap - induce = SR.induce +instance API (LG.Graph Any) where + empty = LG.empty + vertex = LG.vertex + edge = LG.edge mempty + overlay = LG.overlay + connect = LG.connect mempty + vertices = LG.vertices + edges = LG.edges . map (\(x, y) -> (mempty, x, y)) + overlays = LG.overlays + toGraph = T.toGraph + foldg = T.foldg + isSubgraphOf = LG.isSubgraphOf + isEmpty = LG.isEmpty + size = LG.size + hasVertex = LG.hasVertex + hasEdge = LG.hasEdge + vertexCount = T.vertexCount + edgeCount = T.edgeCount + vertexList = LG.vertexList + edgeList = T.edgeList + vertexSet = LG.vertexSet + vertexIntSet = T.vertexIntSet + edgeSet = T.edgeSet + preSet = T.preSet + preIntSet = T.preIntSet + postSet = T.postSet + postIntSet = T.postIntSet + adjacencyList = T.adjacencyList + adjacencyMap = T.adjacencyMap + adjacencyIntMap = T.adjacencyIntMap + adjacencyMapTranspose = T.adjacencyMapTranspose + adjacencyIntMapTranspose = T.adjacencyIntMapTranspose + dfsForest = T.dfsForest + dfsForestFrom = T.dfsForestFrom + dfs = T.dfs + reachable = T.reachable + topSort = T.topSort + isAcyclic = T.isAcyclic + toAdjacencyMap = T.toAdjacencyMap + toAdjacencyIntMap = T.toAdjacencyIntMap + toAdjacencyMapTranspose = T.toAdjacencyMapTranspose + toAdjacencyIntMapTranspose = T.toAdjacencyIntMapTranspose + isDfsForestOf = T.isDfsForestOf + isTopSortOf = T.isTopSortOf + removeVertex = LG.removeVertex + removeEdge = LG.removeEdge + replaceVertex = LG.replaceVertex + transpose = LG.transpose + gmap = fmap + gmapPoly = fmap + induce = LG.induce + closure = LG.closure + reflexiveClosure = LG.reflexiveClosure + symmetricClosure = LG.symmetricClosure + transitiveClosure = LG.transitiveClosure -instance Ord a => GraphAPI (LG.Graph Any a) where - vertices = LG.vertices - overlays = LG.overlays - isSubgraphOf = LG.isSubgraphOf - removeVertex = LG.removeVertex - induce = LG.induce - -instance Ord a => GraphAPI (LAM.AdjacencyMap Any a) where - vertices = LAM.vertices - overlays = LAM.overlays - isSubgraphOf = LAM.isSubgraphOf - removeVertex = LAM.removeVertex - induce = LAM.induce +instance API (LAM.AdjacencyMap Any) where + empty = LAM.empty + vertex = LAM.vertex + edge = LAM.edge mempty + overlay = LAM.overlay + connect = LAM.connect mempty + vertices = LAM.vertices + edges = LAM.edges . map (\(x, y) -> (mempty, x, y)) + overlays = LAM.overlays + toGraph = T.toGraph + foldg = T.foldg + isSubgraphOf = LAM.isSubgraphOf + isEmpty = LAM.isEmpty + hasVertex = LAM.hasVertex + hasEdge = LAM.hasEdge + vertexCount = LAM.vertexCount + edgeCount = LAM.edgeCount + vertexList = LAM.vertexList + edgeList = T.edgeList + vertexSet = LAM.vertexSet + vertexIntSet = T.vertexIntSet + edgeSet = T.edgeSet + preSet = LAM.preSet + preIntSet = T.preIntSet + postSet = LAM.postSet + postIntSet = T.postIntSet + adjacencyList = T.adjacencyList + adjacencyMap = T.adjacencyMap + adjacencyIntMap = T.adjacencyIntMap + adjacencyMapTranspose = T.adjacencyMapTranspose + adjacencyIntMapTranspose = T.adjacencyIntMapTranspose + dfsForest = T.dfsForest + dfsForestFrom = T.dfsForestFrom + dfs = T.dfs + reachable = T.reachable + topSort = T.topSort + isAcyclic = T.isAcyclic + toAdjacencyMap = T.toAdjacencyMap + toAdjacencyIntMap = T.toAdjacencyIntMap + toAdjacencyMapTranspose = T.toAdjacencyMapTranspose + toAdjacencyIntMapTranspose = T.toAdjacencyIntMapTranspose + isDfsForestOf = T.isDfsForestOf + isTopSortOf = T.isTopSortOf + removeVertex = LAM.removeVertex + removeEdge = LAM.removeEdge + replaceVertex = LAM.replaceVertex + transpose = LAM.transpose + gmap = LAM.gmap + gmapPoly = LAM.gmap + induce = LAM.induce + closure = LAM.closure + reflexiveClosure = LAM.reflexiveClosure + symmetricClosure = LAM.symmetricClosure + transitiveClosure = LAM.transitiveClosure + consistent = LAM.consistent diff --git a/test/Algebra/Graph/Test/AdjacencyIntMap.hs b/test/Algebra/Graph/Test/AdjacencyIntMap.hs index b0ac2468a..72946d974 100644 --- a/test/Algebra/Graph/Test/AdjacencyIntMap.hs +++ b/test/Algebra/Graph/Test/AdjacencyIntMap.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.AdjacencyIntMap --- Copyright : (c) Andrey Mokhov 2016-2018 +-- Copyright : (c) Andrey Mokhov 2016-2019 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental @@ -15,10 +15,11 @@ module Algebra.Graph.Test.AdjacencyIntMap ( import Algebra.Graph.AdjacencyIntMap import Algebra.Graph.Test +import Algebra.Graph.Test.API (Mono (..)) import Algebra.Graph.Test.Generic t :: Testsuite -t = testsuite "AdjacencyIntMap." empty +t = testsuite "AdjacencyIntMap." (Mono empty) testAdjacencyIntMap :: IO () testAdjacencyIntMap = do diff --git a/test/Algebra/Graph/Test/Arbitrary.hs b/test/Algebra/Graph/Test/Arbitrary.hs index 85677d0be..ec69c490d 100644 --- a/test/Algebra/Graph/Test/Arbitrary.hs +++ b/test/Algebra/Graph/Test/Arbitrary.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Arbitrary --- Copyright : (c) Andrey Mokhov 2016-2018 +-- Copyright : (c) Andrey Mokhov 2016-2019 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental @@ -27,7 +27,6 @@ import Algebra.Graph import Algebra.Graph.AdjacencyMap.Internal import Algebra.Graph.AdjacencyIntMap.Internal import Algebra.Graph.Export -import Algebra.Graph.Fold (Fold) import Algebra.Graph.Label import Algebra.Graph.Relation.InternalDerived import Algebra.Graph.Relation.Symmetric.Internal @@ -36,7 +35,6 @@ import qualified Algebra.Graph.AdjacencyIntMap as AdjacencyIntMap import qualified Algebra.Graph.AdjacencyMap as AdjacencyMap import qualified Algebra.Graph.NonEmpty.AdjacencyMap as NAM import qualified Algebra.Graph.Class as C -import qualified Algebra.Graph.Fold as Fold import qualified Algebra.Graph.Labelled as LG import qualified Algebra.Graph.Labelled.AdjacencyMap as LAM import qualified Algebra.Graph.NonEmpty as NonEmpty @@ -64,20 +62,6 @@ instance Arbitrary a => Arbitrary (Graph a) where shrink (Connect x y) = [Empty, x, y, Overlay x y] ++ [Connect x' y' | (x', y') <- shrink (x, y) ] -instance (Eq a, Ord a, Arbitrary a) => Arbitrary (Fold a) where - arbitrary = arbitraryGraph - - shrink g = oneLessVertex ++ oneLessEdge - where - oneLessVertex = - let vertices = Fold.vertexList g - in [ Fold.removeVertex v g | v <- vertices ] - - oneLessEdge = - let edges = Fold.edgeList g - in [ Fold.removeEdge v w g | (v, w) <- edges ] - - -- | Generate an arbitrary 'NonEmpty.Graph' value of a specified size. arbitraryNonEmptyGraph :: Arbitrary a => Gen (NonEmpty.Graph a) arbitraryNonEmptyGraph = sized expr diff --git a/test/Algebra/Graph/Test/Fold.hs b/test/Algebra/Graph/Test/Fold.hs deleted file mode 100644 index 61d2ec95b..000000000 --- a/test/Algebra/Graph/Test/Fold.hs +++ /dev/null @@ -1,40 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Algebra.Graph.Test.Fold --- Copyright : (c) Andrey Mokhov 2016-2018 --- License : MIT (see the file LICENSE) --- Maintainer : andrey.mokhov@gmail.com --- Stability : experimental --- --- Testsuite for "Algebra.Graph.Fold" and polymorphic functions defined in --- "Algebra.Graph.Class". ------------------------------------------------------------------------------ -module Algebra.Graph.Test.Fold ( - -- * Testsuite - testFold - ) where - -import Algebra.Graph.Fold -import Algebra.Graph.Test -import Algebra.Graph.Test.Generic - -t :: Testsuite -t = testsuite "Fold." (empty :: Fold Int) - -type F = Fold Int - -testFold :: IO () -testFold = do - putStrLn "\n============ Fold ============" - test "Axioms of graphs" (axioms :: GraphTestsuite F) - - testShow t - testBasicPrimitives t - testIsSubgraphOf t - testToGraph t - testSize t - testGraphFamilies t - testTransformations t - testSplitVertex t - testBind t - testSimplify t diff --git a/test/Algebra/Graph/Test/Generic.hs b/test/Algebra/Graph/Test/Generic.hs index aa73bcde1..5dba838a4 100644 --- a/test/Algebra/Graph/Test/Generic.hs +++ b/test/Algebra/Graph/Test/Generic.hs @@ -22,8 +22,6 @@ import Data.Maybe import Data.Tree import Data.Tuple -import Algebra.Graph.Class (Graph (..)) -import Algebra.Graph.ToGraph import Algebra.Graph.Test import Algebra.Graph.Test.API @@ -35,11 +33,11 @@ import qualified Data.Set as Set import qualified Data.IntSet as IntSet data Testsuite where - Testsuite :: (Arbitrary g, GraphAPI g, Num g, Ord g, Show g, ToGraph g, ToVertex g ~ Int, Vertex g ~ Int) - => String -> (forall r. (g -> r) -> g -> r) -> Testsuite + Testsuite :: (API g, Arbitrary (g Int), Num (g Int), Ord (g Int), Show (g Int)) + => String -> (forall r. (g Int -> r) -> g Int -> r) -> Testsuite -testsuite :: (Arbitrary g, GraphAPI g, Num g, Ord g, Show g, ToGraph g, ToVertex g ~ Int, Vertex g ~ Int) - => String -> g -> Testsuite +testsuite :: (API g, Arbitrary (g Int), Num (g Int), Ord (g Int), Show (g Int)) + => String -> g Int -> Testsuite testsuite prefix g = Testsuite prefix (\f x -> f (x `asTypeOf` g)) size10 :: Testable prop => prop -> Property diff --git a/test/Algebra/Graph/Test/Labelled/AdjacencyMap.hs b/test/Algebra/Graph/Test/Labelled/AdjacencyMap.hs index 7168d0fb8..290476c46 100644 --- a/test/Algebra/Graph/Test/Labelled/AdjacencyMap.hs +++ b/test/Algebra/Graph/Test/Labelled/AdjacencyMap.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Algebra.Graph.Test.Labelled.AdjacencyMap --- Copyright : (c) Andrey Mokhov 2016-2018 +-- Copyright : (c) Andrey Mokhov 2016-2019 -- License : MIT (see the file LICENSE) -- Maintainer : andrey.mokhov@gmail.com -- Stability : experimental diff --git a/test/Main.hs b/test/Main.hs index 06c703fe5..62134320a 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -2,7 +2,6 @@ import Algebra.Graph.Test.AdjacencyIntMap import Algebra.Graph.Test.AdjacencyMap import Algebra.Graph.Test.NonEmpty.AdjacencyMap import Algebra.Graph.Test.Export -import Algebra.Graph.Test.Fold import Algebra.Graph.Test.Graph import Algebra.Graph.Test.NonEmpty.Graph import Algebra.Graph.Test.Internal @@ -29,7 +28,6 @@ main = do go "AdjacencyIntMap" testAdjacencyIntMap go "AdjacencyMap" testAdjacencyMap go "Export" testExport - go "Fold" testFold go "Graph" testGraph go "Internal" testInternal go "LabelledAdjacencyMap" testLabelledAdjacencyMap