9
$\begingroup$

I don't very like the straight edge like

CayleyGraph[DihedralGroup[4], VertexLabels -> Placed["Name", Center], 
 VertexSize -> Medium, GraphLayout -> "TutteEmbedding"]

enter image description here

I note an undocumented option "CurvedEdge", which make me happy. But I don't know why it is sometimes concave inwards and sometimes convex outwards.

CayleyGraph[DihedralGroup[4], VertexLabels -> Placed["Name", Center], 
 VertexSize -> Medium, GraphLayout -> "TutteEmbedding", 
 EdgeShapeFunction -> "CurvedEdge"]

enter image description here

I can only control them one by one like this

CayleyGraph[DihedralGroup[4], VertexLabels -> Placed["Name", Center], 
 VertexSize -> Medium, GraphLayout -> "TutteEmbedding", 
 EdgeShapeFunction -> 
  Catenate[{Thread[{1 \[DirectedEdge] 4, 4 \[DirectedEdge] 6, 
       6 \[DirectedEdge] 7, 7 \[DirectedEdge] 1} -> 
      GraphElementData[{"CurvedEdge", "Curvature" -> -0.5}]], 
    Thread[{2 \[DirectedEdge] 3, 3 \[DirectedEdge] 5, 
       5 \[DirectedEdge] 8, 8 \[DirectedEdge] 2} -> 
      GraphElementData[{"CurvedEdge", "Curvature" -> 0.5}]]}]]

enter image description here

I have to say I hardly can stand such dirty code. Is there a simpler way to implement it?

$\endgroup$
1
  • $\begingroup$ "But I don't know why it is sometimes concave inwards and sometimes convex outwards." Hm. The first diagram sort of suggests that "CurvedEdge" consistently produces arrow bent to the right. So it seems that this is the pattern that you are looking for. $\endgroup$ Commented Apr 13, 2022 at 7:46

3 Answers 3

11
$\begingroup$
 CayleyGraph[DihedralGroup[4], VertexLabels -> Placed["Name", Center], 
  VertexSize -> Medium, GraphLayout -> "TutteEmbedding",
  EdgeStyle -> Arrowheads[{{Medium, .8}}],
  EdgeShapeFunction -> (GraphElementData["CurvedEdge", 
      "Curvature" -> -Sign @ Det @  #[[{1, -1}]]][##] &)] 

enter image description here

Use "Curvature" -> - 1/2 Sign @ Det @ #[[{1, -1}]] to get:

enter image description here

Replace DihedralGroup[4] with DihedralGroup[6] to get:

enter image description here

$\endgroup$
1
  • $\begingroup$ It is exactly what I want $\endgroup$
    – yode
    Commented Apr 13, 2022 at 13:44
10
$\begingroup$

Perhaps not much better, but you could use patterns in the edge specification:

CayleyGraph[
  DihedralGroup[4], VertexLabels -> Placed["Name", Center], 
  VertexSize -> Medium, GraphLayout -> "TutteEmbedding", 
  EdgeShapeFunction -> {
    DirectedEdge[1|4|6|7, _] -> GraphElementData[{"CurvedEdge", "Curvature" -> -0.5}],
    DirectedEdge[2|3|5|8, _] -> GraphElementData[{"CurvedEdge", "Curvature" -> 0.5}]
  }
]

graph with desired curved edges

$\endgroup$
1
  • $\begingroup$ Thank you, that does seem like a step forward, and I'll take it if I don't receive a more concise answer $\endgroup$
    – yode
    Commented Apr 13, 2022 at 8:21
3
$\begingroup$
cg = CayleyGraph[DihedralGroup[4], 
     VertexLabels -> Placed["Name", Center], 
     VertexSize -> Medium, 
     GraphLayout -> "TutteEmbedding",
     EdgeStyle -> Arrowheads[{{Medium, .8}}]];

We can use PositivelyOrientedPoints to detect the orientation of the edge routing coordinates to specify edge curvatures:

SetProperty[cg, EdgeShapeFunction -> (GraphElementData["CurvedEdge", "Curvature" -> 
  If[PositivelyOrientedPoints[Prepend[#, Mean @ GraphEmbedding @ cg]], -1, 1]][##] &)]

enter image description here

Replace -1 with -1/2 and 1 with 1/2 in If[...] to get:

enter image description here

Replace DihedralGroup[4] with DihedralGroup[6] to get:

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.