layered-graph-drawing-0.2.0.0: Layered Graph Drawing after Sugiyama
Safe HaskellSafe-Inferred
LanguageHaskell2010

Graph.GraphDrawing

Synopsis

Main interface

layeredGraphAndCols :: (NodeClass n, EdgeClass e, ShowGraph n e) => Bool -> CGraph n e -> (CGraphL n e, (Map GraphMoveX [UINode], Map Int ([Column], YBlockLines))) Source #

Also returns a map with Columns to allow navigation with arrows

layeredGraphWithSub :: (NodeClass n, EdgeClass e, ShowGraph n e) => Unbox UINode => Bool -> CGraph n e -> CGraphL n e Source #

layered graph drawing with subgraph layouting

type BoxMap Source #

Arguments

 = Map BoxId (Set UINode)

nodes inside the box

type ParentGraphOf Source #

Arguments

 = Map (Maybe BoxId) (Set BoxId)

children

deepestNesting :: (NodeClass n, EdgeClass e, Show n, Enum n, Show e, ExtractNodeType n) => CGraph n e -> (NestMap, BoxMap, ParentGraphOf) Source #

Layout a directed acyclic graph in several steps (Sugiyama) 1. Assign the nodes to several layers (longest path) 2. Dummy vertices for lines that are longer than a layer 3. Reduce crossings, place the longest path on top 4. Assign y-coordinates to the nodes so that long lines that pass several layers are as straight as possible

Similar to longestPathAlgo, we take the rightmost node (which is an output type node) and explore the graph from there to the left When a function is exploded the nesting value of every node of this subgraph is increased by one by the explosion (ExplodeImplode.hs). A difference of the nesting value of two adjacent nodes signals a new subgraph. This function returns a map of subgraphs with a nesting and which graph is embedded in another graph

sortLayers :: Ord a => (a, [[a]]) -> (a, [[a]]) Source #

addBoxId :: (Show a, EdgeAttribute el, Integral a, NodeClass a) => Graph a el -> a -> (a, Maybe BoxId) Source #

Y-coordinate assignment

primitiveYCoordinateAssignement :: (CGraph n e, [[UINode]]) -> CGraphL n e Source #

No spaces between the nodes. This is good for testing purposes, because it is simple

yCoordinateAssignement :: (NodeClass n, Show n, EdgeClass e, ExtractNodeType n, Show e, Enum n) => (CGraph n e, [[UINode]]) -> (CGraphL n e, [[UINode]]) Source #

See "Fast and Simple Horizontal Coordinate Assignment" (Brandes, Köpf)

yPos :: (Num a, Enum a, Ord k) => [[k]] -> Map k a Source #

type YN = (Y, (UINode, Bool)) Source #

data MYN Source #

Constructors

Single (Y, (UINode, Bool)) 
Middle (Y, (UINode, Bool)) 
UpLowMedian (Y, (UINode, Bool)) (Y, (UINode, Bool)) 

Instances

Instances details
Show MYN Source # 
Instance details

Defined in Graph.GraphDrawing

Methods

showsPrec :: Int -> MYN -> ShowS #

show :: MYN -> String #

showList :: [MYN] -> ShowS #

Eq MYN Source # 
Instance details

Defined in Graph.GraphDrawing

Methods

(==) :: MYN -> MYN -> Bool #

(/=) :: MYN -> MYN -> Bool #

Ord MYN Source # 
Instance details

Defined in Graph.GraphDrawing

Methods

compare :: MYN -> MYN -> Ordering #

(<) :: MYN -> MYN -> Bool #

(<=) :: MYN -> MYN -> Bool #

(>) :: MYN -> MYN -> Bool #

(>=) :: MYN -> MYN -> Bool #

max :: MYN -> MYN -> MYN #

min :: MYN -> MYN -> MYN #

toYN :: Bool -> (MYN, MYN) -> ((Y, (UINode, Bool)), (Y, (UINode, Bool))) Source #

getYN :: Bool -> MYN -> (Y, (UINode, Bool)) Source #

getY :: Bool -> MYN -> Y Source #

sweep2 :: (Median, Median) -> Bool -> ([(UINode, Bool)], [(UINode, Bool)]) -> [[(MYN, MYN)]] Source #

toNode :: ((a1, (a2, b1)), (a3, (b2, b3))) -> (a2, b2) Source #

type Insp = (Map Int (MYN, MYN), Map Int (MYN, MYN)) Source #

sweepForIndependentEdgeLists :: (NodeClass n, EdgeClass e) => CGraph n e -> (Median, Median) -> Set (UINode, UINode) -> (Bool, Bool) -> Insp -> (Y, Y) -> ([(UINode, Bool)], [(UINode, Bool)]) -> Set (MYN, MYN) -> [[(MYN, MYN)]] Source #

Takes two layers and returns a list of lists of independent edges. A list A of edges is independent of a list B of edges if every edge of A does not intersect or connect any edge of B. This sweeping should save some time because graphs often have edges crossing near to each other. The number of intersections has been reduced in crossingreduction. Because of this we can assume that most edges are quite short and rectangular to layer0 and layer1. A sweep in the parallel direction of the two layers should reduce the number of edges that have to be examined. The overall algorithm (sweep + resolve) should have a runtime more like n*log(n) instead of n², because we only have to search for conflicts inside of these independent lists. The Brandes-Köpf paper is not explaining very well how they find intersections between two layers. I doubt that the whole algorithm is O(n). It seems more like a quadratic runtime in the worst case. Even finding the number of intersections (without giving back the exact edges that intersect) is O(n log n), See: Simple and Efficient Bilayer Cross Counting by Barth, Mutzel, Jünger or chapter 33 of Cormen: Introduction to algorithms If several edges emanate from a node the algorithm takes (one of the) the median. (e.g. three edges have one median, 4 edges have two) The sweep works by looking at the next node in the two layers, and comparing which node deletes more edges and introduces less new edges from the set of edges to look at. Every edge has a start node (first appearing at its y-position) and an end node. A start node means adding an edge when its source or target node appears in one of the two layers, and the edge disappears when both its nodes have been swept over.

data EdgeTy a Source #

Either e0 prevails against all e1s or all e1s prevail against e0

Constructors

E0Prevails a 
E1Prevails a 
NoIntersect (a, a) 

Instances

Instances details
Show a => Show (EdgeTy a) Source # 
Instance details

Defined in Graph.GraphDrawing

Methods

showsPrec :: Int -> EdgeTy a -> ShowS #

show :: EdgeTy a -> String #

showList :: [EdgeTy a] -> ShowS #

Eq a => Eq (EdgeTy a) Source # 
Instance details

Defined in Graph.GraphDrawing

Methods

(==) :: EdgeTy a -> EdgeTy a -> Bool #

(/=) :: EdgeTy a -> EdgeTy a -> Bool #

resolveConflicts :: (Bool, Bool) -> [(MYN, MYN)] -> [(YN, YN)] Source #

resolveConfs :: (Bool, Bool) -> [(MYN, MYN)] -> Int -> [(MYN, MYN)] Source #

Compare all edges of a layer with each other. Worst case: O(n²). But n can shrink fast in every round and n is small, because of sweepForIndependentEdgeLists

isConsistent :: [EdgeTy (MYN, MYN)] -> EdgeTy Bool Source #

The resolveConflicts-algorithm has to be constructed in a consistent way It should be impossible that edge e has priority to edge x (keeping e), and another edge y has priority to edge e (deleting e). It would not be clear if e has to be deleted or not

conflict :: Bool -> (MYN, MYN) -> (MYN, MYN) -> EdgeTy (MYN, MYN) Source #

cases :: Bool -> (MYN, MYN) -> (MYN, MYN) -> EdgeTy (MYN, MYN) Source #

Given two edges that intersect or connect, which one will prevail?

align :: (EdgeClass e, Show n, NodeClass n, ExtractNodeType n, Show e, Enum n) => CGraph n e -> [[UINode]] -> [(UINode, UINode)] -> (Bool, Bool) -> Map UINode (X, Y) Source #

Similar to Brandes-Köpf but without arrays and no placement of blocks The basic algorithm is longest path. debugging can be done with graphviz, also uncomment line 533 in longestPath | otherwise

Longest Path for horizontal layers

longestPath :: (NodeClass n, EdgeClass e, ShowGraph n e) => [[(X, UINode)]] -> [UINode] -> Int -> CGraph n e -> [[UINode]] -> [(UINode, UINode)] -> Bool -> YBlockLines Source #

Longest Path for vertical layers

longestPathAlgo :: (NodeClass n, EdgeClass e, ShowGraph n e) => CGraph n e -> (CGraph n e, [[UINode]]) Source #

Every graph has a longest path, which is the center of attention for us Return layers of node ids This algorithm is a little bit more complicated because we have to connect nodes vertically, so that they are guaranteed to be all in one vertical layer All nodes before this vertical layer have to be placed in layers before we can proceed

partitionNodes :: EdgeClass e => CGraph n e -> Vector UINode -> (Vector UINode, Vector UINode) Source #

partition nodes into non-vertically connected nodes and vertically connected nodes

Special needs for function networks

addMissingInputNodes :: (NodeClass n, Show n, Show e, EdgeClass e) => CGraph n e -> CGraph n e Source #

Some functions don't have an input (e.g. True). But a function without input can only appear directly after a case node That's why we insert a connection node between this case node and the function node

arrangeMetaNodes :: (NodeClass n, Show n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]]) Source #

To prevent crossing reduction from changing the order of vertically connected nodes we insert them in the right order again

Add connection vertices

When a connection line passes several layers, connection nodes have to be added

addConnectionNs :: (NodeClass n, Show n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]]) Source #

Crossing reduction

crossingRed :: (NodeClass n, Show n, EdgeClass e, Show e, ExtractNodeType n, Enum n) => Int -> Bool -> (NestMap, [BoxId], ParentGraphOf) -> (CGraph n e, [[(UINode, Maybe BoxId)]]) -> (CGraph n e, [[(UINode, Maybe BoxId)]]) Source #

Crossing reduction is like taking a comb and aligning a chain of nodes from left to right and right to left until it is ordered with as little crossings as possible

first :: (Integral a, Num b1) => (a, b2) -> b1 Source #

fi :: (Integral a1, Num a2) => (a1, b) -> (a2, b) Source #

data Dir Source #

Constructors

LeftToRight 
RightToLeft 

Instances

Instances details
Show Dir Source # 
Instance details

Defined in Graph.GraphDrawing

Methods

showsPrec :: Int -> Dir -> ShowS #

show :: Dir -> String #

showList :: [Dir] -> ShowS #

crossR :: (NodeClass n, Show n, EdgeClass e, Show e) => CGraph n e -> Dir -> [[(Int, Maybe BoxId)]] -> [Int] -> Bool -> ParentGraphOf -> [[(Int, Maybe BoxId)]] Source #

One pass right to left and left to right

lv :: (EdgeClass e, Show n, NodeClass n) => CGraph n e -> [(Int, Maybe BoxId)] -> [((Int, Maybe BoxId), Bool)] Source #

Arrange vertical nodes directly below each other, returns Nothing if there are no vertical nodes in this layer

data BaryNode Source #

Instances

Instances details
Show BaryNode Source # 
Instance details

Defined in Graph.GraphDrawing

barycenter :: (NodeClass n, Show n, EdgeClass e, Show e) => CGraph n e -> Dir -> [(Int, Maybe BoxId)] -> [(Int, Maybe BoxId)] -> ParentGraphOf -> Int -> [(Int, Maybe BoxId)] Source #

Assign every node in l1 a number thats the barycenter of its neighbours in l0, then sort. If the node is marked as a vertical node with a number, this number has precedence in sorting subgraph layouting is done here, by sorting nodes inside of blocks recursively

median :: EdgeClass e => CGraph n e -> [Int] -> [Int] -> [Int] Source #

lexicographicSort :: Vector (YNode, YNode) -> Vector (YNode, YNode) Source #

Sort two edges lexicographically after their y-position in the layer An edge has two points, each point has a y-position (e.g. e0y0) and a node number (e.g. e0n0)

primitiveInversionCount :: Vector Int -> Int Source #

See: Simple and Efficient Bilayer Cross Counting by Barth, Mutzel, Jünger

mergeSort :: ([Int], Int) -> ([Int], Int) Source #

Modified merge sort for counting of edge crossings which is the same as counting inversions (see) http://www.geeksforgeeks.org/counting-inversions/

longestinfrequentPaths :: EdgeClass e => NodeClass n => CGraph n e -> [[UINode]] -> Vector Int Source #

The idea behind the following heuristic: Very frequent chaining of functions are obvious and need no attention, e.g. Data.Text.pack str unusual chainings need the highest attention a long path means it is the main path of activity, like a table of contents in a book that is a guide where to go. This long path should be a straight line at the top of the page.

startNodes :: EdgeClass e => CGraph n e -> [Word32] -> [Word32] -> [Word32] Source #

liPaths :: EdgeClass e => NodeClass n => CGraph n e -> [[UINode]] -> [UINode] -> UINode -> Vector Int Source #

Helper functions

fr :: (Int, n) -> (UINode, n) Source #

fromAdj :: EdgeClass e => Map Word32 nl -> [(Word32, [Word32], [e])] -> Graph nl [e] Source #

myTail :: [a] -> [a] Source #

myNub :: Ord a => [a] -> [a] Source #

myNub2 :: [(Int, UINode)] -> [(Int, UINode)] Source #

sel1 :: (a, b, c) -> a Source #

sel2 :: (a, b, c) -> b Source #

sel3 :: (a, b, c) -> c Source #

tuples :: [a] -> [(a, a)] Source #

vHead :: Unbox a => Vector a -> a Source #

Debugging

listShow :: Show a => [a] -> String Source #