Topograph

Tools to work with Directed Acyclic Graphs, by taking advantage of topological sorting.

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

data G v a

Graph representation.

Constructors

G

Fields

• gVertices :: [a]

  all vertices, in topological order.

• gFromVertex :: a -> v

  retrieve original vertex data. O(1)

• gToVertex :: v -> Maybe a

  O(log n)

• gEdges :: a -> [a]

  Outgoing edges.

• gDiff :: a -> a -> Int

  Upper bound of the path length. Negative if there aren't path. O(1)

• gVerticeCount :: Int
• gToInt :: a -> Int

runG

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"

runG'

Arguments

:: Ord v

=> Map v (Set v)

Adjacency Map

-> (forall i. Ord i => G v i -> r)

function on linear indices

-> Maybe r

Return the result or Nothing if there is a cycle.

Like runG but returns Maybe

All paths

allPaths :: forall v a. Ord a => G v a -> a -> a -> [[a]]

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]]

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)

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]]

Depth-first paths starting at a vertex.

>>> runG example $ \g@G{..} -> fmap3 gFromVertex $ dfs g <$> gToVertex 'x'
Right (Just ["xde","xe"])

dfsTree :: forall v a. Ord a => G v a -> a -> Tree a

like dfs but returns a Tree.

>>> traverse2_ dispTree $ runG example $ \g@G{..} -> fmap2 gFromVertex $ dfsTree g <$> gToVertex 'x'
'x'
  'd'
    'e'
  'e'

Longest path

longestPathLengths :: Ord a => G v a -> a -> [Int]

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)

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

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

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)

>>> 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)

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])]

Adjacency list representation of G.

>>> runG example adjacencyList
Right [('a',"bdex"),('b',"d"),('d',"e"),('e',""),('x',"de")]

Helper functions

treePairs :: Tree a -> [(a, a)]

Like pairs but for Tree.

pairs :: [a] -> [(a, a)]

Consequtive pairs.

>>> pairs [1..10]
[(1,2),(2,3),(3,4),(4,5),(5,6),(6,7),(7,8),(8,9),(9,10)]

>>> pairs []
[]

getDown :: Down a -> a

Unwrap Down.