Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- layeredGraphAndCols :: (NodeClass n, Show n, EdgeClass e, Show e) => Bool -> CGraph n e -> (CGraphL n e, (Map GraphMoveX [UINode], Map Int [Column]))
- layeredGraph :: (Unbox UINode, NodeClass n, Show n, EdgeClass e, Show e) => Bool -> CGraph n e -> CGraphL n e
- fr :: (Int, n) -> (UINode, n)
- graphvizNodes :: (CGraph n e, Map Int [Column]) -> String
- primitiveYCoordinateAssignement :: (CGraph n e, [[UINode]]) -> CGraphL n e
- yCoordinateAssignement :: (NodeClass n, EdgeClass e) => (CGraph n e, [[UINode]]) -> CGraphL n e
- horizontalBalancing :: Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y)
- type X = Int
- type Y = Int
- type YN = (Y, (UINode, Bool))
- data MYN
- type Median = Map UINode MYN
- biasedAlignment :: (NodeClass n, EdgeClass e) => CGraph n e -> Map UINode Y -> (Median, Median) -> [[(UINode, Bool)]] -> (Bool, Bool) -> Map UINode (X, Y)
- toNode :: ((a1, (a2, b1)), (a3, (b2, b3))) -> (a2, b2)
- tuples :: [a] -> [(a, a)]
- 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)]
- toYN :: Bool -> (MYN, MYN) -> ((Y, (UINode, Bool)), (Y, (UINode, Bool)))
- 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)
- getYN :: Bool -> MYN -> (Y, (UINode, Bool))
- getY :: Bool -> MYN -> Y
- getN :: MYN -> [UINode]
- ranksame :: [[UINode]] -> String
- col :: Int -> UINode -> String
- align :: EdgeClass e => CGraph n e -> [[UINode]] -> [(UINode, UINode)] -> (Bool, Bool) -> Map UINode (Int, Int)
- type YNode = (YPos, Channel, UINode, IsDummy)
- type YPos = Word32
- type IsDummy = Bool
- data Dir
- leftToRight :: Dir -> Bool
- 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
- myNub :: Ord a => [a] -> [a]
- myNub2 :: [(Int, UINode)] -> [(Int, UINode)]
- type UnconnectedChildren = [UINode]
- longestPathAlgo :: (NodeClass n, EdgeClass e) => CGraph n e -> (CGraph n e, [[UINode]])
- addMissingInputNodes :: (NodeClass n, Show n, EdgeClass e) => CGraph n e -> CGraph n e
- partitionNodes :: EdgeClass e => CGraph n e -> Vector UINode -> (Vector UINode, Vector UINode)
- addConnectionVertices :: (NodeClass n, Show n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]])
- addConnectionVs :: (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 -> CGraph n e
- crossingReduction :: (NodeClass n, Show n, EdgeClass e, Show e) => Int -> Bool -> (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]])
- crossR :: (NodeClass n, Show n, EdgeClass e, Show e) => CGraph n e -> Dir -> [[Int]] -> [Int] -> Bool -> [[Int]]
- lv :: EdgeClass e => CGraph n e -> [Int] -> [(Int, Bool)]
- edgesEnum :: (NodeClass n, EdgeClass e, Show e) => IntMap UINode -> IntMap UINode -> CGraph n e -> Dir -> [UINode] -> [(YNode, YNode)]
- isNotMainFunctionArg :: NodeClass n => CGraph n e -> UINode -> Bool
- barycenter :: (NodeClass n, Show n, EdgeClass e, Show e) => CGraph n e -> Dir -> [Int] -> [Int] -> Int -> [Int]
- median :: EdgeClass e => CGraph n e -> [Int] -> [Int] -> [Int]
- lexicographicSort :: Vector (YNode, YNode) -> Vector (YNode, YNode)
- primitiveInversionCount :: Vector Int -> Int
- merge :: ([Int], Int) -> ([Int], Int) -> ([Int], Int)
- split :: [a] -> ([a], [a])
- mergeSort :: ([Int], Int) -> ([Int], Int)
- fromAdj :: EdgeClass e => Map Word32 nl -> [(Word32, [Word32], [e])] -> Graph nl [e]
- getColumns :: EdgeClass e => CGraphL n e -> (Map X [UINode], Map Int [Column])
- getRows :: CGraphL n e -> Map Y [UINode]
Documentation
layeredGraphAndCols :: (NodeClass n, Show n, EdgeClass e, Show e) => Bool -> CGraph n e -> (CGraphL n e, (Map GraphMoveX [UINode], Map Int [Column])) 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
layeredGraph :: (Unbox UINode, NodeClass n, Show n, EdgeClass e, Show e) => Bool -> CGraph n e -> CGraphL n e Source #
primitiveYCoordinateAssignement :: (CGraph n e, [[UINode]]) -> CGraphL n e Source #
See "Fast and Simple Horizontal Coordinate Assignment" (Brandes, Köpf)
yCoordinateAssignement :: (NodeClass n, EdgeClass e) => (CGraph n e, [[UINode]]) -> CGraphL n e Source #
horizontalBalancing :: Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y) -> Map UINode (X, Y) Source #
Single (Y, (UINode, Bool)) | |
Middle (Y, (UINode, Bool)) | |
UpLowMedian (Y, (UINode, Bool)) (Y, (UINode, Bool)) |
biasedAlignment :: (NodeClass n, EdgeClass e) => CGraph n e -> Map UINode Y -> (Median, Median) -> [[(UINode, Bool)]] -> (Bool, Bool) -> Map UINode (X, Y) 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 => CGraph n e -> [[UINode]] -> [(UINode, UINode)] -> (Bool, Bool) -> Map UINode (Int, Int) Source #
leftToRight :: Dir -> Bool Source #
longestinfrequentPaths :: EdgeClass e => NodeClass n => CGraph n e -> [[UINode]] -> Vector Int Source #
liPaths :: EdgeClass e => NodeClass n => CGraph n e -> [[UINode]] -> [UINode] -> UINode -> Vector Int Source #
type UnconnectedChildren = [UINode] Source #
longestPathAlgo :: (NodeClass n, EdgeClass 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 can 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
addConnectionVertices :: (NodeClass n, Show n, EdgeClass e, Show e) => (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]]) Source #
addConnectionVs :: (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 -> CGraph n e Source #
crossingReduction :: (NodeClass n, Show n, EdgeClass e, Show e) => Int -> Bool -> (CGraph n e, [[UINode]]) -> (CGraph n e, [[UINode]]) Source #
crossR :: (NodeClass n, Show n, EdgeClass e, Show e) => CGraph n e -> Dir -> [[Int]] -> [Int] -> Bool -> [[Int]] Source #
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] -> [Int] -> Int -> [Int] Source #
primitiveInversionCount :: Vector Int -> Int Source #
See: Simple and Efficient Bilayer Cross Counting by Barth, Mutzel, Jünger