# Color edges of a multigraph when there are parallel edges using Graph[] and EdgeStyle

This a related question to : How can I display a multigraph with different colored edges? However I'm not using GraphPlot. Instead I'm using Graph and EdgeStyle attribute. Take this graph :

How can I assign to different colors to the self-loops ? EdgeStyle doesn't work (and perhaps won't work):

• Can you clarify: Do you want each self loop to be a different color, or do you want all self loop to be the same color different from the other edges? Feb 16 '15 at 23:28

Until someone figures this out, this is a workaround if only "display" is of interest. This will turn Graph in Graphics:

gr=Show[Graph[{
1\[DirectedEdge]1,
2\[DirectedEdge]1,
3\[DirectedEdge]1,
1\[DirectedEdge]1,
2\[DirectedEdge]1,
3\[DirectedEdge]2}]]


Then you can do things like:

SeedRandom[5];
gr /. Arrow[BezierCurve[{x_, w__, x_}, y_], z_] :> {RandomColor[],
Thickness[.01], Arrow[BezierCurve[{x, w, x}, y], z]}


• I would consider this problem a bug. The fact that EdgeStyle simply doesn't support differentiating between the edges could be called bad design (or design without foresight). But there's an alternative notation: Graph[{Style[1->2, Red], Style[1->2, Blue]}]. This notation does support separate styling, yet it's not handled correctly. May 19 '15 at 15:21
• Overall this is a pretty big issue: it doesn't only affect styling. It also affects all properties that can be attached to edges. Due to the special nature of multigraphs, I'd assume that if anyone actually does need multigraphs, they likely also need properties. So this problem is serious enough that it makes the new multigraph functionality near-useless. If you agree that this is a bug, could you please file a bug report? May 19 '15 at 15:24
• @Szabolcs we we look into it, thanks. May 19 '15 at 16:45

Update: A more flexible work-around post-processing the box expression of a graph to inject styles before edge primitives:

ClearAll[reStyleF]
reStyleF[g_][{(v1_ \[DirectedEdge] v2_) | (v1_ -> v2_), sty_}] :=
Module[{vid1 = "VertexID$" <> ToString[v1], vid2 = "VertexID$" <> ToString[v2],
boxes = ToBoxes[g], pos},
pos = Position[boxes, With[{vid1 = DynamicLocation[vid1, ___],
vid2 = DynamicLocation[vid2, ___]},
ArrowBox[{v1 | vid1, ___, v2 | vid2} |
BezierCurveBox[{v1 | vid1, ___, v2 | vid2}, ___], ___]]];
RawBoxes @ ReplacePart[ boxes, Thread[pos -> Transpose[{sty, boxes[[##]] & @@@ pos}]]]]


Example:

stylelist = {{Directive[Red, Opacity[1], Thick], Directive[Blue,
Dashed, Opacity[1], Thick]},
{Directive[Orange, Opacity[1], Thick], Directive[Purple, Dashed, Opacity[1], Thick]},
{Directive[Cyan, Opacity[1], Arrowheads[Large], DotDashed, Thickness[.01]]},
{Directive[Green, Opacity[1], Thickness[.01]]}};

ga = Graph[{1 -> 1, 2 -> 1, 3 -> 1, 1 -> 1, 2 -> 1, 3 -> 2},
VertexLabels -> Placed["Name", Center], GraphStyle -> "DiagramGold", ImageSize -> 300,
EdgeStyle -> {(1 -> 1) -> stylelist[[1]], (2 -> 1) -> stylelist[[2]],
(3 -> 2) -> Yellow, (3 -> 1) -> stylelist[[4]]}];

gb = Fold[reStyleF[#][#2] &, ga,
{{1 -> 1, stylelist[[1]]}, {2 -> 1, stylelist[[2]]}, {3 -> 2, stylelist[[3]]}}];

Row[{ga, gb}]


A workaround: You can use EdgeShapeFunction and inject the desired styles as in this answer to a closely related question:
g1 = Graph[{1 -> 1, 2 -> 1,  3 -> 1, 1 -> 1, 2 -> 1, 3 -> 2},