Copyright | (c) Andrey Mokhov 2016-2019 |
---|---|
License | MIT (see the file LICENSE) |
Maintainer | andrey.mokhov@gmail.com |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
Alga is a library for algebraic construction and manipulation of graphs in Haskell. See this paper for the motivation behind the library, the underlying theory, and implementation details.
This module defines the AdjacencyMap
data type for edge-labelled graphs, as
well as associated operations and algorithms. AdjacencyMap
is an instance
of the Graph
type class, which can be used for polymorphic graph
construction and manipulation.
Synopsis
- data AdjacencyMap e a
- adjacencyMap :: AdjacencyMap e a -> Map a (Map a e)
- empty :: AdjacencyMap e a
- vertex :: a -> AdjacencyMap e a
- edge :: (Eq e, Monoid e, Ord a) => e -> a -> a -> AdjacencyMap e a
- (-<) :: a -> e -> (a, e)
- (>-) :: (Eq e, Monoid e, Ord a) => (a, e) -> a -> AdjacencyMap e a
- overlay :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
- connect :: (Eq e, Monoid e, Ord a) => e -> AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a
- vertices :: Ord a => [a] -> AdjacencyMap e a
- edges :: (Eq e, Monoid e, Ord a) => [(e, a, a)] -> AdjacencyMap e a
- overlays :: (Eq e, Monoid e, Ord a) => [AdjacencyMap e a] -> AdjacencyMap e a
- fromAdjacencyMaps :: (Eq e, Monoid e, Ord a) => [(a, Map a e)] -> AdjacencyMap e a
- isSubgraphOf :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a -> Bool
- isEmpty :: AdjacencyMap e a -> Bool
- hasVertex :: Ord a => a -> AdjacencyMap e a -> Bool
- hasEdge :: Ord a => a -> a -> AdjacencyMap e a -> Bool
- edgeLabel :: (Monoid e, Ord a) => a -> a -> AdjacencyMap e a -> e
- vertexCount :: AdjacencyMap e a -> Int
- edgeCount :: AdjacencyMap e a -> Int
- vertexList :: AdjacencyMap e a -> [a]
- edgeList :: AdjacencyMap e a -> [(e, a, a)]
- vertexSet :: AdjacencyMap e a -> Set a
- edgeSet :: (Eq a, Eq e) => AdjacencyMap e a -> Set (e, a, a)
- preSet :: Ord a => a -> AdjacencyMap e a -> Set a
- postSet :: Ord a => a -> AdjacencyMap e a -> Set a
- skeleton :: Ord a => AdjacencyMap e a -> AdjacencyMap a
- removeVertex :: Ord a => a -> AdjacencyMap e a -> AdjacencyMap e a
- removeEdge :: Ord a => a -> a -> AdjacencyMap e a -> AdjacencyMap e a
- replaceVertex :: (Eq e, Monoid e, Ord a) => a -> a -> AdjacencyMap e a -> AdjacencyMap e a
- replaceEdge :: (Eq e, Monoid e, Ord a) => e -> a -> a -> AdjacencyMap e a -> AdjacencyMap e a
- transpose :: (Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a
- gmap :: (Eq e, Monoid e, Ord a, Ord b) => (a -> b) -> AdjacencyMap e a -> AdjacencyMap e b
- emap :: (Eq f, Monoid f) => (e -> f) -> AdjacencyMap e a -> AdjacencyMap f a
- induce :: (a -> Bool) -> AdjacencyMap e a -> AdjacencyMap e a
- induceJust :: Ord a => AdjacencyMap e (Maybe a) -> AdjacencyMap e a
- closure :: (Eq e, Ord a, StarSemiring e) => AdjacencyMap e a -> AdjacencyMap e a
- reflexiveClosure :: (Ord a, Semiring e) => AdjacencyMap e a -> AdjacencyMap e a
- symmetricClosure :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a
- transitiveClosure :: (Eq e, Ord a, StarSemiring e) => AdjacencyMap e a -> AdjacencyMap e a
- consistent :: (Ord a, Eq e, Monoid e) => AdjacencyMap e a -> Bool
Data structure
data AdjacencyMap e a Source #
Edge-labelled graphs, where the type variable e
stands for edge labels.
For example, AdjacencyMap
Bool
a
is isomorphic to unlabelled graphs
defined in the top-level module Algebra.Graph.AdjacencyMap, where False
and True
denote the lack of and the existence of an unlabelled edge,
respectively.
Instances
adjacencyMap :: AdjacencyMap e a -> Map a (Map a e) Source #
The adjacency map of an edge-labelled graph: each vertex is associated with a map from its direct successors to the corresponding edge labels.
Basic graph construction primitives
empty :: AdjacencyMap e a Source #
Construct the empty graph. Complexity: O(1) time and memory.
isEmpty
empty == TruehasVertex
x empty == FalsevertexCount
empty == 0edgeCount
empty == 0
vertex :: a -> AdjacencyMap e a Source #
Construct the graph comprising a single isolated vertex. Complexity: O(1) time and memory.
isEmpty
(vertex x) == FalsehasVertex
x (vertex y) == (x == y)vertexCount
(vertex x) == 1edgeCount
(vertex x) == 0
edge :: (Eq e, Monoid e, Ord a) => e -> a -> a -> AdjacencyMap e a Source #
Construct the graph comprising a single edge. Complexity: O(1) time, memory.
edge e x y ==connect
e (vertex
x) (vertex
y) edgezero
x y ==vertices
[x,y]hasEdge
x y (edge e x y) == (e /=zero
)edgeLabel
x y (edge e x y) == eedgeCount
(edge e x y) == if e ==zero
then 0 else 1vertexCount
(edge e 1 1) == 1vertexCount
(edge e 1 2) == 2
(-<) :: a -> e -> (a, e) infixl 5 Source #
The left-hand part of a convenient ternary-ish operator x-<e>-y
for
creating labelled edges.
x -<e>- y == edge
e x y
(>-) :: (Eq e, Monoid e, Ord a) => (a, e) -> a -> AdjacencyMap e a infixl 5 Source #
The right-hand part of a convenient ternary-ish operator x-<e>-y
for
creating labelled edges.
x -<e>- y == edge
e x y
overlay :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a Source #
Overlay two graphs. This is a commutative, associative and idempotent
operation with the identity empty
.
Complexity: O((n + m) * log(n)) time and O(n + m) memory.
isEmpty
(overlay x y) ==isEmpty
x &&isEmpty
yhasVertex
z (overlay x y) ==hasVertex
z x ||hasVertex
z yvertexCount
(overlay x y) >=vertexCount
xvertexCount
(overlay x y) <=vertexCount
x +vertexCount
yedgeCount
(overlay x y) >=edgeCount
xedgeCount
(overlay x y) <=edgeCount
x +edgeCount
yvertexCount
(overlay 1 2) == 2edgeCount
(overlay 1 2) == 0
Note: overlay
composes edges in parallel using the operator <+>
with
zero
acting as the identity:
edgeLabel
x y $ overlay (edge
e x y) (edge
zero
x y) == eedgeLabel
x y $ overlay (edge
e x y) (edge
f x y) == e<+>
f
Furthermore, when applied to transitive graphs, overlay
composes edges in
sequence using the operator <.>
with one
acting as the identity:
edgeLabel
x z $transitiveClosure
(overlay (edge
e x y) (edge
one
y z)) == eedgeLabel
x z $transitiveClosure
(overlay (edge
e x y) (edge
f y z)) == e<.>
f
connect :: (Eq e, Monoid e, Ord a) => e -> AdjacencyMap e a -> AdjacencyMap e a -> AdjacencyMap e a Source #
Connect two graphs with edges labelled by a given label. When applied to
the same labels, this is an associative operation with the identity empty
,
which distributes over overlay
and obeys the decomposition axiom.
Complexity: O((n + m) * log(n)) time and O(n + m) memory. Note that the
number of edges in the resulting graph is quadratic with respect to the
number of vertices of the arguments: m = O(m1 + m2 + n1 * n2).
isEmpty
(connect e x y) ==isEmpty
x &&isEmpty
yhasVertex
z (connect e x y) ==hasVertex
z x ||hasVertex
z yvertexCount
(connect e x y) >=vertexCount
xvertexCount
(connect e x y) <=vertexCount
x +vertexCount
yedgeCount
(connect e x y) <=vertexCount
x *vertexCount
y +edgeCount
x +edgeCount
yvertexCount
(connect e 1 2) == 2edgeCount
(connect e 1 2) == if e ==zero
then 0 else 1
vertices :: Ord a => [a] -> AdjacencyMap e a Source #
Construct the graph comprising a given list of isolated vertices. Complexity: O(L * log(L)) time and O(L) memory, where L is the length of the given list.
vertices [] ==empty
vertices [x] ==vertex
xhasVertex
x . vertices ==elem
xvertexCount
. vertices ==length
.nub
vertexSet
. vertices == Set.fromList
overlays :: (Eq e, Monoid e, Ord a) => [AdjacencyMap e a] -> AdjacencyMap e a Source #
fromAdjacencyMaps :: (Eq e, Monoid e, Ord a) => [(a, Map a e)] -> AdjacencyMap e a Source #
Construct a graph from a list of adjacency sets. Complexity: O((n + m) * log(n)) time and O(n + m) memory.
fromAdjacencyMaps [] ==empty
fromAdjacencyMaps [(x, Map.empty
)] ==vertex
x fromAdjacencyMaps [(x, Map.singleton
y e)] == if e ==zero
thenvertices
[x,y] elseedge
e x yoverlay
(fromAdjacencyMaps xs) (fromAdjacencyMaps ys) == fromAdjacencyMaps (xs++
ys)
Relations on graphs
isSubgraphOf :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a -> Bool Source #
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.
isSubgraphOfempty
x == True isSubgraphOf (vertex
x)empty
== False isSubgraphOf x y ==> x <= y
Graph properties
isEmpty :: AdjacencyMap e a -> Bool Source #
Check if a graph is empty. Complexity: O(1) time.
isEmptyempty
== True isEmpty (overlay
empty
empty
) == True isEmpty (vertex
x) == False isEmpty (removeVertex
x $vertex
x) == True isEmpty (removeEdge
x y $edge
e x y) == False
hasVertex :: Ord a => a -> AdjacencyMap e a -> Bool Source #
Check if a graph contains a given vertex. Complexity: O(log(n)) time.
hasVertex xempty
== False hasVertex x (vertex
y) == (x == y) hasVertex x .removeVertex
x ==const
False
vertexCount :: AdjacencyMap e a -> Int Source #
The number of vertices in a graph. Complexity: O(1) time.
vertexCountempty
== 0 vertexCount (vertex
x) == 1 vertexCount ==length
.vertexList
vertexCount x < vertexCount y ==> x < y
edgeCount :: AdjacencyMap e a -> Int Source #
vertexList :: AdjacencyMap e a -> [a] Source #
edgeList :: AdjacencyMap e a -> [(e, a, a)] Source #
vertexSet :: AdjacencyMap e a -> Set a Source #
skeleton :: Ord a => AdjacencyMap e a -> AdjacencyMap a Source #
Convert a graph to the corresponding unlabelled AdjacencyMap
by
forgetting labels on all non-zero
edges.
Complexity: O((n + m) * log(n)) time and memory.
hasEdge
x y ==hasEdge
x y . skeleton
Graph transformation
removeVertex :: Ord a => a -> AdjacencyMap e a -> AdjacencyMap e a Source #
removeEdge :: Ord a => a -> a -> AdjacencyMap e a -> AdjacencyMap e a Source #
Remove an edge from a given graph. Complexity: O(log(n)) time.
removeEdge x y (edge
e 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
replaceVertex :: (Eq e, Monoid e, Ord a) => a -> a -> AdjacencyMap e a -> AdjacencyMap e a Source #
The function
replaces vertex replaceVertex
x yx
with vertex y
in a
given AdjacencyMap
. If y
already exists, x
and y
will be merged.
Complexity: O((n + m) * log(n)) time.
replaceVertex x x == id replaceVertex x y (vertex
x) ==vertex
y replaceVertex x y ==gmap
(\v -> if v == x then y else v)
replaceEdge :: (Eq e, Monoid e, Ord a) => e -> a -> a -> AdjacencyMap e a -> AdjacencyMap e a Source #
transpose :: (Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a Source #
gmap :: (Eq e, Monoid e, Ord a, Ord b) => (a -> b) -> AdjacencyMap e a -> AdjacencyMap e b Source #
Transform a graph by applying a function to each of its vertices. This is
similar to Functor
's fmap
but can be used with non-fully-parametric
AdjacencyMap
.
Complexity: O((n + m) * log(n)) time.
gmap fempty
==empty
gmap f (vertex
x) ==vertex
(f x) gmap f (edge
e x y) ==edge
e (f x) (f y) gmapid
==id
gmap f . gmap g == gmap (f . g)
emap :: (Eq f, Monoid f) => (e -> f) -> AdjacencyMap e a -> AdjacencyMap f a Source #
Transform a graph by applying a function h
to each of its edge labels.
Complexity: O((n + m) * log(n)) time.
The function h
is required to be a homomorphism on the underlying type of
labels e
. At the very least it must preserve zero
and <+>
:
hzero
==zero
h x<+>
h y == h (x<+>
y)
If e
is also a semiring, then h
must also preserve the multiplicative
structure:
hone
==one
h x<.>
h y == h (x<.>
y)
If the above requirements hold, then the implementation provides the following guarantees.
emap hempty
==empty
emap h (vertex
x) ==vertex
x emap h (edge
e x y) ==edge
(h e) x y emap h (overlay
x y) ==overlay
(emap h x) (emap h y) emap h (connect
e x y) ==connect
(h e) (emap h x) (emap h y) emapid
==id
emap g . emap h == emap (g . h)
induce :: (a -> Bool) -> AdjacencyMap e a -> AdjacencyMap e a Source #
Construct the induced subgraph of a given graph by removing the vertices that do not satisfy a given predicate. Complexity: O(n + m) time, 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
induceJust :: Ord a => AdjacencyMap e (Maybe a) -> AdjacencyMap e a Source #
Relational operations
closure :: (Eq e, Ord a, StarSemiring e) => AdjacencyMap e a -> AdjacencyMap e a Source #
Compute the reflexive and transitive closure of a graph over the underlying star semiring using the Warshall-Floyd-Kleene algorithm.
closureempty
==empty
closure (vertex
x) ==edge
one
x x closure (edge
e x x) ==edge
one
x x closure (edge
e x y) ==edges
[(one
,x,x), (e,x,y), (one
,y,y)] closure ==reflexiveClosure
.transitiveClosure
closure ==transitiveClosure
.reflexiveClosure
closure . closure == closurepostSet
x (closure y) == Set.fromList
(reachable
x y)
reflexiveClosure :: (Ord a, Semiring e) => AdjacencyMap e a -> AdjacencyMap e a Source #
Compute the reflexive closure of a graph over the underlying semiring by
adding a self-loop of weight one
to every vertex.
Complexity: O(n * log(n)) time.
reflexiveClosureempty
==empty
reflexiveClosure (vertex
x) ==edge
one
x x reflexiveClosure (edge
e x x) ==edge
one
x x reflexiveClosure (edge
e x y) ==edges
[(one
,x,x), (e,x,y), (one
,y,y)] reflexiveClosure . reflexiveClosure == reflexiveClosure
symmetricClosure :: (Eq e, Monoid e, Ord a) => AdjacencyMap e a -> AdjacencyMap e a Source #
Compute the symmetric closure of a graph by overlaying it with its own transpose. Complexity: O((n + m) * log(n)) time.
symmetricClosureempty
==empty
symmetricClosure (vertex
x) ==vertex
x symmetricClosure (edge
e x y) ==edges
[(e,x,y), (e,y,x)] symmetricClosure x ==overlay
x (transpose
x) symmetricClosure . symmetricClosure == symmetricClosure
transitiveClosure :: (Eq e, Ord a, StarSemiring e) => AdjacencyMap e a -> AdjacencyMap e a Source #
Compute the transitive closure of a graph over the underlying star semiring using a modified version of the Warshall-Floyd-Kleene algorithm, which omits the reflexivity step.
transitiveClosureempty
==empty
transitiveClosure (vertex
x) ==vertex
x transitiveClosure (edge
e x y) ==edge
e x y transitiveClosure . transitiveClosure == transitiveClosure
Miscellaneous
consistent :: (Ord a, Eq e, Monoid e) => AdjacencyMap e a -> Bool Source #
Check that the internal graph representation is consistent, i.e. that all
edges refer to existing vertices, and there are no zero
-labelled edges. It
should be impossible to create an inconsistent adjacency map, and we use this
function in testing.