4
$\begingroup$

I would like to plot graphs with multiedges, where each edge could have two colors (color 1 at vertex A and color 2 at vertex B). A very similar questions for graphs without multiedges has been answered by kglr:

edges = DirectedEdge @@@ {{a, h}, {a, h}, {a, h}, {f, e}, {b, c}, {b, d},
   {b, e}, {g, d}, {h, c}};

edgecolors = {{Blue, Green}, {Red, Blue}, {Purple}, {Purple}, {Blue}, 
   {Red, Blue}, {Green, Blue}, {Purple}, {Purple}};

coloring = AssociationThread[edges, edgecolors];

eShapeFunction = Module[{c = coloring @ #2, bsf = BSplineFunction @ #, 
    s = Subdivide[Length @ coloring @ #2]}, 
  {CapForm["Butt"], Thread[{c, Line /@ Partition[bsf /@ s, 2, 1]}]}] &;


Graph[Reverse @ {a, b, c, d, e, f, g, h}, edges, 
 GraphLayout -> {"CircularEmbedding", "Offset" -> Pi/8}, 
 VertexLabels -> Placed["Name", Center], VertexSize -> .25, 
 VertexStyle -> White, 
 VertexLabelStyle -> Directive[FontFamily -> "Times", Large], 
 EdgeStyle -> Directive[CapForm["Round"], Opacity[.7], AbsoluteThickness[15]], 
 PerformanceGoal -> "Quality", EdgeShapeFunction -> eShapeFunction]

While the code is great for simple graphs, unfortunalty for multi-edges, it introduces loops and messes up the colors:

enter image description here

It is not obvious to me how to fix the eShapeFunction or how to replace it.

$\endgroup$
2
  • $\begingroup$ If you have Mathematica 12.1, you need to apply EdgeTaggedGraph to make edges distinguishable. Then the method shown in the linked question will work. If you have M12.0 or earlier, then visualizing multigraphs is a major pain and requires ugly and fragile hacks. $\endgroup$
    – Szabolcs
    May 17 '20 at 11:40
  • $\begingroup$ @Szabolcs Ah ok -- i was not aware of the problems with multiedges. Very good to know. I have access to it i think - need to reinstall. So if you could provide a solution, i would be extremly happy, even for 12.1. Thank you $\endgroup$ May 17 '20 at 11:42
5
$\begingroup$
  1. Use EdgeTaggedGraph to get a list of tagged edges,
  2. Define the association coloring using tagged edges, and
  3. Modify eShapeFunction so that curved edges are preserved

edges = DirectedEdge @@@ {{a, h}, {a, h}, {a, h}, {f, e}, {b, c}, {b, d},
       {b, e}, {g, d}, {h, c}};

edgecolors = {{Blue, Green}, {Red, Blue}, {Purple}, {Purple}, {Blue}, 
      {Red, Blue}, {Green, Blue}, {Purple}, {Purple}};

taggededges = EdgeList @ EdgeTaggedGraph @ edges;

coloring = AssociationThread[taggededges, edgecolors];

eShapeFunction2 = Module[{c = coloring @ #2, bsf = BSplineFunction @ #, 
       s = Partition[Subdivide[Length @ coloring @ #2], 2, 1]}, 
    {CapForm["Butt"], Thread[{c, Line /@ (bsf /@ Subdivide[##, 100] & @@@ s)}]}] &;


Graph[Reverse @ {a, b, c, d, e, f, g, h}, taggededges, 
  GraphLayout -> {"CircularEmbedding", "Offset" -> Pi/8}, 
  VertexLabels -> Placed["Name", Center], VertexSize -> .25, 
  VertexStyle -> White, 
  VertexLabelStyle -> Directive[FontFamily -> "Times", Large], 
  EdgeStyle -> 
  Directive[CapForm["Round"], Opacity[.7], AbsoluteThickness[5]], 
  PerformanceGoal -> "Quality", EdgeShapeFunction -> eShapeFunction2]

enter image description here

Another example: Define edgecolors as

SeedRandom[1]
edgecolors = RandomColor[RandomInteger[{2, 5}]] & /@ edges;

to get

enter image description here

$\endgroup$
1
  • $\begingroup$ Wonderful thank you! I was able to get access to M12.1, and it works perfectly. Now its a good motivation to explore EdgeTaggedGraph further. $\endgroup$ May 17 '20 at 15:45

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.