1----------------------------------------------------------------------------- 2-- | 3-- Module : Algebra.Graph.Class 4-- Copyright : (c) Andrey Mokhov 2016-2019 5-- License : MIT (see the file LICENSE) 6-- Maintainer : andrey.mokhov@gmail.com 7-- Stability : experimental 8-- 9-- __Alga__ is a library for algebraic construction and manipulation of graphs 10-- in Haskell. See <https://github.com/snowleopard/alga-paper this paper> for the 11-- motivation behind the library, the underlying theory, and implementation details. 12-- 13-- This module defines the core type class 'Graph', a few graph subclasses, and 14-- basic polymorphic graph construction primitives. Functions that cannot be 15-- implemented fully polymorphically and require the use of an intermediate data 16-- type are not included. For example, to compute the number of vertices in a 17-- 'Graph' expression you will need to use a concrete data type, such as 18-- "Algebra.Graph.Graph" or "Algebra.Graph.AdjacencyMap". 19-- 20-- See "Algebra.Graph.HigherKinded.Class" for the higher-kinded version of the 21-- core graph type class. 22----------------------------------------------------------------------------- 23module Algebra.Graph.Class ( 24 -- * The core type class 25 Graph (..), 26 27 -- * Undirected graphs 28 Undirected, 29 30 -- * Reflexive graphs 31 Reflexive, 32 33 -- * Transitive graphs 34 Transitive, 35 36 -- * Preorders 37 Preorder, 38 39 -- * Basic graph construction primitives 40 edge, vertices, overlays, connects, edges, 41 42 -- * Relations on graphs 43 isSubgraphOf, 44 45 -- * Standard families of graphs 46 path, circuit, clique, biclique, star, tree, forest 47 ) where 48 49import Data.Tree 50 51import Algebra.Graph.Label (Dioid, one) 52 53import qualified Algebra.Graph as G 54import qualified Algebra.Graph.Undirected as UG 55import qualified Algebra.Graph.AdjacencyMap as AM 56import qualified Algebra.Graph.Labelled as LG 57import qualified Algebra.Graph.Labelled.AdjacencyMap as LAM 58import qualified Algebra.Graph.AdjacencyIntMap as AIM 59import qualified Algebra.Graph.Relation as R 60import qualified Algebra.Graph.Relation.Symmetric as RS 61 62{-| 63The core type class for constructing algebraic graphs, characterised by the 64following minimal set of axioms. In equations we use @+@ and @*@ as convenient 65shortcuts for 'overlay' and 'connect', respectively. 66 67 * 'overlay' is commutative and associative: 68 69 > x + y == y + x 70 > x + (y + z) == (x + y) + z 71 72 * 'connect' is associative and has 'empty' as the identity: 73 74 > x * empty == x 75 > empty * x == x 76 > x * (y * z) == (x * y) * z 77 78 * 'connect' distributes over 'overlay': 79 80 > x * (y + z) == x * y + x * z 81 > (x + y) * z == x * z + y * z 82 83 * 'connect' can be decomposed: 84 85 > x * y * z == x * y + x * z + y * z 86 87The following useful theorems can be proved from the above set of axioms. 88 89 * 'overlay' has 'empty' as the identity and is idempotent: 90 91 > x + empty == x 92 > empty + x == x 93 > x + x == x 94 95 * Absorption and saturation of 'connect': 96 97 > x * y + x + y == x * y 98 > x * x * x == x * x 99 100The core type class 'Graph' corresponds to unlabelled directed graphs. 101'Undirected', 'Reflexive', 'Transitive' and 'Preorder' graphs can be obtained 102by extending the minimal set of axioms. 103 104When specifying the time and memory complexity of graph algorithms, /n/ will 105denote the number of vertices in the graph, /m/ will denote the number of 106edges in the graph, and /s/ will denote the /size/ of the corresponding 107'Graph' expression. 108-} 109class Graph g where 110 -- | The type of graph vertices. 111 type Vertex g 112 -- | Construct the empty graph. 113 empty :: g 114 -- | Construct the graph with a single vertex. 115 vertex :: Vertex g -> g 116 -- | Overlay two graphs. 117 overlay :: g -> g -> g 118 -- | Connect two graphs. 119 connect :: g -> g -> g 120 121instance Graph (G.Graph a) where 122 type Vertex (G.Graph a) = a 123 empty = G.empty 124 vertex = G.vertex 125 overlay = G.overlay 126 connect = G.connect 127 128instance Graph (UG.Graph a) where 129 type Vertex (UG.Graph a) = a 130 empty = UG.empty 131 vertex = UG.vertex 132 overlay = UG.overlay 133 connect = UG.connect 134 135instance Undirected (UG.Graph a) 136 137instance Ord a => Graph (AM.AdjacencyMap a) where 138 type Vertex (AM.AdjacencyMap a) = a 139 empty = AM.empty 140 vertex = AM.vertex 141 overlay = AM.overlay 142 connect = AM.connect 143 144instance Graph AIM.AdjacencyIntMap where 145 type Vertex AIM.AdjacencyIntMap = Int 146 empty = AIM.empty 147 vertex = AIM.vertex 148 overlay = AIM.overlay 149 connect = AIM.connect 150 151instance Dioid e => Graph (LG.Graph e a) where 152 type Vertex (LG.Graph e a) = a 153 empty = LG.empty 154 vertex = LG.vertex 155 overlay = LG.overlay 156 connect = LG.connect one 157 158instance (Dioid e, Eq e, Ord a) => Graph (LAM.AdjacencyMap e a) where 159 type Vertex (LAM.AdjacencyMap e a) = a 160 empty = LAM.empty 161 vertex = LAM.vertex 162 overlay = LAM.overlay 163 connect = LAM.connect one 164 165instance Ord a => Graph (R.Relation a) where 166 type Vertex (R.Relation a) = a 167 empty = R.empty 168 vertex = R.vertex 169 overlay = R.overlay 170 connect = R.connect 171 172instance Ord a => Graph (RS.Relation a) where 173 type Vertex (RS.Relation a) = a 174 empty = RS.empty 175 vertex = RS.vertex 176 overlay = RS.overlay 177 connect = RS.connect 178 179instance Ord a => Undirected (RS.Relation a) 180 181{-| 182The class of /undirected graphs/ that satisfy the following additional axiom. 183 184 * 'connect' is commutative: 185 186 > x * y == y * x 187-} 188class Graph g => Undirected g 189 190{-| 191The class of /reflexive graphs/ that satisfy the following additional axiom. 192 193 * Each vertex has a /self-loop/: 194 195 > vertex x == vertex x * vertex x 196 197Note that by applying the axiom in the reverse direction, one can always remove 198all self-loops resulting in an /irreflexive graph/. This type class can 199therefore be also used in the context of irreflexive graphs. 200-} 201class Graph g => Reflexive g 202 203{-| 204The class of /transitive graphs/ that satisfy the following additional axiom. 205 206 * The /closure/ axiom: graphs with equal transitive closures are equal. 207 208 > y /= empty ==> x * y + x * z + y * z == x * y + y * z 209 210By repeated application of the axiom one can turn any graph into its transitive 211closure or transitive reduction. 212-} 213class Graph g => Transitive g 214 215{-| 216The class of /preorder graphs/ that are both reflexive and transitive. 217-} 218class (Reflexive g, Transitive g) => Preorder g 219 220instance Graph () where 221 type Vertex () = () 222 empty = () 223 vertex _ = () 224 overlay _ _ = () 225 connect _ _ = () 226 227instance Undirected () 228instance Reflexive () 229instance Transitive () 230instance Preorder () 231 232-- Note: Maybe g and (a -> g) instances are identical and use the Applicative's 233-- pure and <*>. We do not provide a general instance for all Applicative 234-- functors because that would lead to overlapping instances. 235instance Graph g => Graph (Maybe g) where 236 type Vertex (Maybe g) = Vertex g 237 empty = pure empty 238 vertex = pure . vertex 239 overlay x y = overlay <$> x <*> y 240 connect x y = connect <$> x <*> y 241 242instance Undirected g => Undirected (Maybe g) 243instance Reflexive g => Reflexive (Maybe g) 244instance Transitive g => Transitive (Maybe g) 245instance Preorder g => Preorder (Maybe g) 246 247instance Graph g => Graph (a -> g) where 248 type Vertex (a -> g) = Vertex g 249 empty = pure empty 250 vertex = pure . vertex 251 overlay x y = overlay <$> x <*> y 252 connect x y = connect <$> x <*> y 253 254instance Undirected g => Undirected (a -> g) 255instance Reflexive g => Reflexive (a -> g) 256instance Transitive g => Transitive (a -> g) 257instance Preorder g => Preorder (a -> g) 258 259instance (Graph g, Graph h) => Graph (g, h) where 260 type Vertex (g, h) = (Vertex g , Vertex h ) 261 empty = (empty , empty ) 262 vertex (x, y ) = (vertex x , vertex y ) 263 overlay (x1, y1) (x2, y2) = (overlay x1 x2, overlay y1 y2) 264 connect (x1, y1) (x2, y2) = (connect x1 x2, connect y1 y2) 265 266instance (Undirected g, Undirected h) => Undirected (g, h) 267instance (Reflexive g, Reflexive h) => Reflexive (g, h) 268instance (Transitive g, Transitive h) => Transitive (g, h) 269instance (Preorder g, Preorder h) => Preorder (g, h) 270 271instance (Graph g, Graph h, Graph i) => Graph (g, h, i) where 272 type Vertex (g, h, i) = (Vertex g , Vertex h , Vertex i ) 273 empty = (empty , empty , empty ) 274 vertex (x, y , z ) = (vertex x , vertex y , vertex z ) 275 overlay (x1, y1, z1) (x2, y2, z2) = (overlay x1 x2, overlay y1 y2, overlay z1 z2) 276 connect (x1, y1, z1) (x2, y2, z2) = (connect x1 x2, connect y1 y2, connect z1 z2) 277 278instance (Undirected g, Undirected h, Undirected i) => Undirected (g, h, i) 279instance (Reflexive g, Reflexive h, Reflexive i) => Reflexive (g, h, i) 280instance (Transitive g, Transitive h, Transitive i) => Transitive (g, h, i) 281instance (Preorder g, Preorder h, Preorder i) => Preorder (g, h, i) 282 283-- | Construct the graph comprising a single edge. 284-- Complexity: /O(1)/ time, memory and size. 285-- 286-- @ 287-- edge x y == 'connect' ('vertex' x) ('vertex' y) 288-- @ 289edge :: Graph g => Vertex g -> Vertex g -> g 290edge x y = connect (vertex x) (vertex y) 291 292-- | Construct the graph comprising a given list of isolated vertices. 293-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 294-- given list. 295-- 296-- @ 297-- vertices [] == 'empty' 298-- vertices [x] == 'vertex' x 299-- @ 300vertices :: Graph g => [Vertex g] -> g 301vertices = overlays . map vertex 302 303-- | Construct the graph from a list of edges. 304-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 305-- given list. 306-- 307-- @ 308-- edges [] == 'empty' 309-- edges [(x,y)] == 'edge' x y 310-- @ 311edges :: Graph g => [(Vertex g, Vertex g)] -> g 312edges = overlays . map (uncurry edge) 313 314-- | Overlay a given list of graphs. 315-- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length 316-- of the given list, and /S/ is the sum of sizes of the graphs in the list. 317-- 318-- @ 319-- overlays [] == 'empty' 320-- overlays [x] == x 321-- overlays [x,y] == 'overlay' x y 322-- overlays == 'foldr' 'overlay' 'empty' 323-- @ 324overlays :: Graph g => [g] -> g 325overlays [] = empty 326overlays [x] = x 327overlays (x:xs) = x `overlay` overlays xs 328 329-- | Connect a given list of graphs. 330-- Complexity: /O(L)/ time and memory, and /O(S)/ size, where /L/ is the length 331-- of the given list, and /S/ is the sum of sizes of the graphs in the list. 332-- 333-- @ 334-- connects [] == 'empty' 335-- connects [x] == x 336-- connects [x,y] == 'connect' x y 337-- connects == 'foldr' 'connect' 'empty' 338-- @ 339connects :: Graph g => [g] -> g 340connects [] = empty 341connects [x] = x 342connects (x:xs) = x `connect` connects xs 343 344-- | The 'isSubgraphOf' function takes two graphs and returns 'True' if the 345-- first graph is a /subgraph/ of the second. Here is the current implementation: 346-- 347-- @ 348-- isSubgraphOf x y = 'overlay' x y == y 349-- @ 350-- The complexity therefore depends on the complexity of equality testing of 351-- the specific graph instance. 352-- 353-- @ 354-- isSubgraphOf 'empty' x == True 355-- isSubgraphOf ('vertex' x) 'empty' == False 356-- isSubgraphOf x ('overlay' x y) == True 357-- isSubgraphOf ('overlay' x y) ('connect' x y) == True 358-- isSubgraphOf ('path' xs) ('circuit' xs) == True 359-- @ 360isSubgraphOf :: (Graph g, Eq g) => g -> g -> Bool 361isSubgraphOf x y = overlay x y == y 362 363-- | The /path/ on a list of vertices. 364-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 365-- given list. 366-- 367-- @ 368-- path [] == 'empty' 369-- path [x] == 'vertex' x 370-- path [x,y] == 'edge' x y 371-- @ 372path :: Graph g => [Vertex g] -> g 373path xs = case xs of [] -> empty 374 [x] -> vertex x 375 (_:ys) -> edges (zip xs ys) 376 377-- | The /circuit/ on a list of vertices. 378-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 379-- given list. 380-- 381-- @ 382-- circuit [] == 'empty' 383-- circuit [x] == 'edge' x x 384-- circuit [x,y] == 'edges' [(x,y), (y,x)] 385-- @ 386circuit :: Graph g => [Vertex g] -> g 387circuit [] = empty 388circuit (x:xs) = path $ [x] ++ xs ++ [x] 389 390-- | The /clique/ on a list of vertices. 391-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 392-- given list. 393-- 394-- @ 395-- clique [] == 'empty' 396-- clique [x] == 'vertex' x 397-- clique [x,y] == 'edge' x y 398-- clique [x,y,z] == 'edges' [(x,y), (x,z), (y,z)] 399-- clique (xs ++ ys) == 'connect' (clique xs) (clique ys) 400-- @ 401clique :: Graph g => [Vertex g] -> g 402clique = connects . map vertex 403 404-- | The /biclique/ on two lists of vertices. 405-- Complexity: /O(L1 + L2)/ time, memory and size, where /L1/ and /L2/ are the 406-- lengths of the given lists. 407-- 408-- @ 409-- biclique [] [] == 'empty' 410-- biclique [x] [] == 'vertex' x 411-- biclique [] [y] == 'vertex' y 412-- biclique [x1,x2] [y1,y2] == 'edges' [(x1,y1), (x1,y2), (x2,y1), (x2,y2)] 413-- biclique xs ys == 'connect' ('vertices' xs) ('vertices' ys) 414-- @ 415biclique :: Graph g => [Vertex g] -> [Vertex g] -> g 416biclique xs [] = vertices xs 417biclique [] ys = vertices ys 418biclique xs ys = connect (vertices xs) (vertices ys) 419 420-- | The /star/ formed by a centre vertex connected to a list of leaves. 421-- Complexity: /O(L)/ time, memory and size, where /L/ is the length of the 422-- given list. 423-- 424-- @ 425-- star x [] == 'vertex' x 426-- star x [y] == 'edge' x y 427-- star x [y,z] == 'edges' [(x,y), (x,z)] 428-- star x ys == 'connect' ('vertex' x) ('vertices' ys) 429-- @ 430star :: Graph g => Vertex g -> [Vertex g] -> g 431star x [] = vertex x 432star x ys = connect (vertex x) (vertices ys) 433 434-- | The /tree graph/ constructed from a given 'Tree' data structure. 435-- Complexity: /O(T)/ time, memory and size, where /T/ is the size of the 436-- given tree (i.e. the number of vertices in the tree). 437-- 438-- @ 439-- tree (Node x []) == 'vertex' x 440-- tree (Node x [Node y [Node z []]]) == 'path' [x,y,z] 441-- tree (Node x [Node y [], Node z []]) == 'star' x [y,z] 442-- tree (Node 1 [Node 2 [], Node 3 [Node 4 [], Node 5 []]]) == 'edges' [(1,2), (1,3), (3,4), (3,5)] 443-- @ 444tree :: Graph g => Tree (Vertex g) -> g 445tree (Node x []) = vertex x 446tree (Node x f ) = star x (map rootLabel f) 447 `overlay` forest (filter (not . null . subForest) f) 448 449-- | The /forest graph/ constructed from a given 'Forest' data structure. 450-- Complexity: /O(F)/ time, memory and size, where /F/ is the size of the 451-- given forest (i.e. the number of vertices in the forest). 452-- 453-- @ 454-- forest [] == 'empty' 455-- forest [x] == 'tree' x 456-- forest [Node 1 [Node 2 [], Node 3 []], Node 4 [Node 5 []]] == 'edges' [(1,2), (1,3), (4,5)] 457-- forest == 'overlays' . 'map' 'tree' 458-- @ 459forest :: Graph g => Forest (Vertex g) -> g 460forest = overlays . map tree 461