Weighted graph with multiple different coloured non-weighted paths - styling
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)][[1]]]][[2]];
$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
]
Here's your example:
u = Directive[Gray, Thickness[0.002], Arrowheads[0]];
$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][[1]]]][[2]]; $styles =
Delete[$styles, p];
{Arrowheads[{{.03, .95}}], st, Arrow@#}] &),
VertexLabels -> "Name"]
Using the same approach as in this answer
i = 1;
SetProperty[EdgeAdd[g1, Join[e0, e1]],
{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]