How can I display a multigraph with different colored edges?

Question

I'm new to Mathematica(version 9) and I'm trying to display a multigraph with different colored edges. Here's my code so far:

G = {{1 -> 2, 1},  {2 -> 3, 1},  {3 -> 4, 1}, {4 -> 5, 1},
     {5 -> 6, 1},  {6 -> 7, 1},  {7 -> 8, 1}, {8 -> 9, 1},
     {9 -> 1, 1},  {1 -> 2, 2},  {2 -> 3, 2}, {3 -> 4, 2},
     {4 -> 5, 2},  {5 -> 6, 2},  {6 -> 7, 2}, {7 -> 8, 2},
     {8 -> 1, 2},  {1 -> 2, 3},  {2 -> 3, 3}, {3 -> 4, 3},
     {4 -> 5, 3},  {5 -> 6, 3},  {6 -> 7, 3}, {7 -> 1, 3},
     {1 -> 2, 4},  {2 -> 3, 4},  {3 -> 4, 4}, {4 -> 5, 4},
     {5 -> 6, 4},  {6 -> 1, 4},  {1 -> 2, 5}, {2 -> 3, 5},
     {3 -> 4, 5}, {4 -> 5, 5},   {5 -> 1, 5}}

GraphPlot[G,                
    EdgeRenderingFunction -> (Switch[#3, 1, {Black,  Line[#1]},
                                         2, {Red,    Line[#1]},
                                         3, {Blue,   Line[#1]},
                                         4, {Green,  Line[#1]},
                                         5, {Purple, Line[#1]}] &),
    VertexLabeling -> True,
    Method -> "CircularEmbedding",
    MultiedgeStyle -> All]

This draws a graph with only a few of its edges and gives many "Switch is not a graphics primitive or directive." errors. How can I get this code to draw all of the edges properly?

Thanks,

Corey

Answer 1

I tried to make a workaround substitute function for your particular GraphPlot that avoids the error with VertexLabeling by first drawing an unlabeled graph and then correcting the colors according to the Switch function you specified. In the initial plot, the edges are relatively easy to filter out because they appear in a single Line command. With this, I eventually arrived at this:

graphPlotColored[data_, colorFn_] := Module[{
   lines,
   edgdeLabelsSorted,
   unlabeledGraph = 
    GraphPlot[data[[All, 1]], VertexLabeling -> True, 
     Method -> "CircularEmbedding", MultiedgeStyle -> All]
   },
  lines = First@Cases[unlabeledGraph, Line[l_] :> l, Infinity];
  edgdeLabelsSorted = 
   Flatten@MapIndexed[
     Cases[data, {Rule @@ #, _}, Infinity][[Last@#2, 2]] &, 
     Gather[Map[#[[{1, -1}]] &, lines]], {2}];
  unlabeledGraph /. 
   Line[l_] :> 
    MapThread[{colorFn[#2], Line[#1]} &, {lines, edgdeLabelsSorted}]
  ]

g = {{1 -> 2, 1}, {2 -> 3, 1}, {3 -> 4, 1}, {4 -> 5, 1}, {5 -> 6, 
    1}, {6 -> 7, 1}, {7 -> 8, 1}, {8 -> 9, 1}, {9 -> 1, 1}, {1 -> 2, 
    2}, {2 -> 3, 2}, {3 -> 4, 2}, {4 -> 5, 2}, {5 -> 6, 2}, {6 -> 7, 
    2}, {7 -> 8, 2}, {8 -> 1, 2}, {1 -> 2, 3}, {2 -> 3, 3}, {3 -> 4, 
    3}, {4 -> 5, 3}, {5 -> 6, 3}, {6 -> 7, 3}, {7 -> 1, 3}, {1 -> 2, 
    4}, {2 -> 3, 4}, {3 -> 4, 4}, {4 -> 5, 4}, {5 -> 6, 4}, {6 -> 1, 
    4}, {1 -> 2, 5}, {2 -> 3, 5}, {3 -> 4, 5}, {4 -> 5, 5}, {5 -> 1, 
    5}};

graphPlotColored[g, (Switch[#, 1, Black, 2, Red, 3, Blue, 4, Green, 5,
     Purple] &)]

The way this works is that data is assumed to have edge labels for every edge, as in the example g. Then I make unlabeledGraph without those labels, and collect the raw edge lines in it. My observation on which everything is based is that each element in lines numbers the starting and end points by exactly the same numbers as the vertices in the graph. If the line is curved, there are other numbers in the line (referencing interpolating points in the GraphicsComplex of the graph), but they have higher numbers.

So I can establish a correspondence between each element of lines and the corresponding elements of data; and for multiple edges between identical vertices this correspondence is made unique by following the order in which lines appear in unlabeledGraph. This is what edgdeLabelsSorted is for. For each edge, it picks the label of an element in data that has the same end points.

Finally, I post-process unlabeledGraph with a rule that prepends each edge line with a graphics directive specified by colorFn, with the argument given by the label found in edgdeLabelsSorted.

Since this isn't supposed to be a general solution, I simply put the options from your example into the function unlabeledGraph by hand. This could be customized and extended further. But at least it seems to work for the type of graph you're looking at.