How to get distinct labels on parallel edges in a graph?

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

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

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 Associations 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

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

See also:

  • GraphUnion but with multiple edges?
  • Graph: Coloring parallel edges individually
  • Weighted graph with multiple different coloured non-weighted paths - styling
  • Coloring multi-edges in graphs