5
$\begingroup$

I want to create graphs consisting of many nodes arranged in a line. The nodes have values (which determine their size) and should be arranged in increasing order. A simple example is something like this:

nVertices = 8;
vertexValues = N[Subdivide[40, 65, nVertices - 1], 3];

vertexLabs = Thread[Rule[Range[nVertices], Placed[#, Center] & /@ vertexValues]];
edges = {1 -> 3, 3 -> 1, 2 -> 6, 6 -> 7, 7 -> 2, 4 -> 5, 5 -> 4};

Graph[Range[nVertices], edges, 
 VertexCoordinates -> Table[{i, 0}, {i, nVertices}],
 VertexSize -> 
  Table[i -> {"Scaled", 1/8 vertexValues[[i]]/Max[vertexValues]}, {i, nNodes}],
 PerformanceGoal -> "Quality",
 VertexLabels -> vertexLabs,
 EdgeShapeFunction -> {{"CurvedEdge", "Curvature" -> 1}}]

which gives the following:

enter image description here

To get the edges to curve above and below the row of nodes, I needed to add the line EdgeShapeFunction -> {{"CurvedEdge", "Curvature" -> 1}} which I found elsewhere on this website (seems to be undocumented?). By varying the value of curvature, I can control how far away the edges go. For instance, using EdgeShapeFunction -> {{"CurvedEdge", "Curvature" -> 2}} gives:

enter image description here

This changes the shape of the edges in the loop 43.6 -> 57.9 -> 61.4 -> 43.6, but there is no effect on the edges in the loops 40.0 -> 47.1 -> 40.0 and 50.7 -> 54.3 -> 50.7. With a little experimentation, I eventually realised that I cannot control the curvature of edges when a pair of nodes are connected in both directions, ie. when i -> j -> i. Now if the nodes neighbour each other, this is only slightly annoying, but when there are nodes in between, I want to be able to control the curvature to prevent the edges passing through the intervening nodes.

Does anyone know how to get finer control over these kinds of edges and why EdgeShapeFunction doesn't seem to be affecting these kinds of edges?

$\endgroup$

1 Answer 1

6
$\begingroup$

You could define custom edge shape for your example:

curveEdge[d_ : 1][{x_, ___, y_}, _[a_, b_]] :=
 Block[{mid},
  mid = Reverse[d*({1, -1}*(y - (x + y)/2))] + (x + y)/2;
  Arrow[BezierCurve[{DynamicLocation["VertexID$" <> ToString[a], 
      Automatic, Center], mid, 
     DynamicLocation["VertexID$" <> ToString[b], Automatic, 
      Center]}]]
  ]

Graph[Range[nVertices], edges, 
 VertexCoordinates -> Table[{i, 0}, {i, nVertices}], 
 VertexSize -> 
  Table[i -> {"Scaled", 1/8 vertexValues[[i]]/Max[vertexValues]}, {i, 
    nVertices}], PerformanceGoal -> "Quality", 
 VertexLabels -> vertexLabs, EdgeShapeFunction -> curveEdge[1.5], 
 EdgeStyle -> Arrowheads[.03]]

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.