Copyright | (c) Anton Lorenzen Andrey Mokhov 2016-2018 |
---|---|
License | MIT (see the file LICENSE) |
Maintainer | anfelor@posteo.de, andrey.mokhov@gmail.com |
Stability | unstable |
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 provides primitives for interoperability between this library and the Data.Graph module of the containers library. It is for internal use only and may be removed without notice at any point.
Synopsis
- data GraphKL a = GraphKL {
- toGraphKL :: Graph
- fromVertexKL :: Vertex -> a
- toVertexKL :: a -> Maybe Vertex
- fromAdjacencyMap :: Ord a => AdjacencyMap a -> GraphKL a
- fromAdjacencyIntMap :: AdjacencyIntMap -> GraphKL Int
- dfsForest :: GraphKL a -> Forest a
- dfsForestFrom :: [a] -> GraphKL a -> Forest a
- dfs :: [a] -> GraphKL a -> [a]
- topSort :: GraphKL a -> [a]
- scc :: Ord a => AdjacencyMap a -> AdjacencyMap (AdjacencyMap a)
Data type and construction
GraphKL
encapsulates King-Launchbury graphs, which are implemented in
the Data.Graph module of the containers
library.
GraphKL | |
|
fromAdjacencyMap :: Ord a => AdjacencyMap a -> GraphKL a Source #
Build GraphKL
from an AdjacencyMap
. If fromAdjacencyMap g == h
then the following holds:
map (fromVertexKL
h) (vertices
$toGraphKL
h) ==vertexList
g map (\(x, y) -> (fromVertexKL
h x,fromVertexKL
h y)) (edges
$toGraphKL
h) ==edgeList
gtoGraphKL
(fromAdjacencyMap (1 * 2 + 3 * 1)) ==array
(0,2) [(0,[1]), (1,[]), (2,[0])]toGraphKL
(fromAdjacencyMap (1 * 2 + 2 * 1)) ==array
(0,1) [(0,[1]), (1,[0])]
fromAdjacencyIntMap :: AdjacencyIntMap -> GraphKL Int Source #
Build GraphKL
from an AdjacencyIntMap
. If
fromAdjacencyIntMap g == h
then the following holds:
map (fromVertexKL
h) (vertices
$toGraphKL
h) ==toAscList
(vertexIntSet
g) map (\(x, y) -> (fromVertexKL
h x,fromVertexKL
h y)) (edges
$toGraphKL
h) ==edgeList
gtoGraphKL
(fromAdjacencyIntMap (1 * 2 + 3 * 1)) ==array
(0,2) [(0,[1]), (1,[]), (2,[0])]toGraphKL
(fromAdjacencyIntMap (1 * 2 + 2 * 1)) ==array
(0,1) [(0,[1]), (1,[0])]
Basic algorithms
dfsForest :: GraphKL a -> Forest a Source #
Compute the depth-first search forest of a graph.
In the following examples we will use the helper function:
(%) :: (GraphKL Int -> a) ->AdjacencyMap
Int -> a a % g = a $fromAdjacencyMap
g
for greater clarity.
forest
(dfsForest %edge
1 1) ==vertex
1forest
(dfsForest %edge
1 2) ==edge
1 2forest
(dfsForest %edge
2 1) ==vertices
[1, 2]isSubgraphOf
(forest
$ dfsForest % x) x == True dfsForest %forest
(dfsForest % x) == dfsForest % x dfsForest %vertices
vs ==map
(\v -> Node v []) (nub
$sort
vs)dfsForestFrom
(vertexList
x) % x == dfsForest % x dfsForest % (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1 , subForest = [ Node { rootLabel = 5 , subForest = [] }]} , Node { rootLabel = 3 , subForest = [ Node { rootLabel = 4 , subForest = [] }]}]
dfsForestFrom :: [a] -> GraphKL a -> Forest a Source #
Compute the depth-first search forest of a graph, searching from each of the given vertices in order. Note that the resulting forest does not necessarily span the whole graph, as some vertices may be unreachable.
In the following examples we will use the helper function:
(%) :: (GraphKL Int -> a) ->AdjacencyMap
Int -> a a % g = a $fromAdjacencyMap
g
for greater clarity.
forest
(dfsForestFrom [1] %edge
1 1) ==vertex
1forest
(dfsForestFrom [1] %edge
1 2) ==edge
1 2forest
(dfsForestFrom [2] %edge
1 2) ==vertex
2forest
(dfsForestFrom [3] %edge
1 2) ==empty
forest
(dfsForestFrom [2, 1] %edge
1 2) ==vertices
[1, 2]isSubgraphOf
(forest
$ dfsForestFrom vs % x) x == True dfsForestFrom (vertexList
x) % x ==dfsForest
% x dfsForestFrom vs %vertices
vs ==map
(\v -> Node v []) (nub
vs) dfsForestFrom [] % x == [] dfsForestFrom [1, 4] % (3 * (1 + 4) * (1 + 5)) == [ Node { rootLabel = 1 , subForest = [ Node { rootLabel = 5 , subForest = [] } , Node { rootLabel = 4 , subForest = [] }]
dfs :: [a] -> GraphKL a -> [a] Source #
Compute the list of vertices visited by the depth-first search in a graph, when searching from each of the given vertices in order.
In the following examples we will use the helper function:
(%) :: (GraphKL Int -> a) ->AdjacencyMap
Int -> a a % g = a $fromAdjacencyMap
g
for greater clarity.
dfs [1] %edge
1 1 == [1] dfs [1] %edge
1 2 == [1,2] dfs [2] %edge
1 2 == [2] dfs [3] %edge
1 2 == [] dfs [1,2] %edge
1 2 == [1,2] dfs [2,1] %edge
1 2 == [2,1] dfs [] % x == [] dfs [1,4] % (3 * (1 + 4) * (1 + 5)) == [1,5,4]isSubgraphOf
(vertices
$ dfs vs x) x == True
topSort :: GraphKL a -> [a] Source #
Compute the topological sort of a graph. Note that this function returns a result even if the graph is cyclic.
In the following examples we will use the helper function:
(%) :: (GraphKL Int -> a) ->AdjacencyMap
Int -> a a % g = a $fromAdjacencyMap
g
for greater clarity.
topSort % (1 * 2 + 3 * 1) == [3,1,2] topSort % (1 * 2 + 2 * 1) == [1,2]
scc :: Ord a => AdjacencyMap a -> AdjacencyMap (AdjacencyMap a) Source #