# Graph with fixed vertex layout but curved edges

I have constructed a graph (network) whose vertices I want to be arranged in a square grid, I have already done this by means of the "GridEmbedding" GraphLayout, however this layout makes every edge a straight line, which makes it hard to distinguish overlapping edges visually. For instance, visualizing the edge 1->3 is not clear since the line overlaps with the edge 2->4 (which is also not clear), the arrow could be mistaken for an edge 2->3 which isn't there at all.

In the figure above, Mathematica does curve some edges, but only the ones that are symmetric.

I want to keep the grid-like arrangement of the vertices but make the edges appear as curved arcs; moreover, it would be nice to keep the edges between near vertices straight and only curve the ones with a length greater than 1.

Here's another depiction of the same graph for clarity:

Here the code:

Written:

Edges={1 \[DirectedEdge] 11, 2 \[DirectedEdge] 12, 3 \[DirectedEdge] 23,
4 \[DirectedEdge] 9, 5 \[DirectedEdge] 20, 6 \[DirectedEdge] 21,
7 \[DirectedEdge] 22, 8 \[DirectedEdge] 13, 9 \[DirectedEdge] 24,
10 \[DirectedEdge] 20, 11 \[DirectedEdge] 16, 12 \[DirectedEdge] 22,
13 \[DirectedEdge] 13, 14 \[DirectedEdge] 24, 1 \[DirectedEdge] 3,
2 \[DirectedEdge] 4, 4 \[DirectedEdge] 5, 6 \[DirectedEdge] 9,
7 \[DirectedEdge] 10, 8 \[DirectedEdge] 9, 11 \[DirectedEdge] 12,
12 \[DirectedEdge] 14, 13 \[DirectedEdge] 13, 16 \[DirectedEdge] 19,
17 \[DirectedEdge] 19, 21 \[DirectedEdge] 25, 22 \[DirectedEdge] 24,
23 \[DirectedEdge] 24, 8 \[DirectedEdge] 3, 11 \[DirectedEdge] 6,
12 \[DirectedEdge] 2, 13 \[DirectedEdge] 13, 14 \[DirectedEdge] 4,
16 \[DirectedEdge] 1, 17 \[DirectedEdge] 7, 18 \[DirectedEdge] 3,
19 \[DirectedEdge] 9, 21 \[DirectedEdge] 1, 22 \[DirectedEdge] 12,
23 \[DirectedEdge] 18, 24 \[DirectedEdge] 9, 25 \[DirectedEdge] 15,
4 \[DirectedEdge] 3, 5 \[DirectedEdge] 2, 8 \[DirectedEdge] 7,
9 \[DirectedEdge] 6, 10 \[DirectedEdge] 8, 13 \[DirectedEdge] 13,
14 \[DirectedEdge] 12, 15 \[DirectedEdge] 12, 19 \[DirectedEdge] 17,
20 \[DirectedEdge] 16, 23 \[DirectedEdge] 22, 24 \[DirectedEdge] 21,
25 \[DirectedEdge] 23}

Vertices1={1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, \
20, 21, 22, 23, 24, 25}

rotateLabel[lbl_] := Rotate[lbl, 90 Degree]

Rotate[Graph[Vertices1, DeleteDuplicates[Edges],
VertexLabels -> Placed["Name", Before, rotateLabel],
GraphLayout -> {"GridEmbedding", "Dimension" -> {5, 5}},
EdgeStyle -> Orange, VertexLabelStyle -> 21], -Pi/2]

• Please post the Mathematica code. Commented Dec 12, 2023 at 2:48
• I'm sorry the code looks so horribly formatted, this is my first time including Mathematica code in this website, I included a screenshot to make it readable and kept the code in case anyone wants to copy it. Commented Dec 12, 2023 at 3:21

Use the option EdgeShapeFunction -> "CurvedEdge":

Graph[Range @ 25,
DeleteDuplicates[Edges],
VertexLabels -> Placed["Name", Above],
VertexCoordinates ->
Apply[Join]@ Reverse @ Transpose @
Partition[GraphEmbedding[GridGraph[{5, 5}]], 5],
EdgeStyle -> Orange,
VertexLabelStyle -> 21,
EdgeShapeFunction -> "CurvedEdge"]


Alternatively,

Graph[Apply[Join]@Transpose@Reverse@Partition[Range@25, 5],
DeleteDuplicates[Edges],
VertexLabels -> Placed["Name", Above],
GraphLayout -> "GridEmbedding",
EdgeStyle -> Orange,
VertexLabelStyle -> 21,
EdgeShapeFunction -> "CurvedEdge"]


same picture

\$Version

(* "13.3.1 for Mac OS X ARM (64-bit) (July 24, 2023)" *)

Clear["Global*"]


Definitions:

Edges = {1 \[DirectedEdge] 11, 2 \[DirectedEdge] 12,
3 \[DirectedEdge] 23, 4 \[DirectedEdge] 9, 5 \[DirectedEdge] 20,
6 \[DirectedEdge] 21, 7 \[DirectedEdge] 22, 8 \[DirectedEdge] 13,
9 \[DirectedEdge] 24, 10 \[DirectedEdge] 20, 11 \[DirectedEdge] 16,
12 \[DirectedEdge] 22, 13 \[DirectedEdge] 13,
14 \[DirectedEdge] 24, 1 \[DirectedEdge] 3, 2 \[DirectedEdge] 4,
4 \[DirectedEdge] 5, 6 \[DirectedEdge] 9, 7 \[DirectedEdge] 10,
8 \[DirectedEdge] 9, 11 \[DirectedEdge] 12, 12 \[DirectedEdge] 14,
13 \[DirectedEdge] 13, 16 \[DirectedEdge] 19,
17 \[DirectedEdge] 19, 21 \[DirectedEdge] 25,
22 \[DirectedEdge] 24, 23 \[DirectedEdge] 24, 8 \[DirectedEdge] 3,
11 \[DirectedEdge] 6, 12 \[DirectedEdge] 2, 13 \[DirectedEdge] 13,
14 \[DirectedEdge] 4, 16 \[DirectedEdge] 1, 17 \[DirectedEdge] 7,
18 \[DirectedEdge] 3, 19 \[DirectedEdge] 9, 21 \[DirectedEdge] 1,
22 \[DirectedEdge] 12, 23 \[DirectedEdge] 18, 24 \[DirectedEdge] 9,
25 \[DirectedEdge] 15, 4 \[DirectedEdge] 3, 5 \[DirectedEdge] 2,
8 \[DirectedEdge] 7, 9 \[DirectedEdge] 6, 10 \[DirectedEdge] 8,
13 \[DirectedEdge] 13, 14 \[DirectedEdge] 12,
15 \[DirectedEdge] 12, 19 \[DirectedEdge] 17,
20 \[DirectedEdge] 16, 23 \[DirectedEdge] 22,
24 \[DirectedEdge] 21, 25 \[DirectedEdge] 23};

Vertices1 = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,
17, 18, 19, 20, 21, 22, 23, 24, 25};

vertexPos[n_] := {Mod[n - 1, 5], -Floor[(n - 1)/5]}

edgeLen[edge_] :=
EuclideanDistance[vertexPos[#[[1]]], vertexPos[#[[-1]]]] &@edge

colors = {Black, Blue, Darker[Green], Orange, Red};

Graph[
Vertices1, DeleteDuplicates[Edges],
VertexLabels -> Placed[Automatic, Center],
EdgeShapeFunction -> (If[
edgeLen[#] == 1, # -> "Arrow", # -> "CurvedEdge"] & /@ Edges),
EdgeStyle -> ((# -> colors[[edgeLen[#] + 1]]) & /@ Edges),
VertexCoordinates -> (# -> vertexPos[#] & /@ Range[25]),
VertexStyle -> LightBlue,
VertexSize -> .35,
VertexLabelStyle -> 18]
`