Customising GraphPlot

Question

I am trying to get GraphPlot to order the nodes always in the same way. Unfortunately the graph spec (set of rules defining the connectivity) seems to override the VertexCoordinateRules specification, leading to an inconsistency with VertexRenderingFunction in spite of the fact that EdgeRenderingFunction seems to behave correctly. I hope that I am doing something wrong since I would much rather look stupid than discover that I have cleverly found the limit of what GraphPlot can do. Also, I realise from reading various posts (e.g. this) that Graph might be a better function to work with since it is more mathematical (or something). However, having invested so much time and effort in GraphPlot over the years I would rather get it to work if it is at all possible. In place of the specification one can use an adjacency matrix, but since I want rich labels for the nodes I don't think I can use it (and have not tried it). In order to explain the problem clearly I need to show quite a bit of code and output. Hopefully I am not breaking etiquette and, if I am, apologies in advance.

The application is a visualisation of the flow of credits in a mutual credit system between 6 different business sectors. There are 36 possible arrows between these 6 nodes, including self-loops (adjacency matrix is 6 x 6). In my visualisation the thickness of each arrow is proportional to the total volume of credits that have moved from one sector to another in the time window corresponding to the analysis. I need to:

• Be able to show an arbitrary number of arrows, in particular the n-thickest, where 1 <= n <= 36.

• Make the size of each node proportional to the total volume of credits sent by that sector.

• Arrange the 6 nodes always in the same fixed positions, even if not all nodes show up. This is because when using rules GraphPlot won't display a node that has no arrows going into it or coming out of it. This can be achieved using an adjacency matrix (see this), but as I say above I am not sure, in that case, whether I would be able to make each node a Disk with variable radius.

OK. I will first show the code and the output of a case that works fine, and then will show the case that I could not get to work.

Some initial data:

Clear[cat];
nSectors = 6;
cat = Table[i, {i, 1, nSectors}];
jIndex = {3, 4, 5, 1, 6, 2};
normSecSecVol = {
   {0.25515, 0.05141, 0.04060, 0.15890, 0.17294, 0.06380},
   {0.08274, 0.03464, 0.08215, 0.25191, 0.16752, 0.08861},
   {0.05404, 0.02809, 0.09767, 0.15798, 0.16552, 0.02086},
   {0.20103, 0.11734, 0.24655, 0.50854, 0.58478, 0.14337},
   {0.34976, 0.21686, 0.09425, 0.56797, 1.00000, 0.06062},
   {0.04310, 0.02636, 0.08167, 0.06989, 0.17527, 0.01062}
   };
normTotOfEachSecVol = {0.324, 0.309, 0.229, 0.787, 1., 0.178};

The data is normalised. The variable names should be self-explanatory. jIndex is needed because GraphPlot orders the rules in ascending (or alphabetical) order. I am using node numbers in this example code but in my real code I use sector names. jIndex gives me the alphabetical order of the sector names, which were not in that order in the raw data.

I wrote some code to order the locations of the 36 entries of normSecSecVol from smallest to largest. The result for the matrix above is this, where each location is trivially counted from the top-left to the bottom-right corner, row by row:

graphPosition = {36, 18, 32, 14, 8, 3, 31, 2, 13, 30, 6, 34, 33, 9, 7,
    12, 27, 15, 20, 24, 16, 4, 17, 11, 5, 35, 19, 26, 21, 10, 1, 25, 
   22, 28, 23, 29};

Now let us assume that I want to display the 6 thickest arrows. The code is this:

nArrowsToPlot = 6;
Clear[mask];
mask = Table[0, {i, 1, nSectors}, {j, 1, nSectors}];
kmax = nSectors^2;
kmin = kmax - nArrowsToPlot;
k = kmax;
While[k > kmin,
  modGraphPosition = Mod[graphPosition[[k]], nSectors];
  If[modGraphPosition == 0,
    modGraphPosition = nSectors
  ];
  i = IntegerPart[(graphPosition[[k]] - modGraphPosition)/nSectors ] + 1;
  j = modGraphPosition;
  mask[[i, j]] = 1;
  k--
  ];
MatrixForm[mask]

Now I want to know how many vertices need to be plotted, and which ones:

Total[mask];
Total[mask, {2}];
totRowCol = Total[mask] + Total[mask, {2}];
normTotal = totRowCol/Max[totRowCol] // N;
vertexMask = Ceiling[normTotal];
nVertices = Total[vertexMask]
vIndex = SparseArray[vertexMask]["AdjacencyLists"]

The result is nVertices = 3 and vIndex = {1,4,5}. Now let's build and sort the spec (apologies for the inelegant Do loops!):

Clear[graphSpecUnsorted, graphSpec];
graphSpecUnsorted = {};
Do[
  Do[
   If[ mask[[jIndex[[i]], jIndex[[j]]]] == 1,
    AppendTo[
     graphSpecUnsorted, {cat[[jIndex[[i]]]] -> cat[[jIndex[[j]]]],
                        normSecSecVol[[jIndex[[i]], jIndex[[j]]]]/60}]
    ],
   {i, 1, nSectors}
   ],
  {j, 1, nSectors}
  ];
MatrixForm[graphSpecUnsorted]
graphSpec = Sort[graphSpecUnsorted];
MatrixForm[graphSpec]

We now define the custom functions and plot the first graph (Note: I adapted the code for the coords from some other post, I am sorry I can't remember which):

c1 = 1;
c2 = 0.6;
erf = {Switch[#2[[1]],
        1, {RGBColor[0, 0.8, 0], Thickness[#3],
            Arrowheads[{{c1*#3^c2, 0.5}}], Arrow[#1]},
        2, {Magenta, Thickness[#3],
            Arrowheads[{{c1*#3^c2, 0.5}}], Arrow[#1]},
        3, {RGBColor[.6, 0, .8], Thickness[#3],
             Arrowheads[{{c1*#3^c2, 0.5}}], Arrow[#1]},
        4, {Red, Thickness[#3],
            Arrowheads[{{c1*#3^c2, 0.5}}], Arrow[#1]},
        5, {Blue, Thickness[#3],
            Arrowheads[{{c1*#3^c2, 0.5}}], Arrow[#1]},
        6, {Black, Thickness[#3],
            Arrowheads[{{c1*#3^c2, 0.5}}], Arrow[#1]}]} &;
vrf = {Yellow, EdgeForm[Black],
    Disk[#1, Sqrt[ normTotOfEachSecVol[[ vIndex[[#3]] ]] ]/3.5],
    Black, Text[Style[#2, FontSize -> 12, Bold], #1]} &;
myVertices = Sort[Union[Flatten[{graphSpec[[All, 1, 1]],graphSpec[[All, 1, 2]]}]]];
circleCoords = Table[Partition[Flatten[
      CircularEmbedding[nSectors]], 2][[ i ]], {i, 1, nSectors}];
coords = Table[ myVertices[[ i ]] -> circleCoords[[ vIndex[[ i]] ]], {i, nVertices} ];
GraphPlot[graphSpec,
    VertexCoordinateRules -> coords,
    VertexRenderingFunction -> vrf,
    DirectedEdges -> True,
    SelfLoopStyle -> 0.3,
    EdgeRenderingFunction -> erf,
    AspectRatio -> 1.4]

Great, this is all correct. Now let's look at the case that does not work. We set nArrowsToPlot = 12 and get the adjacency matrix:

In this case we have nVertices = 6 and vIndex = {1,2,3,4,5,6}. Building and sorting graphspec yields:

The new graph looks like this:

Now things are getting interesting. The arrows are all correct. The location of the names of the nodes (in this simple example just the integers 1 to 6) are also correct. What's messed up is the size of the nodes. Or, better, 1 and 6 are correct, the others are not. After some hours running around in circles I came up with this weird Sort algorithm:

nList = Length[graphSpec];
Sort[graphSpec];
Do[
  If[ (graphSpec[[i, 1, 2]] > graphSpec[[i + 1, 1, 1]]) &&
        (graphSpec[[i, 1, 2]] > graphSpec[[i + 1, 1, 2]]),
   temp = graphSpec[[i + 1]];
   graphSpec[[i + 1]] = graphSpec[[i]];
   graphSpec[[i]] = temp
   ],
  {i, 1, nList - 1}
  ];
MatrixForm[graphSpec]

Whose output is:

You will notice that all that's happened is that the rule 1 -> 5 has moved down a few lines. This helps, as can be seen from the next version of the graph:

Now nodes 1, 2, 5, and 6 are correct! However, nodes 3 and 4 are not, they are swapped relative to where they should be. I think this example makes it clear who the culprit is: in the 3rd graph spec, the second line is 2 -> 4, meaning that node 4 shows up in the list of rules before 3. This is what messes up GraphPlot since it will plot (the size of) node 4 before 3 as it goes around the circle following my coords specification, even though the labels themselves are correct.

So that's as far as I have got, and have run out of ideas. Is there any way to force GraphPlot to follow my coords? Can I do something different with coords or VertexRenderingFunction? Any help would be much appreciated.

System info: Mathematica 10 on MacBook Pro

Answer 1

The easiest way to fix the issue is to supply a Graph object to GraphPlot - this way, you can specify both edges and vertices, ensuring that the vertices are ordered like you want it.

The following code demonstrates how to apply this to your example (I've also cleaned up the rest of the code a bit)

normSecSecVol = {
   {0.25515, 0.05141, 0.04060, 0.15890, 0.17294, 0.06380},
   {0.08274, 0.03464, 0.08215, 0.25191, 0.16752, 0.08861},
   {0.05404, 0.02809, 0.09767, 0.15798, 0.16552, 0.02086},
   {0.20103, 0.11734, 0.24655, 0.50854, 0.58478, 0.14337},
   {0.34976, 0.21686, 0.09425, 0.56797, 1.00000, 0.06062},
   {0.04310, 0.02636, 0.08167, 0.06989, 0.17527, 0.01062}
   };
normTotOfEachSecVol = {0.324, 0.309, 0.229, 0.787, 1., 0.178};

vertices = <|MapIndexed[#2[[1]] -> # &, normTotOfEachSecVol]|>
(* <|1 -> 0.324, 2 -> 0.309, 3 -> 0.229, 4 -> 0.787, 5 -> 1., 6 -> 0.178|> *)

(* colors associated with each vertex *)
colors = {RGBColor[0, 0.8, 0], Magenta, RGBColor[0.6, 0, 0.8], Red, Blue, Black};

(* generate a list of rules of the form edge->weight *)
edges = Sort@<|Join @@ MapIndexed[Rule @@ #2 -> # &, normSecSecVol, {2}]|>;
<|(6 -> 6) -> 0.01062, … , (5 -> 5) -> 1.|>

c1 = 0.1;
c2 = 0.6;
GraphPlot[
 Graph[
  Range@Length@normTotOfEachSecVol,
  (* select the 6 last edges (which have the highest weights) *)
  Keys@Take[edges, -6],
  GraphLayout -> "CircularEmbedding"
  ],
 SelfLoopStyle -> 0.3,
 MultiedgeStyle -> All,
 VertexRenderingFunction -> (
   {
     Yellow,
     EdgeForm[Black],
     Disk[#1, Sqrt[normTotOfEachSecVol[[#2]]]/3.5],
     Black,
     Text[Style[#2, FontSize -> 12, Bold], #1]
     } &
   ),
 EdgeRenderingFunction -> (With[
     {w = edges[Rule @@ #2]},
     {
      colors[[#2[[1]]]],
      Thickness[0.02 w],
      Arrowheads[{{c1*w^c2, 0.5}}],
      Arrow@#1
      }
     ] &)
 ]

For 12 edges: