BezierCurve in EdgeShapeFunction fails when used on multiedges graph
As I said in my comment:
The problem is that for loops, Graph
is creating curved edges. Therefore, the edges are not just {point1, point2}
type Lines
. Ultimately your problem is your replacement rule, which is not well suited for such lists.
You can check that the EdgeShapeFunction
is passed all the points, not only the initial ones:
pts = {1 -> 2, 2 -> 1, 2 -> 3, 3 -> 1};
Graph[pts, VertexLabels -> Placed["Name", Center],
EdgeShapeFunction -> ((Print[Short[#]]; Line[#1]) &)]
{{0.496922,0.},{0.518107,0.109873},<<15>>,{0.999994,0.864245}} {{0.999994,0.864245},{0.978809,0.754372},<<15>>,{0.496922,0.}} {{0.999994,0.864245},{0.,0.867795}} {{0.,0.867795},{0.496922,0.}}
So, keeping that in mind, you can write the proper function, for example:
edgeFun[pts_, e__] := BezierCurve[{#, # - {0, 1}, #2} & @@ pts[[{1, -1}]]];
pts = {1 -> 2, 2 -> 1, 2 -> 3, 3 -> 1};
Graph[pts, VertexLabels -> Placed["Name", Center], EdgeShapeFunction -> edgeFun]
An alternative is to use "CurvedArc"
as the EdgeShapeFunction
:
Graph[pts, VertexLabels -> Placed["Name", Center], VertexSize -> Medium,
EdgeShapeFunction -> GraphElementData[{"CurvedArc", "Curvature" -> -3/2}]]
Graph[pts1, VertexLabels -> Placed["Name", Center], VertexSize -> Medium,
EdgeShapeFunction -> GraphElementData[{"CurvedArc", "Curvature" -> -3/2}]]
Just to be redundant, I think your patterns need tuning for the extra points sent by multiple edges:
{{0, 0}, {1, 2}} /. {a_, b_} :> {"a is " <> ToString[a], "b is " <> ToString[b]}
{"a is {0, 0}", "b is {1, 2}"}
{{0, 0}, {1, 1}, {2, 2}, {3, 3}} /. {a_, b_} :> {"a is " <> ToString[a], "b is " <> ToString[b]}
{{"a is 0", "b is 0"}, {"a is 1", "b is 1"}, {"a is 2", "b is 2"}, {"a is 3", "b is 3"}}