Graph with fixed vertex layout but curved edges

Question

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]

Answer 1

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

Answer 2

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