# Weighted graph with multiple different coloured non-weighted paths - styling

This follows on from my previous question answered here.

Ultimately, I now have a graph which I've simplified for posting here:

g1 = Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3,
3 \[UndirectedEdge] 1}, EdgeWeight -> {10, 10, 10},
VertexLabels -> Table[i -> Placed[i, Center], {i, 3}],
VertexLabelStyle -> Directive[White, Bold, 15], VertexSize -> 0.1,
GraphLayout -> {"VertexLayout" -> {"SpringElectricalEmbedding",
"EdgeWeighted" -> True}}]

r0 = {1, 2, 3};
e0 = DirectedEdge @@@ Partition[r0, 2, 1];

r1 = {1, 2, 1};
e1 = DirectedEdge @@@ Partition[r1, 2, 1];

e0, e1
]], {VertexCoordinates -> GraphEmbedding[g1],
VertexStyle -> {1 -> Red}, EdgeStyle -> {
Alternatives @@ e0 -> {Green, Thick},
Alternatives @@ e1 -> {Blue, Thick}
}}]


Which outputs the following: Ideally, one of the arrows from v1 to v2 would be green. However, as Mathematica views this edge in e1 as the same as the equivalent edge in e0, the formatting of the latter defined edge overwrites the e0 edge.

Research into options so far has spanned: (1) using this EdgeShapeFunction technique, which is not working as I believe the syntax isn't handling the collection of edges correctly and (2) looking into constructing custom sub DirectedEdge type objects to trick Mathematica into thinking they were different, which I don't believe is possible given my layman's understanding of the software.

• Properties for multigraphs are not supported. This is a very annoying limitation of Mathematica. I suggest you contact Wolfram Support and complain about it. If you (and others) don't, then there is no chance that this will improve in the future. Oct 4, 2018 at 8:09

Using the same approach as in this answer

i = 1;
{VertexCoordinates -> GraphEmbedding[g1],  VertexStyle -> {1 -> Red},
EdgeShapeFunction->{Alternatives @@ Intersection[e0, e1] ->
({Arrowheads[{0, 0, .05, 0}], Thick, {Blue, Green}[[i++]], Arrow[#]} &)},
EdgeStyle -> {Alternatives@@e1 -> {Blue, Thick}, Alternatives@@e0 -> {Green, Thick}}}] For the general case with multiple groups with arbitrary intersections, you can use the general method in the linked answer by specifying the list of styles for each distinct edge in the input graph ... as follows:

ClearAll[index, style]
styles = Normal @ GroupBy[Flatten[Thread[# ->
Directive[#2, Arrowheads[{0, 0, .05, 0}], Thick]] & @@@
Thread[{{e0, e1}, {Green, Blue}}]], First -> Last] ;
g0 = Graph[Join[EdgeList[g1], e0, e1], EdgeStyle -> styles, VertexStyle -> {1 -> Red} ,
VertexLabels -> Table[i -> Placed[i, Center], {i, 3}],
VertexLabelStyle -> Directive[White, Bold, 15],
VertexSize -> 0.1  , VertexCoordinates -> GraphEmbedding[g1]] ;
distinctedges = DeleteDuplicates[Join[e0, e1]] ;
(style[#] = PropertyValue[{g0, #}, EdgeStyle]) & /@ distinctedges;
(index[#] = 1) & /@  distinctedges;
g2 = Fold[(SetProperty[{#,  #2}, EdgeShapeFunction ->
({ style[#2][[index[#2]++]], Arrow[#]} &)]) &,   g0,  distinctedges]


In general, here's another way to style multigraph edges without using SetProperty. Just make a matrix of the edges and their styles:

$styles = {{a -> e, Green}, {e -> b, Green}, {a -> b, Red}, {a -> b, Directive[Dashing[{Small, Small}], Blue]}, {a -> b, RGBColor[1, 0.5, 0]}, {a -> b, Directive[RGBColor[0.5, 0, 0.5], Dashing[0.01]]}}; ef = (Block[{st, p}, st = $$styles[[p = FirstPosition[$$styles, #2 | (#2 /. DirectedEdge -> Rule)][]]][]; $$styles = Delete[$$styles, p]; {Thickness[0.008], Arrowheads[{{.08, .5}}], st, Arrow@#}] &) Graph[$styles[[All,1]],
VertexLabels -> Placed["Name", Center], VertexSize -> 0.14,
VertexLabelStyle -> Directive[FontSize -> 17, FontColor -> White],
EdgeShapeFunction -> ef
] u = Directive[Gray, Thickness[0.002], Arrowheads];
$$styles = {1 \[DirectedEdge] 2 -> RGBColor[0, 0, 1], 1 \[DirectedEdge] 2 -> RGBColor[0, 1, 0], 1 \[UndirectedEdge] 2 -> u, 1 \[UndirectedEdge] 3 -> u, 2 \[DirectedEdge] 3 -> RGBColor[0, 1, 0], 2 \[UndirectedEdge] 3 -> u, 2 \[DirectedEdge] 1 -> RGBColor[0, 0, 1]}; Graph[{1 \[UndirectedEdge] 2, 2 \[UndirectedEdge] 3, 3 \[UndirectedEdge] 1, 1 \[DirectedEdge] 2, 1 \[DirectedEdge] 2, 2 \[DirectedEdge] 1, 2 \[DirectedEdge] 3}, EdgeWeight -> {10, 10, 10, 0, 0, 0, 0}, VertexLabels -> Table[i -> Placed[i, Center], {i, 3}], VertexLabelStyle -> Directive[White, Bold, 15], VertexSize -> 0.1, VertexStyle -> {1 -> Red}, GraphLayout -> {"VertexLayout" -> {"SpringElectricalEmbedding", "EdgeWeighted" -> True}}, EdgeShapeFunction -> ( Module[{st, p}, st =$$styles[[p =
FirstPosition[$$styles, #2][]]][];$$styles =
Delete[\$styles, p];
VertexLabels -> "Name"]
` • I am unsure how I am able to discern different routes via this method, sorry? On a map with 12 nodes, and five routes of length 5-10, this is quite mentally cumbersome. Oct 4, 2018 at 2:27
• @JordanMacLachlan it's easy to just specify the styles explicitly
– M.R.
Oct 4, 2018 at 3:00
• I haven't seen this way of doing multigraph styling, nice! Oct 4, 2018 at 18:28
• @JordanMacLachlan Do you see how it works now?
– M.R.
Oct 4, 2018 at 19:01
• For the record: if I could note two posts as answers to the original question, I would also accept this solution. Given I implemented the technique first posted, I will keep that as my accepted answer, however. Regardless, I really appreciate your help. Thank you. Oct 4, 2018 at 21:08