Safe Haskell | None |
---|---|
Language | Haskell2010 |
Topograph
Contents
Description
Tools to work with Directed Acyclic Graphs, by taking advantage of topological sorting.
- SPDX-License-Id: BSD-3-Clause
- Author: Oleg Grenrus
Synopsis
- data G v a = G {}
- runG :: forall v r. Ord v => Map v (Set v) -> (forall i. Ord i => G v i -> r) -> Either [v] r
- runG' :: forall v r. Ord v => Map v (Set v) -> (forall i. Ord i => G v i -> r) -> Maybe r
- allPaths :: forall v a. Ord a => G v a -> a -> a -> [[a]]
- allPaths' :: forall v a. Ord a => G v a -> a -> a -> [a] -> [[a]]
- allPathsTree :: forall v a. Ord a => G v a -> a -> a -> Maybe (Tree a)
- dfs :: forall v a. Ord a => G v a -> a -> [[a]]
- dfsTree :: forall v a. Ord a => G v a -> a -> Tree a
- longestPathLengths :: Ord a => G v a -> a -> [Int]
- transpose :: forall v a. Ord a => G v a -> G v (Down a)
- reduction :: Ord a => G v a -> G v a
- closure :: Ord a => G v a -> G v a
- edgesSet :: Ord a => G v a -> Set (a, a)
- adjacencyMap :: Ord v => G v a -> Map v (Set v)
- adjacencyList :: Ord v => G v a -> [(v, [v])]
- treePairs :: Tree a -> [(a, a)]
- pairs :: [a] -> [(a, a)]
- getDown :: Down a -> a
Graph
Graph used in examples (with all arrows pointing down)
a ----- / | \ \ b | x \ \ | / \ | d \ | ------- e
See https://en.wikipedia.org/wiki/Transitive_reduction for a picture.
>>>
let example :: Map Char (Set Char); example = M.map S.fromList $ M.fromList [('a', "bxde"), ('b', "d"), ('x', "de"), ('d', "e"), ('e', "")]
>>>
:set -XRecordWildCards
>>>
import Data.Monoid (All (..))
>>>
import Data.Foldable (traverse_)
>>>
let fmap2 = fmap . fmap
>>>
let fmap3 = fmap . fmap2
>>>
let traverse2_ = traverse_ . traverse_
>>>
let traverse3_ = traverse_ . traverse2_
>>>
let dispTree :: Show a => Tree a -> IO (); dispTree = go 0 where go i (T.Node x xs) = putStrLn (replicate (i * 2) ' ' ++ show x) >> traverse_ (go (succ i)) xs
Graph representation.
Constructors
G | |
Fields
|
Arguments
:: Ord v | |
=> Map v (Set v) | Adjacency Map |
-> (forall i. Ord i => G v i -> r) | function on linear indices |
-> Either [v] r | Return the result or a cycle in the graph. |
Run action on topologically sorted representation of the graph.
Examples
Topological sorting
>>>
runG example $ \G {..} -> map gFromVertex gVertices
Right "axbde"
Vertices are sorted
>>>
runG example $ \G {..} -> map gFromVertex $ sort gVertices
Right "axbde"
Outgoing edges
>>>
runG example $ \G {..} -> map (map gFromVertex . gEdges) gVertices
Right ["xbde","de","d","e",""]
Note: edges are always larger than source vertex:
>>>
runG example $ \G {..} -> getAll $ foldMap (\a -> foldMap (\b -> All (a < b)) (gEdges a)) gVertices
Right True
Not DAG
>>>
let loop = M.map S.fromList $ M.fromList [('a', "bx"), ('b', "cx"), ('c', "ax"), ('x', "")]
>>>
runG loop $ \G {..} -> map gFromVertex gVertices
Left "abc"
>>>
runG (M.singleton 'a' (S.singleton 'a')) $ \G {..} -> map gFromVertex gVertices
Left "aa"
All paths
allPaths :: forall v a. Ord a => G v a -> a -> a -> [[a]] Source #
All paths from a
to b
. Note that every path has at least 2 elements, start and end.
Use allPaths'
for the intermediate steps only.
>>>
runG example $ \g@G{..} -> fmap3 gFromVertex $ allPaths g <$> gToVertex 'a' <*> gToVertex 'e'
Right (Just ["axde","axe","abde","ade","ae"])
>>>
runG example $ \g@G{..} -> fmap3 gFromVertex $ allPaths g <$> gToVertex 'a' <*> gToVertex 'a'
Right (Just [])
allPaths' :: forall v a. Ord a => G v a -> a -> a -> [a] -> [[a]] Source #
allPaths
without begin and end elements.
>>>
runG example $ \g@G{..} -> fmap3 gFromVertex $ allPaths' g <$> gToVertex 'a' <*> gToVertex 'e' <*> pure []
Right (Just ["xd","x","bd","d",""])
allPathsTree :: forall v a. Ord a => G v a -> a -> a -> Maybe (Tree a) Source #
Like allPaths
but return a Tree
.
>>>
let t = runG example $ \g@G{..} -> fmap3 gFromVertex $ allPathsTree g <$> gToVertex 'a' <*> gToVertex 'e'
>>>
fmap3 (T.foldTree $ \a bs -> if null bs then [[a]] else concatMap (map (a:)) bs) t
Right (Just (Just ["axde","axe","abde","ade","ae"]))
>>>
fmap3 (S.fromList . treePairs) t
Right (Just (Just (fromList [('a','b'),('a','d'),('a','e'),('a','x'),('b','d'),('d','e'),('x','d'),('x','e')])))
>>>
let ls = runG example $ \g@G{..} -> fmap3 gFromVertex $ allPaths g <$> gToVertex 'a' <*> gToVertex 'e'
>>>
fmap2 (S.fromList . concatMap pairs) ls
Right (Just (fromList [('a','b'),('a','d'),('a','e'),('a','x'),('b','d'),('d','e'),('x','d'),('x','e')]))
>>>
traverse3_ dispTree t
'a' 'x' 'd' 'e' 'e' 'b' 'd' 'e' 'd' 'e' 'e'
>>>
traverse3_ (putStrLn . T.drawTree . fmap show) t
'a' | +- 'x' | | | +- 'd' | | | | | `- 'e' | | | `- 'e' ...
DFS
dfs :: forall v a. Ord a => G v a -> a -> [[a]] Source #
Depth-first paths starting at a vertex.
>>>
runG example $ \g@G{..} -> fmap3 gFromVertex $ dfs g <$> gToVertex 'x'
Right (Just ["xde","xe"])
Longest path
longestPathLengths :: Ord a => G v a -> a -> [Int] Source #
Longest paths lengths starting from a vertex.
>>>
runG example $ \g@G{..} -> longestPathLengths g <$> gToVertex 'a'
Right (Just [0,1,1,2,3])
>>>
runG example $ \G {..} -> map gFromVertex gVertices
Right "axbde"
>>>
runG example $ \g@G{..} -> longestPathLengths g <$> gToVertex 'b'
Right (Just [0,0,0,1,2])
Transpose
transpose :: forall v a. Ord a => G v a -> G v (Down a) Source #
Graph with all edges reversed.
>>>
runG example $ adjacencyList . transpose
Right [('a',""),('b',"a"),('d',"abx"),('e',"adx"),('x',"a")]
Properties
Commutes with closure
>>>
runG example $ adjacencyList . closure . transpose
Right [('a',""),('b',"a"),('d',"abx"),('e',"abdx"),('x',"a")]
>>>
runG example $ adjacencyList . transpose . closure
Right [('a',""),('b',"a"),('d',"abx"),('e',"abdx"),('x',"a")]
Commutes with reduction
>>>
runG example $ adjacencyList . reduction . transpose
Right [('a',""),('b',"a"),('d',"bx"),('e',"d"),('x',"a")]
>>>
runG example $ adjacencyList . transpose . reduction
Right [('a',""),('b',"a"),('d',"bx"),('e',"d"),('x',"a")]
Transitive reduction
reduction :: Ord a => G v a -> G v a Source #
Transitive reduction.
Smallest graph, such that if there is a path from u to v in the original graph, then there is also such a path in the reduction.
>>>
runG example $ \g -> adjacencyList $ reduction g
Right [('a',"bx"),('b',"d"),('d',"e"),('e',""),('x',"d")]
Taking closure first doesn't matter:
>>>
runG example $ \g -> adjacencyList $ reduction $ closure g
Right [('a',"bx"),('b',"d"),('d',"e"),('e',""),('x',"d")]
Transitive closure
closure :: Ord a => G v a -> G v a Source #
Transitive closure.
A graph, such that if there is a path from u to v in the original graph, then there is an edge from u to v in the closure.
>>>
runG example $ \g -> adjacencyList $ closure g
Right [('a',"bdex"),('b',"de"),('d',"e"),('e',""),('x',"de")]
Taking reduction first, doesn't matter:
>>>
runG example $ \g -> adjacencyList $ closure $ reduction g
Right [('a',"bdex"),('b',"de"),('d',"e"),('e',""),('x',"de")]
Query
edgesSet :: Ord a => G v a -> Set (a, a) Source #
>>>
runG example $ \g@G{..} -> map (\(a,b) -> [gFromVertex a, gFromVertex b]) $ S.toList $ edgesSet g
Right ["ax","ab","ad","ae","xd","xe","bd","de"]
adjacencyMap :: Ord v => G v a -> Map v (Set v) Source #
Recover adjacency map representation from the G
.
>>>
runG example adjacencyMap
Right (fromList [('a',fromList "bdex"),('b',fromList "d"),('d',fromList "e"),('e',fromList ""),('x',fromList "de")])
adjacencyList :: Ord v => G v a -> [(v, [v])] Source #
Adjacency list representation of G
.
>>>
runG example adjacencyList
Right [('a',"bdex"),('b',"d"),('d',"e"),('e',""),('x',"de")]