13
$\begingroup$

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]

example bug

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

$\endgroup$
5
  • 2
    $\begingroup$ It works fine with version 8 (at least I saw no warnings). Here is the result. $\endgroup$
    – xzczd
    Jan 12, 2013 at 5:15
  • $\begingroup$ Weird. Thanks a lot. $\endgroup$
    – Corey
    Jan 12, 2013 at 5:58
  • 3
    $\begingroup$ It's true, version 9 gives an error. It's because it can't handle the labels for more than one undirected edge between the same vertices. E.g., you can try just one duplicate edge in this shortened graph (first and last entries are duplicates): g2 = {{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,7}};GraphPlot[g2, VertexLabeling -> True] Looks like a bug to me. $\endgroup$
    – Jens
    Jan 12, 2013 at 6:38
  • $\begingroup$ Your code also works as written in version 7. $\endgroup$
    – Mr.Wizard
    Jan 12, 2013 at 8:25
  • $\begingroup$ also works fine in version 11. $\endgroup$
    – kglr
    Aug 25, 2017 at 21:18

1 Answer 1

5
$\begingroup$

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] &)]

graph

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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.