Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Imagine I have some graph G, and I perform a graph embedding using a command like:

G = Graph[GraphEdges, GraphLayout -> {"SpringElectricalEmbedding"}]

I then want to apply a "GridEmbedding" to the post-Spring/Electrical embedded graph.

How can I do this?

Specifically, I have a graph I know to be a rectangular lattice, but the vertices are at random positions initially. Attempting a direct "GridEmbedding" yields junk; however the "SpringElectricalEmbedding" almost works, but begins to fail around the edges of the graph. Does anyone have advice for dealing with this?

Alternatively, can "GridEmbedding" be made to respect edge lengths / weights akin to what is possible for "SpringElectricalEmbedding"?

share|improve this question
add comment

1 Answer 1

up vote 8 down vote accepted

Here's the one way:

g = Graph[RandomSample[EdgeList[GridGraph[{10, 12}]], 218], 
      GraphLayout -> {"GridEmbedding", "Dimension" -> {10, 12}}]

enter image description here

Apply SpringElectricalEmbedding to see how it work:

SetProperty[g, GraphLayout -> "SpringElectricalEmbedding"]

enter image description here

Since you know your graph is rectangular, you can pick four corners by checking vertex degree.

In[356]:= corners = VertexList[g, x_ /; VertexDegree[g, x] == 2]
Out[356]= {111, 120, 10, 1}

Get possible tuples of corners:

In[357]:= tuples = Subsets[corners, {2}]
Out[357]= {{111, 120}, {111, 10}, {111, 1}, {120, 10}, {120, 1}, {10, 1}}

Generate shortest path function for further computation:

shortpath = FindShortestPath[g];

By checking lengths of paths between corners, you could find two boundary paths:

In[359]:= bound = shortpath @@@ tuples;
          {m, n} = Most[Sort[Union[Length /@ bound]]];
           paths = Select[bound, Length[#] == m &]
Out[361]= {{111, 112, 113, 114, 115, 116, 117, 118, 119, 120}, {10, 9,
           8, 7, 6, 5, 4, 3, 2, 1}}

Compute grids of vertex indices:

pairs = If[Length[shortpath[paths[[1, 1]], paths[[2, 1]]]] == n,
   Transpose[paths], paths[[1]] = Reverse[paths[[1]]]; 
   Transpose[paths]];
grids = (VertexIndex[g, #] & /@ shortpath[##]) & @@@ pairs;

Compute coordinates using "SpringElectricalEmbedding":

coords = GraphEmbedding[g, "SpringElectricalEmbedding"];

Now straighten coords by the mean of each grid lines:

Table[coords[[i, 2]] = Mean[coords[[i, 2]]];, {i, grids}];
 Table[
coords[[i, 1]] = Mean[coords[[i, 1]]];, {i, Transpose[grids]}];

Here's the results:

SetProperty[g, VertexCoordinates -> coords]

enter image description here

You could make function to do all steps:

gridCoordinates[g_] :=
   Block[{coords, corners, tuples, shortpath, bound, m, n, paths, pairs,
     grids},
    coords = GraphEmbedding[g, "SpringElectricalEmbedding"];
    corners = VertexList[g, x_ /; VertexDegree[g, x] == 2];
    tuples = Subsets[corners, {2}];
    shortpath = FindShortestPath[g];
    bound = shortpath @@@ tuples;
    {m, n} = Most[Sort[Union[Length /@ bound]]];
    paths = Select[bound, Length[#] == m &];
    pairs = If[Length[shortpath[paths[[1, 1]], paths[[2, 1]]]] == n,
              Transpose[paths], paths[[1]] = Reverse[paths[[1]]]; 
              Transpose[paths]];
    grids = (VertexIndex[g, #] & /@ shortpath[##]) & @@@ pairs;
    Table[coords[[i, 2]] = Mean[coords[[i, 2]]];, {i, grids}];
    Table[coords[[i, 1]] = Mean[coords[[i, 1]]];, {i, Transpose[grids]}];
    coords
   ]

Here's the version that generate coordinate on unit grid:

  gridUnitCoordinates[g_] :=
   Block[{coords, corners, tuples, shortpath, bound, m, n, paths, pairs,
     grids},
    corners = VertexList[g, x_ /; VertexDegree[g, x] == 2];
    tuples = Subsets[corners, {2}];
    shortpath = FindShortestPath[g];
    bound = shortpath @@@ tuples;
    {m, n} = Most[Sort[Union[Length /@ bound]]];
    paths = Select[bound, Length[#] == m &];
    pairs = If[Length[shortpath[paths[[1, 1]], paths[[2, 1]]]] == n,
              Transpose[paths], paths[[1]] = Reverse[paths[[1]]]; 
              Transpose[paths]];
    grids = (VertexIndex[g, #] & /@ shortpath[##]) & @@@ pairs;
    {m, n} = Dimensions[grids];
    coords = Flatten[Table[{j, i}, {i, m}, {j, n}], 1];
    coords[[Ordering[Flatten[grids]]]]
   ]
share|improve this answer
    
Just a small note: SpringEmbedding typically gives better results for grid like graphs than SpringElectricalEmbedding. –  Szabolcs Feb 7 '13 at 17:15
    
@halmir Very nice answer! Is there a nice way to sort of map / snap the vertices in your output to a square / integer lattice? –  Roger Harris Feb 7 '13 at 19:50
    
@RogerHarris Nearest may work for that (haven't tried). It'd be necessary to actually find a lattice with the correct dimensions for this to work well. This may give ideas for that. –  Szabolcs Feb 8 '13 at 0:33
    
@halmir Why does your procedure only appear to work for a 10 x 12 integer lattice? –  Roger Harris Feb 8 '13 at 15:37
    
@RogerHarris what do you mean? it should work any integer lattice.. for example, m = 24; n = 32; g = Graph[ RandomSample[EdgeList[GridGraph[{m, n}]], EdgeCount[GridGraph[{m, n}]]], GraphLayout -> {"GridEmbedding", "Dimension" -> {m, n}}] –  halmir Feb 8 '13 at 23:03
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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