# Plotting Graphs with multi-edges that have two colors per edge

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}};

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:

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

• 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. May 17, 2020 at 11:40
• @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 May 17, 2020 at 11:42

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;

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]


Another example: Define edgecolors as

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


to get

• 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. May 17, 2020 at 15:45