{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
-----------------------------------------------------------------------------
-- |
-- Module : Algebra.Graph
-- Copyright : (c) Andrey Mokhov 2016-2017
-- 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 core data type 'Graph' and associated algorithms.
-- 'Graph' 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 (
-- * Algebraic data type for graphs
Graph (..),
-- * Basic graph construction primitives
empty, vertex, edge, overlay, connect, vertices, edges, overlays, connects,
graph,
-- * Graph folding
foldg,
-- * Relations on graphs
isSubgraphOf, (===),
-- * Graph properties
isEmpty, size, hasVertex, hasEdge, vertexCount, edgeCount, vertexList,
edgeList, vertexSet, vertexIntSet, edgeSet,
-- * Standard families of graphs
path, circuit, clique, biclique, star, tree, forest, mesh, torus, deBruijn,
-- * Graph transformation
removeVertex, removeEdge, replaceVertex, mergeVertices, splitVertex,
transpose, induce, simplify,
-- * Graph composition
box
) where
import Control.Applicative (Alternative, (<|>))
import Control.Monad
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.Relation as R
import qualified Data.IntSet as IntSet
import qualified Data.Set as Set
import qualified Data.Tree as Tree
{-| The 'Graph' datatype 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:
> 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))
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 'Graph' then /n/, /m/ and /s/ can be
computed as follows:
@n == 'vertexCount' g
m == 'edgeCount' g
s == 'size' g@
Note that 'size' is slightly different from the 'length' method of the
'Foldable' type class, as the latter does not count 'empty' leaves of the
expression:
@'length' 'empty' == 0
'size' 'empty' == 1
'length' ('vertex' x) == 1
'size' ('vertex' x) == 1
'length' ('empty' + 'empty') == 0
'size' ('empty' + 'empty') == 2@
The 'size' of any graph is positive, and the difference @('size' g - 'length' g)@
corresponds to the number of occurrences of 'empty' in an expression @g@.
Converting a 'Graph' 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 Graph a = Empty
| Vertex a
| Overlay (Graph a) (Graph a)
| Connect (Graph a) (Graph a)
deriving (Foldable, Functor, Show, Traversable)
instance C.Graph (Graph a) where
type Vertex (Graph a) = a
empty = empty
vertex = vertex
overlay = overlay
connect = connect
instance C.ToGraph (Graph a) where
type ToVertex (Graph a) = a
toGraph = foldg C.empty C.vertex C.overlay C.connect
instance H.ToGraph Graph where
toGraph = foldg H.empty H.vertex H.overlay H.connect
instance H.Graph Graph where
connect = connect
instance Num a => Num (Graph a) where
fromInteger = Vertex . fromInteger
(+) = Overlay
(*) = Connect
signum = const Empty
abs = id
negate = id
instance Ord a => Eq (Graph a) where
x == y = C.toGraph x == (C.toGraph y :: AM.AdjacencyMap a)
instance Applicative Graph where
pure = Vertex
(<*>) = ap
instance Monad Graph where
return = pure
g >>= f = foldg Empty f Overlay Connect g
instance Alternative Graph where
empty = Empty
(<|>) = Overlay
instance MonadPlus Graph where
mzero = Empty
mplus = Overlay
-- | Construct the /empty graph/. An alias for the constructor 'Empty'.
-- Complexity: /O(1)/ time, memory and size.
--
-- @
-- 'isEmpty' empty == True
-- 'hasVertex' x empty == False
-- 'vertexCount' empty == 0
-- 'edgeCount' empty == 0
-- 'size' empty == 1
-- @
empty :: Graph a
empty = Empty
-- | Construct the graph comprising /a single isolated vertex/. An alias for the
-- constructor 'Vertex'.
-- Complexity: /O(1)/ time, memory and size.
--
-- @
-- '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
-- @
vertex :: a -> Graph 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 -> 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'.
-- 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 :: Graph a -> Graph a -> Graph a
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.
-- 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 :: Graph a -> Graph a -> Graph 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.
--
-- @
-- vertices [] == 'empty'
-- vertices [x] == 'vertex' x
-- 'hasVertex' x . vertices == 'elem' x
-- 'vertexCount' . vertices == 'length' . 'Data.List.nub'
-- 'vertexSet' . vertices == Set.'Set.fromList'
-- @
vertices :: [a] -> Graph a
vertices = H.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)] -> Graph a
edges = H.edges
-- | 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
-- 'isEmpty' . overlays == 'all' 'isEmpty'
-- @
overlays :: [Graph a] -> Graph a
overlays = H.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
-- '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.
-- 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 [] return (++) (++) == 'Data.Foldable.toList'
-- foldg 0 (const 1) (+) (+) == 'Data.Foldable.length'
-- foldg 1 (const 1) (+) (+) == 'size'
-- 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)
-- | 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 :: Ord a => Graph a -> Graph a -> Bool
isSubgraphOf = H.isSubgraphOf
-- | Structural equality on graph expressions.
-- Complexity: /O(s)/ time.
--
-- @
-- x === x == True
-- x === x + 'empty' == False
-- x + y === x + y == True
-- 1 + 2 === 2 + 1 == False
-- x + y === x * y == False
-- @
(===) :: Eq a => Graph a -> Graph a -> Bool
Empty === Empty = True
(Vertex x) === (Vertex y) = x == y
(Overlay x1 y1) === (Overlay x2 y2) = x1 === x2 && y1 === y2
(Connect x1 y1) === (Connect x2 y2) = x1 === x2 && y1 === y2
_ === _ = False
infix 4 ===
-- | 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 :: Graph a -> Bool
isEmpty = H.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 :: Graph a -> Int
size = foldg 1 (const 1) (+) (+)
-- | Check if a graph contains a given vertex. A convenient alias for `elem`.
-- Complexity: /O(s)/ time.
--
-- @
-- hasVertex x 'empty' == False
-- hasVertex x ('vertex' x) == True
-- hasVertex x . 'removeVertex' x == const False
-- @
hasVertex :: Eq a => a -> Graph a -> Bool
hasVertex = H.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 :: Eq a => a -> a -> Graph a -> Bool
hasEdge s t g = not $ intact st where (_, _, st) = smash s t g
-- | The number of vertices in a graph.
-- Complexity: /O(s * log(n))/ time.
--
-- @
-- vertexCount 'empty' == 0
-- vertexCount ('vertex' x) == 1
-- vertexCount == 'length' . 'vertexList'
-- @
vertexCount :: Ord a => Graph a -> Int
vertexCount = length . vertexList
-- | 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 => Graph a -> Int
edgeCount = length . edgeList
-- | 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 => Graph a -> [a]
vertexList = Set.toAscList . vertexSet
-- | 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 => Graph 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 'empty' == Set.'Set.empty'
-- vertexSet . 'vertex' == Set.'Set.singleton'
-- vertexSet . 'vertices' == Set.'Set.fromList'
-- vertexSet . 'clique' == Set.'Set.fromList'
-- @
vertexSet :: Ord a => Graph a -> Set.Set a
vertexSet = H.vertexSet
-- | 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 'empty' == IntSet.'IntSet.empty'
-- vertexIntSet . 'vertex' == IntSet.'IntSet.singleton'
-- vertexIntSet . 'vertices' == IntSet.'IntSet.fromList'
-- vertexIntSet . 'clique' == IntSet.'IntSet.fromList'
-- @
vertexIntSet :: Graph Int -> IntSet.IntSet
vertexIntSet = H.vertexIntSet
-- | 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 => Graph 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.
--
-- @
-- path [] == 'empty'
-- path [x] == 'vertex' x
-- path [x,y] == 'edge' x y
-- path . 'reverse' == 'transpose' . path
-- @
path :: [a] -> Graph a
path = H.path
-- | 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] -> Graph a
circuit = H.circuit
-- | 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 . 'reverse' == 'transpose' . clique
-- @
clique :: [a] -> Graph a
clique = H.clique
-- | The /biclique/ on a list 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] -> Graph a
biclique = H.biclique
-- | The /star/ formed by a centre vertex and 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 :: a -> [a] -> Graph a
star = H.star
-- | 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).
--
-- @
-- tree (Node x []) == 'vertex' x
-- tree (Node x [Node y [Node z []]]) == 'path' [x,y,z]
-- tree (Node x [Node y [], Node z []]) == 'star' x [y,z]
-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)]
-- @
tree :: Tree.Tree a -> Graph a
tree = H.tree
-- | The /forest graph/ constructed from a given '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).
--
-- @
-- forest [] == 'empty'
-- forest [x] == 'tree' x
-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)]
-- forest == 'overlays' . map 'tree'
-- @
forest :: Tree.Forest a -> Graph a
forest = H.forest
-- | 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.
--
-- @
-- mesh xs [] == 'empty'
-- mesh [] ys == 'empty'
-- mesh [x] [y] == 'vertex' (x, y)
-- mesh xs ys == 'box' ('path' xs) ('path' ys)
-- 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,\'b\')) ]
-- @
mesh :: [a] -> [b] -> Graph (a, b)
mesh = H.mesh
-- | 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.
--
-- @
-- torus xs [] == 'empty'
-- torus [] ys == 'empty'
-- torus [x] [y] == 'edge' (x, y) (x, y)
-- torus xs ys == 'box' ('circuit' xs) ('circuit' ys)
-- 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,\'a\')) ]
-- @
torus :: [a] -> [b] -> Graph (a, b)
torus = H.torus
-- | 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.
--
-- @
-- deBruijn 0 xs == 'edge' [] []
-- n > 0 'Test.QuickCheck.==>' deBruijn n [] == 'empty'
-- deBruijn 1 [0,1] == 'edges' [ ([0],[0]), ([0],[1]), ([1],[0]), ([1],[1]) ]
-- 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") ]
-- 'vertexCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^n
-- n > 0 'Test.QuickCheck.==>' 'edgeCount' (deBruijn n xs) == ('length' $ 'Data.List.nub' xs)^(n + 1)
-- @
deBruijn :: Int -> [a] -> Graph [a]
deBruijn = H.deBruijn
-- | Remove a vertex from a given graph.
-- Complexity: /O(s)/ time, memory and size.
--
-- @
-- removeVertex x ('vertex' x) == 'empty'
-- 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.
--
-- @
-- 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 1 1 (1 * 1 * 2 * 2) == 1 * 2 * 2
-- removeEdge 1 2 (1 * 1 * 2 * 2) == 1 * 1 + 2 * 2
-- @
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)
smash :: Eq a => a -> a -> Graph a -> Pieces a
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 function @'replaceVertex' x y@ replaces vertex @x@ with vertex @y@ in a
-- given 'Graph'. 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 -> Graph a -> Graph a
replaceVertex = H.replaceVertex
-- | Merge vertices satisfying a given predicate with 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 :: Eq a => (a -> Bool) -> a -> Graph a -> Graph a
mergeVertices = H.mergeVertices
-- | 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.
--
-- @
-- splitVertex x [] == 'removeVertex' x
-- splitVertex x [x] == id
-- splitVertex x [y] == 'replaceVertex' x y
-- splitVertex 1 [0,1] $ 1 * (2 + 3) == (0 + 1) * (2 + 3)
-- @
splitVertex :: Eq a => a -> [a] -> Graph a -> Graph a
splitVertex = H.splitVertex
-- | 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 . '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)
-- | 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) -> Graph a -> Graph a
induce = H.induce
-- | 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 'empty' '===' 'empty'
-- simplify 1 '===' 1
-- simplify (1 + 1) '===' 1
-- simplify (1 + 2 + 1) '===' 1 + 2
-- simplify (1 * 1 * 1) '===' 1 * 1
-- @
simplify :: Ord a => Graph a -> Graph 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
-- | 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 ('path' [0,1]) ('path' "ab") == 'edges' [ ((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', has singleton
-- graphs as /identities/ and 'empty' as the /annihilating zero/. 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
-- box x 'empty' ~~ 'empty'
-- '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 :: Graph a -> Graph b -> Graph (a, b)
box = H.box