4
$\begingroup$

I want to plot a coloured Graph in Mathematica. The speciality, however, is that my edges can have two colours. Color A close to vertex A, and colour B close to vertex B. I was able to find plots for coloured graphs, and multi-edges with different colours, but not single edges with two colours.

An example of such a graph can be seen here:

enter image description here

$\endgroup$
3
  • 1
    $\begingroup$ possible duplicate: How to color each edge of a graph with two colors? $\endgroup$ – kglr May 17 '20 at 9:17
  • 1
    $\begingroup$ Have you seen this as well? $\endgroup$ – J. M.'s ennui May 17 '20 at 9:19
  • 1
    $\begingroup$ Thank you kglr and JM. Those codes appear to be related, but i wonder whether this actually works. In particular, a vertex can have several different incoming colored edges, thus the edge color cannot be inherited from the vertex (JM's link). And it seems in kglr's link, there is a third hidden vertex that defines the boundary of monochromatic edges. $\endgroup$ – Mario Krenn May 17 '20 at 9:39
3
$\begingroup$

Update: An alternative ChartelementFunction that gives curved edges:

ClearAll[ eSF]
eSF[clr_Association] := GraphComputation`GraphChartDump`pEdge[True, blah, blah, #1, #2]/.
   Style[circle_Circle, _] :> circle /. 
    Circle[center_, radius_, angles_] :> 
      MapThread[Function[{x, y}, {x, Circle[center, radius, y]}], 
       {clr@#2, Partition[Subdivide[## & @@ angles, Length[clr@#2]], 2, 1]}]&;

Examples:

edgecolors = {{Blue}, {Red, Blue}, {Green, Blue}, {Purple}, {Blue}, {Red, Blue}, 
  {Green, Blue}, {Purple}, {Purple}};
coloring = AssociationThread[edges, edgecolors]; 

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["Butt"], Opacity[.7], AbsoluteThickness[10]], 
 PerformanceGoal -> "Quality", EdgeShapeFunction -> eSF[coloring]]

enter image description here

Use

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

to get

enter image description here

Original answer:

An approach that works for graphs without multi-edges:

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

Specify a list of colors for each edge:

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

Construct an Association for coloring rules:

coloring = AssociationThread[edges, edgecolors];

A custom EdgeShapeFunction that divides each edge into colored segments:

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]

enter image description here

We can have arbitrary number of colors for each edge. For example, change edgecolors to

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

to get

enter image description here

$\endgroup$
4
  • $\begingroup$ This is perfect, thank you so much! Have to try to understand it now :) $\endgroup$ – Mario Krenn May 17 '20 at 10:45
  • $\begingroup$ Since your updated eShapeFunction, double edges are not loops anymore. But the associated colors seem wrong. if you try edges = DirectedEdge @@@ {{a, h}, {a, h}, {a, f}, {f, e}, {b, c}, {b, d}, {b, e}, {g, d}, {h, c}};, i would expect that between a-h, there are two edges. one Blue, one Red-Blue. However, in the code both are Red-Blue $\endgroup$ – Mario Krenn May 17 '20 at 11:13
  • 1
    $\begingroup$ @MarioKrenn, If you have version 12.1 you can try if EdgeTaggedGraph. If it doesn't, i suggest you post a new question for the multi-edges case (I don't see a simple modification of the current post to handle multi-edges). $\endgroup$ – kglr May 17 '20 at 11:13
  • $\begingroup$ Thanks for the suggestion, i did ask a new question and will accept your answer here in a day or so. Thank you very much for your help! $\endgroup$ – Mario Krenn May 17 '20 at 11:25

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.