2
$\begingroup$

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: enter image description here

Here the code: enter image description here

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]
$\endgroup$
2
  • 1
    $\begingroup$ Please post the Mathematica code. $\endgroup$
    – cvgmt
    Dec 12, 2023 at 2:48
  • $\begingroup$ 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. $\endgroup$ Dec 12, 2023 at 3:21

2 Answers 2

1
$\begingroup$

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"]

enter image description here

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

$\endgroup$
1
$\begingroup$
$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};

The Graph

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]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.