# How can I detect the number of crossings in a layout of a graph?

This question was inspired by the game Planarity in which a player tries to position the vertices so that no two lines cross. As I move the vertices, the change in the number of crossings is detected in time. It is also necessary for my research in graph drawing.

In Mathematica, we can draw a graph.

Problem 1. How can we detect the number of crossings in the layout of a graph?

For example, we have the following graph with LayeredDigraphEmbedding; how do we detect the number of crossings? The graph I am considering can contain curves.

Graph[{1 \[UndirectedEdge] 16, 1 \[UndirectedEdge] 19,
2 \[UndirectedEdge] 13, 2 \[UndirectedEdge] 14,
2 \[UndirectedEdge] 15, 2 \[UndirectedEdge] 16,
2 \[UndirectedEdge] 19, 3 \[UndirectedEdge] 6,
3 \[UndirectedEdge] 9, 3 \[UndirectedEdge] 10,
3 \[UndirectedEdge] 17, 3 \[UndirectedEdge] 20,
4 \[UndirectedEdge] 7, 4 \[UndirectedEdge] 13,
4 \[UndirectedEdge] 15, 4 \[UndirectedEdge] 20,
5 \[UndirectedEdge] 10, 6 \[UndirectedEdge] 16,
7 \[UndirectedEdge] 8, 7 \[UndirectedEdge] 9,
7 \[UndirectedEdge] 18, 8 \[UndirectedEdge] 13,
8 \[UndirectedEdge] 19, 9 \[UndirectedEdge] 15,
9 \[UndirectedEdge] 17, 11 \[UndirectedEdge] 18,
12 \[UndirectedEdge] 20, 13 \[UndirectedEdge] 14,
13 \[UndirectedEdge] 18, 13 \[UndirectedEdge] 19,
14 \[UndirectedEdge] 17, 15 \[UndirectedEdge] 18,
15 \[UndirectedEdge] 19, 16 \[UndirectedEdge] 19,
17 \[UndirectedEdge] 18}, GraphLayout -> "LayeredDigraphEmbedding"]


I find 26 crossings by hand.

Problem 2. Given an edge, how do we determine which edges cross it?

For example:

Graph[{1 \[UndirectedEdge] 16, 1 \[UndirectedEdge] 19,
2 \[UndirectedEdge] 13, 2 \[UndirectedEdge] 14,
2 \[UndirectedEdge] 15, 2 \[UndirectedEdge] 16,
2 \[UndirectedEdge] 19, 3 \[UndirectedEdge] 6,
3 \[UndirectedEdge] 9, 3 \[UndirectedEdge] 10,
3 \[UndirectedEdge] 17, 3 \[UndirectedEdge] 20,
4 \[UndirectedEdge] 7, 4 \[UndirectedEdge] 13,
4 \[UndirectedEdge] 15, 4 \[UndirectedEdge] 20,
5 \[UndirectedEdge] 10, 6 \[UndirectedEdge] 16,
7 \[UndirectedEdge] 8, 7 \[UndirectedEdge] 9,
7 \[UndirectedEdge] 18, 8 \[UndirectedEdge] 13,
8 \[UndirectedEdge] 19, 9 \[UndirectedEdge] 15,
9 \[UndirectedEdge] 17, 11 \[UndirectedEdge] 18,
12 \[UndirectedEdge] 20, 13 \[UndirectedEdge] 14,
13 \[UndirectedEdge] 18, 13 \[UndirectedEdge] 19,
14 \[UndirectedEdge] 17, 15 \[UndirectedEdge] 18,
15 \[UndirectedEdge] 19, 16 \[UndirectedEdge] 19,
17 \[UndirectedEdge] 18}, GraphLayout -> "LayeredDigraphEmbedding",
VertexLabels -> Placed[Automatic, Center], VertexSize -> 0.25]


We can find that the edge $$\{4, 13\}$$ is crossed $$3$$ times in total and it was crossed by $$\{3,9\}, \{3,17\}, \{8,19\}$$, respectively.

It feels like it is involved in computational geometry.

• What do you mean by "The graph I am considering can exist curves"? Can create curves? Contains curves? Something else? Jan 27, 2023 at 15:14
• Thank you for your revision, your comments are good. It should be revised by "Curves are permitted in the layout of my graph". Jan 27, 2023 at 15:31

Update: For each edge e find the list of edges that intersect e:

ClearAll[removeArrow, edgesToLines, intersectingQ]


First, a helper function that replaces Arrows with lines or curves:

removeArrow =  ReplaceAll[{Arrow[b_BezierCurve, ___] :> b,
Arrow[c_List, ___] :> Line[c]}];


Then, create a new graph g0 with each edge wrapped with a tooltip:

g0 = Graph[Labeled[#, #, Tooltip] & /@ EdgeList[g], Options[g]];


Post-process g0 to construct an association that associates with each edge a curve:

edgesToLines = Association @ Cases[Show @ g0,
Tooltip[a_, t_] :> t -> First[removeArrow @ Cases[_Arrow] @ a], All];


Define a function that returns True if the curves associated with the two input edges intersect:

intersectingQ[e1_, e2_] := {} =!=
GraphicsMeshFindIntersections[Graphics[edgesToLines /@ {e1, e2}],
GraphicsMeshAllPoints -> False]


Use intersectingQ to get, for each edge e in EdgeList[g], the indices of edges that intersect edge e:

adjlists = SparseArray[Boole@Outer[intersectingQ, #, #] & @



Example:

intersectingEdges[3 \[UndirectedEdge] 17]


Tabulate the lists and counts of intersecting edges:

Grid[Prepend[{"edge", "intersecting edges", "count"}] @
KeyValueMap[{#, #2, Length @ #2} &] @ intersectingEdges,
Frame -> All]


1. Wrap the graph object g with Show to get a graphics object
2. Replace Arrows with Lines
3. Use the function GraphicsMeshFindIntersections with the option GraphicsMeshAllPoints -> False
g2 = Show[g] /. {Arrow[b_BezierCurve, _] :> b, Arrow[c_List, _] :> Line[c]};

ints = GraphicsMeshFindIntersections[g2,  GraphicsMeshAllPoints -> False];

Length @ ints

26

Show[g, Graphics[{Red,  PointSize @ Large, Point @ ints}]]


• Nice! In a further step, how do we return the number of times an edge crossed, or which edge it crossed with? Jan 26, 2023 at 13:46
• @licheng, please see the update.
– kglr
Jan 26, 2023 at 19:28