Update 2: With version 12.1 comes EdgeTaggedGraph
which enables individual labeling and styling multi-edges:
EdgeTaggedGraph[{Style[Labeled[1 <-> 2, "lbl1"], Red],
Style[Labeled[1 <-> 2, "lbl2"], Blue], 2 <-> 3, 2 <-> 3, 3 <-> 1},
EdgeLabels->Placed["Name", Center]]
![enter image description here](https://i.sstatic.net/IUSdZ.png)
Update: An alternative method that that takes lists of vertices, edges, edge labels and edge styles.
Lexicographic sorting of the edges, labels and styles based on the vertex list seem to match the order in which edges are processed for rendering.
ClearAll[multiGraph2]
multiGraph2[vl_, elist_, elabels_, estyles_, o : OptionsPattern[Graph]] :=
Module[{esf, edges, labels, styles,
sorted = Transpose@ SortBy[Transpose[{elist, elabels, estyles}],
{PositionIndex[vl]@#[[1, 1]] &, PositionIndex[vl]@#[[1, 2]] &}]},
{edges, labels, styles} = {sorted[[1]], ## & @@ (RotateRight /@ sorted[[2 ;;]])};
esf = {First[styles = RotateLeft[styles]],
GraphElementData["Arrow"][##] /. Arrowheads[ah_] :>
Arrowheads[Append[ah, {.05, .5, Graphics[
Text[Framed[First[labels = RotateLeft[labels]],
FrameStyle -> None, Background -> White]]]}]]} &;
Graph[vl, edges, EdgeShapeFunction -> esf, o]]
Example:
SeedRandom[12345]
edges = RandomSample@ EdgeList[RandomGraph[{7, 10},
DirectedEdges -> True]][[{1, 1, 2, 2, 2, 3, 4, 5, 6, 7, 8, 9, 10}]];
edges = Flatten@Gather[edges];
styles = ColorData[97] /@ Range[Length@edges];
labels = Flatten[MapIndexed[Row[{#, CharacterRange["A", "Z"][[#2[[1]]]]}, "-"] &, #] & /@
Gather[edges]];
multiGraph2[RandomSample[Range[7]], edges, labels, styles,
VertexSize -> Medium, VertexLabels -> Placed["Name", Center], ImageSize -> Large]
![enter image description here](https://i.sstatic.net/Rh5jd.png)
Original answer:
A function that produces a multi-graph with distinct labels and styles for multi-edges given an input list of the form
{{v1, {{v11, label11, style11}, {v12, label12, style12}, ...}, ...}
The list is processed into an edge list and Association
s for edge labels and styles that are used to construct a custom EdgeShapeFunction
:
ClearAll[multiGraph]
multiGraph[a_, o : OptionsPattern[Graph]] := Module[{esf,
edges = Flatten[Thread[DirectedEdge[#[[1]], #[[2, All, 1]]]] & /@ a],
edgelabels = GroupBy[#, First -> Last, Flatten] &@
Flatten[Thread[Thread[DirectedEdge[#[[1]], #[[2, All, 1]]]] -> #[[2, All, 2]]]& /@ a],
edgestyles = GroupBy[#, First -> Last, Flatten] &@
Flatten[Thread[Thread[DirectedEdge[#[[1]], #[[2, All, 1]]]] -> #[[2, All, 3]]]& /@ a]},
esf = {Dashing[{}], First[edgestyles[#2] = RotateRight[edgestyles[#2] ]],
GraphElementData["Arrow"][##] /. Arrowheads[ah_] :> Arrowheads[Append[ah, {.05, .5,
Graphics[Text[Framed[First[edgelabels[#2] = RotateRight[edgelabels[#2] ]],
FrameStyle -> None, Background -> White]]]}]]} &;
Graph[edges, EdgeShapeFunction -> esf, o]]
Examples:
data = {{1, {{2, "A", Red}, {2, "B", Blue}, {3, "C", Green},
{3, "D", Directive[Thick, Orange]}}},
{2, {{3, "E", Directive[Dashed, Thick, Purple]}, {1, "F", Gray}}}};
data2 = data /. s_String :> Style[RandomWord["Noun"], 16, Black];
multiGraph[data2, VertexSize -> Small,
VertexLabels -> Placed["Name", Center], ImageSize -> Large, VertexLabelStyle -> Large]
![enter image description here](https://i.sstatic.net/2Qv9r.png)
SeedRandom[7777]
randomdata = {#, Table[{RandomChoice[Range@4], Style[RandomWord["Noun"], 14],
Opacity[1, RandomColor[]]}, RandomInteger[{2, 4}]]} & /@ Range[4];
multiGraph[randomdata, VertexSize -> Small, VertexLabels -> Placed["Name", Center],
ImageSize -> Large, VertexLabelStyle -> Medium]
![enter image description here](https://i.sstatic.net/7iP9m.png)
See also:
Graph
. $\endgroup$