Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- layeredGraphAndCols :: (NodeClass n, EdgeClass e, ShowGraph n e) => Bool -> CGraph n e -> (CGraphL n e, (Map GraphMoveX [UINode], Map Int ([Column], YBlockLines)))
- layeredGraphWithSub :: (NodeClass n, EdgeClass e, ShowGraph n e) => Unbox UINode => Bool -> CGraph n e -> CGraphL n e
- type BoxMap = Map BoxId (Set UINode)
- type ParentGraphOf = Map (Maybe BoxId) (Set BoxId)
- deepestNesting :: (NodeClass n, EdgeClass e, Show n, Enum n, Show e, ExtractNodeType n) => CGraph n e -> (NestMap, BoxMap, ParentGraphOf)
- layeredGraph :: (Unbox UINode, NodeClass n, EdgeClass e, ShowGraph n e) => Bool -> CGraph n e -> (NestMap, [BoxId], ParentGraphOf) -> CGraphL n e
- sortLayers :: Ord a => (a, [[a]]) -> (a, [[a]])
- addBoxId :: (Show a, EdgeAttribute el, Integral a, NodeClass a) => Graph a el -> a -> (a, Maybe BoxId)
- primitiveYCoordinateAssignement :: (CGraph n e, [[UINode]]) -> CGraphL n e
- yCoordinateAssignement :: (NodeClass n, Show n, EdgeClass e, ExtractNodeType n, Show e, Enum n) => (CGraph n e, [[UINode]]) -> (CGraphL n e, [[UINode]])
- yPos :: (Num a, Enum a, Ord k) => [[k]] -> Map k a
- medians :: (NodeClass b, EdgeClass e) => (CGraph b e, [[Word32]]) -> (Map Word32 MYN, Map Word32 MYN)
- horizontalBalancing :: Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y)
- type YN = (Y, (UINode, Bool))
- data MYN
- type Median = Map UINode MYN
- toYN :: Bool -> (MYN, MYN) -> ((Y, (UINode, Bool)), (Y, (UINode, Bool)))
- getYN :: Bool -> MYN -> (Y, (UINode, Bool))
- getY :: Bool -> MYN -> Y
- getN :: MYN -> [UINode]
- biasedAlignment :: (NodeClass n, Show n, EdgeClass e, ExtractNodeType n, Show e, Enum n) => CGraph n e -> Map UINode Y -> (Median, Median) -> [[(UINode, Bool)]] -> (Bool, Bool) -> Map UINode (X, Y)
- sweep2 :: (Median, Median) -> Bool -> ([(UINode, Bool)], [(UINode, Bool)]) -> [[(MYN, MYN)]]
- toNode :: ((a1, (a2, b1)), (a3, (b2, b3))) -> (a2, b2)
- type Insp = (Map Int (MYN, MYN), Map Int (MYN, MYN))
- 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)]]
- data EdgeTy a
- = E0Prevails a
- | E1Prevails a
- | NoIntersect (a, a)
- resolveConflicts :: (Bool, Bool) -> [(MYN, MYN)] -> [(YN, YN)]
- resolveConfs :: (Bool, Bool) -> [(MYN, MYN)] -> Int -> [(MYN, MYN)]
- isConsistent :: [EdgeTy (MYN, MYN)] -> EdgeTy Bool
- conflict :: Bool -> (MYN, MYN) -> (MYN, MYN) -> EdgeTy (MYN, MYN)
- cases :: Bool -> (MYN, MYN) -> (MYN, MYN) -> EdgeTy (MYN, MYN)
- blockChildren :: Map UINode UINode -> (X, UINode) -> [(X, UINode)]
- nodeWithoutParent :: [[UINode]] -> [(UINode, UINode)] -> (X, UINode) -> Maybe (X, UINode)
- 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)
- longestPath :: (NodeClass n, EdgeClass e, ShowGraph n e) => [[(X, UINode)]] -> [UINode] -> Int -> CGraph n e -> [[UINode]] -> [(UINode, UINode)] -> Bool -> YBlockLines
- type UnconnectedChildren = [UINode]
- type SubgraphLayers = [[[UINode]]]
- longestPathAlgo :: (NodeClass n, EdgeClass e, ShowGraph n e) => CGraph n e -> (CGraph n e, [[UINode]])
- verticalLayers :: EdgeClass e => Graph n [e] -> [([UINode], UnconnectedChildren, Bool)]
- nodesWithoutChildrenVertLayer :: (NodeClass n, EdgeClass e) => CGraph n e -> Vector UINode
- partitionNodes :: EdgeClass e => CGraph n e -> Vector UINode -> (Vector UINode, Vector UINode)
- addMissingInputNodes :: (NodeClass n, Show n, Show e, EdgeClass e) => CGraph n e -> CGraph n e
- arrangeMetaNodes :: (NodeClass n, Show n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]])
- addConnectionNodes :: (NodeClass n, Show n, ExtractNodeType n, Enum n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]])
- addConnectionNs :: (NodeClass n, Show n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]])
- insertConnNode :: (NodeClass n, Show n, EdgeClass e) => CGraph n e -> UINode -> UINode -> Maybe Channel -> Channel -> (Maybe BoxId, Nesting) -> CGraph n e
- crossingReduction :: (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]])
- 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)]])
- first :: (Integral a, Num b1) => (a, b2) -> b1
- fi :: (Integral a1, Num a2) => (a1, b) -> (a2, b)
- data Dir
- leftToRight :: Dir -> Bool
- crossR :: (NodeClass n, Show n, EdgeClass e, Show e) => CGraph n e -> Dir -> [[(Int, Maybe BoxId)]] -> [Int] -> Bool -> ParentGraphOf -> [[(Int, Maybe BoxId)]]
- lv :: (EdgeClass e, Show n, NodeClass n) => CGraph n e -> [(Int, Maybe BoxId)] -> [((Int, Maybe BoxId), Bool)]
- type YPos = Word32
- type IsDummy = Bool
- type YNode = (YPos, Channel, UINode, IsDummy)
- edgesEnum :: (NodeClass n, EdgeClass e, Show e) => IntMap UINode -> IntMap UINode -> CGraph n e -> Dir -> [UINode] -> [(YNode, YNode)]
- data BaryNode
- barycenter :: (NodeClass n, Show n, EdgeClass e, Show e) => CGraph n e -> Dir -> [(Int, Maybe BoxId)] -> [(Int, Maybe BoxId)] -> ParentGraphOf -> Int -> [(Int, Maybe BoxId)]
- median :: EdgeClass e => CGraph n e -> [Int] -> [Int] -> [Int]
- lexicographicSort :: Vector (YNode, YNode) -> Vector (YNode, YNode)
- primitiveInversionCount :: Vector Int -> Int
- mergeSort :: ([Int], Int) -> ([Int], Int)
- longestinfrequentPaths :: EdgeClass e => NodeClass n => CGraph n e -> [[UINode]] -> Vector Int
- startNodes :: EdgeClass e => CGraph n e -> [Word32] -> [Word32] -> [Word32]
- liPaths :: EdgeClass e => NodeClass n => CGraph n e -> [[UINode]] -> [UINode] -> UINode -> Vector Int
- fr :: (Int, n) -> (UINode, n)
- fromAdj :: EdgeClass e => Map Word32 nl -> [(Word32, [Word32], [e])] -> Graph nl [e]
- myTail :: [a] -> [a]
- myNub :: Ord a => [a] -> [a]
- myNub2 :: [(Int, UINode)] -> [(Int, UINode)]
- sel1 :: (a, b, c) -> a
- sel2 :: (a, b, c) -> b
- sel3 :: (a, b, c) -> c
- tuples :: [a] -> [(a, a)]
- vHead :: Unbox a => Vector a -> a
- col :: Int -> UINode -> String
- graphvizNodes :: (CGraph n e, Map Int [Column]) -> String
- listShow :: Show a => [a] -> String
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
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
layeredGraph :: (Unbox UINode, NodeClass n, EdgeClass e, ShowGraph n e) => Bool -> CGraph n e -> (NestMap, [BoxId], ParentGraphOf) -> CGraphL n e Source #
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)
medians :: (NodeClass b, EdgeClass e) => (CGraph b e, [[Word32]]) -> (Map Word32 MYN, Map Word32 MYN) Source #
Single (Y, (UINode, Bool)) | |
Middle (Y, (UINode, Bool)) | |
UpLowMedian (Y, (UINode, Bool)) (Y, (UINode, Bool)) |
biasedAlignment :: (NodeClass n, Show n, EdgeClass e, ExtractNodeType n, Show e, Enum n) => CGraph n e -> Map UINode Y -> (Median, Median) -> [[(UINode, Bool)]] -> (Bool, Bool) -> Map UINode (X, Y) Source #
sweep2 :: (Median, Median) -> Bool -> ([(UINode, Bool)], [(UINode, Bool)]) -> [[(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.
Either e0 prevails against all e1s or all e1s prevail against e0
E0Prevails a | |
E1Prevails a | |
NoIntersect (a, a) |
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
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
type UnconnectedChildren = [UINode] Source #
type SubgraphLayers = [[[UINode]]] Source #
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
verticalLayers :: EdgeClass e => Graph n [e] -> [([UINode], UnconnectedChildren, Bool)] Source #
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
addConnectionNodes :: (NodeClass n, Show n, ExtractNodeType n, Enum n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]]) Source #
addConnectionNs :: (NodeClass n, Show n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]]) Source #
insertConnNode :: (NodeClass n, Show n, EdgeClass e) => CGraph n e -> UINode -> UINode -> Maybe Channel -> Channel -> (Maybe BoxId, Nesting) -> CGraph n e Source #
Crossing reduction
crossingReduction :: (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]]) Source #
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
leftToRight :: Dir -> Bool Source #
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
edgesEnum :: (NodeClass n, EdgeClass e, Show e) => IntMap UINode -> IntMap UINode -> CGraph n e -> Dir -> [UINode] -> [(YNode, YNode)] Source #
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
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.
liPaths :: EdgeClass e => NodeClass n => CGraph n e -> [[UINode]] -> [UINode] -> UINode -> Vector Int Source #