| Copyright | (c) Andrey Mokhov 2016-2018 |
|---|---|
| License | MIT (see the file LICENSE) |
| Maintainer | andrey.mokhov@gmail.com |
| Stability | unstable |
| Safe Haskell | None |
| Language | Haskell2010 |
Algebra.Graph.IntAdjacencyMap.Internal
Description
This module exposes the implementation of adjacency maps. The API is unstable and unsafe, and is exposed only for documentation. You should use the non-internal module Algebra.Graph.IntAdjacencyMap instead.
- data IntAdjacencyMap = AM {
- adjacencyMap :: !(IntMap IntSet)
- graphKL :: GraphKL
- mkAM :: IntMap IntSet -> IntAdjacencyMap
- consistent :: IntAdjacencyMap -> Bool
- data GraphKL = GraphKL {
- toGraphKL :: Graph
- fromVertexKL :: Vertex -> Int
- toVertexKL :: Int -> Maybe Vertex
- mkGraphKL :: IntMap IntSet -> GraphKL
Adjacency map implementation
data IntAdjacencyMap Source #
The IntAdjacencyMap data type represents a graph by a map of vertices to
their adjacency sets. 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 Show instance is defined using basic graph construction primitives:
show (empty :: IntAdjacencyMap Int) == "empty" show (1 :: IntAdjacencyMap Int) == "vertex 1" show (1 + 2 :: IntAdjacencyMap Int) == "vertices [1,2]" show (1 * 2 :: IntAdjacencyMap Int) == "edge 1 2" show (1 * 2 * 3 :: IntAdjacencyMap Int) == "edges [(1,2),(1,3),(2,3)]" show (1 * 2 + 3 :: IntAdjacencyMap Int) == "overlay (vertex 3) (edge 1 2)"
The Eq instance satisfies all axioms of algebraic graphs:
overlayis commutative and associative:x + y == y + x x + (y + z) == (x + y) + z
connectis associative and hasemptyas the identity:x * empty == x empty * x == x x * (y * z) == (x * y) * z
connectdistributes overoverlay:x * (y + z) == x * y + x * z (x + y) * z == x * z + y * z
connectcan be decomposed:x * y * z == x * y + x * z + y * z
The following useful theorems can be proved from the above set of axioms.
overlayhasemptyas the identity and is idempotent:x + empty == x empty + x == x x + x == xAbsorption 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 and m will denote the number of vertices and edges in the graph, respectively.
mkAM :: IntMap IntSet -> IntAdjacencyMap Source #
Construct an AdjacencyMap from a map of successor sets and (lazily)
compute the corresponding King-Launchbury representation.
Note: this function is for internal use only.
consistent :: IntAdjacencyMap -> Bool Source #
Check if the internal graph representation is consistent, i.e. that all edges refer to existing vertices. It should be impossible to create an inconsistent adjacency map, and we use this function in testing. Note: this function is for internal use only.
consistentempty== True consistent (vertexx) == True consistent (overlayx y) == True consistent (connectx y) == True consistent (edgex y) == True consistent (edgesxs) == True consistent (graphxs ys) == True consistent (fromAdjacencyListxs) == True
Interoperability with King-Launchbury graphs
GraphKL encapsulates King-Launchbury graphs, which are implemented in
the Data.Graph module of the containers library.
Note: this data structure is for internal use only.
If mkGraphKL (adjacencyMap g) == h then the following holds:
map (fromVertexKLh) (vertices$toGraphKLh) ==vertexListg map (\(x, y) -> (fromVertexKLh x,fromVertexKLh y)) (edges$toGraphKLh) ==edgeListg
Constructors
| GraphKL | |
Fields
| |