8
$\begingroup$

I'd like to draw something like the following graph:

testGraph = Graph[{1 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 4,
                   2 \[UndirectedEdge] 3, 2 \[UndirectedEdge] 5,
                   3 \[UndirectedEdge] 4}, 
                   VertexLabels -> {1 -> "1", 2 -> "2", 3 -> "3", 4 -> "4", 5 -> "5"}, 
                   VertexCoordinates -> {{0, 0}, {1, 1}, {2, 3}, {4, 1}, {3, 3}}, 
                   ImagePadding -> 10]

Mathematica graphics

However, without changing any of the explicitly specified vertex positions, I'd like edges to curve to avoid vertices. For example, while it's fine that the edges between vertices 2 and 5, and 3 and 4 cross, what if I have an edge between vertices 1 & 5 (if I actually do this, Mathematica v9 appears to no longer respect my vertex coordinates) and what if I would like this edge not to pass through a small sphere about vertex 2?

Is there any way to enforce vertex positionings while allowing for curved edges that avoid vertices in Mathematica v9? This is a dream, however, could I specify a length for an edge and have it travel along an arc to meet that length requirement provided stationary vertices?

A hack would involve creating a set of edges between "invisible" vertices, however, it would take a lot of invisible vertices to create an appropriate curvature effect, and this doesn't seem like the right thing to do.

$\endgroup$
  • $\begingroup$ But you have no 1->5 connection. Only 1->2 and 2->5. $\endgroup$ – Kuba Nov 28 '14 at 9:18
  • $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Read the faq! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$ – Dr. belisarius Nov 28 '14 at 12:24
  • $\begingroup$ @Kuba You're absolutely right --- the problem should be fixed now. $\endgroup$ – GBrenner Nov 28 '14 at 14:19
  • $\begingroup$ @belisarius Thanks for putting up the graphic, and I appreciate your welcome. $\endgroup$ – GBrenner Nov 28 '14 at 14:20
4
$\begingroup$

quick fix is to use EdgeShapeFunction. My function here is not very sophisticated so it may happen that you cross different vertices somewhere some day, so be careful :) :

 Graph[{1 \[UndirectedEdge] 2, 1 \[UndirectedEdge] 4, 2 \[UndirectedEdge] 3,
        2 \[UndirectedEdge] 5, 1 \[UndirectedEdge] 5, 3 \[UndirectedEdge] 4}, 
  VertexLabels -> {1 -> "1", 2 -> "2", 3 -> "3", 4 -> "4", 5 -> "5"}, 
  VertexCoordinates -> {{0, 0}, {1, 1}, {2, 3}, {4, 1}, {3, 3}}, 
  ImagePadding -> 10, 
  EdgeShapeFunction -> (BezierCurve[
                          {#, # + .5 RotationMatrix[.3].(#2 - #), #2} & @@ #] &)]

enter image description here

$\endgroup$
  • $\begingroup$ Yes yes... this is the sort of thing I'm looking for. Can I ask only certain edges to be BezierCurves and the rest straightline? Also, I can't upvote until I have 15 rep, but I would otherwise. $\endgroup$ – GBrenner Nov 28 '14 at 14:55
  • $\begingroup$ @GBrenner Take a look at documentation for ESP. You can set result basing on arguments, like: EdgeShapeFunction -> (If[MatchQ[1 \[UndirectedEdge] 5, #2], BezierCurve[{#, # + RotationMatrix[1].(#2 - #), #2} & @@ #], Line[#] ] &) $\endgroup$ – Kuba Nov 28 '14 at 15:01
  • $\begingroup$ Got it, thanks. $\endgroup$ – GBrenner Nov 28 '14 at 15:02
7
$\begingroup$

Update: The edge shape function "CurvedArc" has an option "Curvature" that controls the shape of the BezierCurve it produces.

Examples:

Graph[{1 -> 2, 2 -> 3, 1->3}, VertexCoordinates -> {{0, 0}, {1, 1}, {2, 2}},
 VertexLabels -> Placed["Name", Center], VertexSize -> Medium,
 EdgeShapeFunction -> GraphElementData[{"CurvedArc", "Curvature" -> 2}]]

Mathematica graphics

Graph[{1 -> 2, 2 -> 3}, VertexCoordinates -> {{0, 0}, {1, 1}, {2, 2}},
 VertexLabels -> Placed["Name", Center], VertexSize -> Medium,
 EdgeShapeFunction -> {(1 -> 2) -> GraphElementData[{"CurvedArc", "Curvature" -> 1}],
   (2 -> 3) -> GraphElementData[{"CurvedArc", "Curvature" -> -2}]}]

Mathematica graphics

gr = Graph[{1 -> 2, 1 -> 4, 2 -> 3, 2 -> 5, 3 -> 4, 1 -> 5},
   ImagePadding -> 10, VertexCoordinates -> {{0, 0}, {1, 1}, {2, 3}, {4, 1}, {3, 3}},
   VertexLabels -> Placed["Name", Center], VertexSize -> Medium,  ImageSize -> 500];

gr2 = Fold[SetProperty[{#, #2[[1]]},
     {EdgeLabels -> Placed[Style["curvature\n" <> ToString[#2[[2]]], 14],  "Middle"], 
      EdgeShapeFunction -> Composition[Style[#, Arrowheads[{{Large, .75}}]] &,
        Arrow, GraphElementData[{"CurvedArc", "Curvature" -> #2[[2]]}]]}] &,
   gr, {{1 -> 4, 1.}, {2 -> 5, 0.}, {1 -> 5, .75}, {3 -> 4, -2.5}}];

Row[{gr, gr2}]

enter image description here


Original post:

There is a built-in EdgeShapeFunction, "CurvedArc", that produces a set of edges that look almost exactly like the ones in @Kuba's answer.

SetProperty[testGraph, EdgeShapeFunction -> "CurvedArc"]

Mathematica graphics

testGraph2 = EdgeAdd[testGraph, 1 -> 5];
SetProperty[testGraph2, EdgeShapeFunction -> "CurvedArc"]

Mathematica graphics

Curve only the edges 1 -> 4, 2 -> 5, and 1 -> 5:

Fold[SetProperty[{#, #2}, EdgeShapeFunction -> "CurvedArc"] &, testGraph2, 
    {1 -> 4, 2 -> 5, 1 -> 5}]

Mathematica graphics

$\endgroup$
6
$\begingroup$

There is the somewhat hidden built-in graph-method of "EdgeLayout" that can be exploited for this purpose (see Details under GraphLayout):

AdjacencyGraph[Range@8, Table[Boole[j > i], {i, 8}, {j, 8}],
   DirectedEdges -> True, VertexLabels -> "Name",
   GraphLayout -> {
     "EdgeLayout" -> {"DividedEdgeBundling", 
       "CoulombConstant" -> #[[1]], "VelocityDamping" -> .2, 
       "SmoothEdge" -> True,
       "NewForce" -> False, "Connectivity" -> True, 
       "Compatibility" -> #[[3]], "Threshold" -> #[[4]], 
       "CoulombDecay" -> 1, "LaneWidth" -> #[[2]]}, 
     "VertexLayout" -> {"MultipartiteEmbedding", 
       "VertexPartition" -> {1, 3, 3, 1}}
     }, PlotLabel -> #] & /@ {
        {0, 0, True, .1}, {-10, 100, True, .1}, {-100, .1, True, .1},
        {10, .1, True, .1}, {100, .1, True, .1}, {100, 10, False, .1},
        {500, .1, True, .01}, {-10, 100, False, .1}, {-100, .1, False, .1},
        {100, .1, True, .5}}

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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