8
$\begingroup$

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"?

$\endgroup$
  • $\begingroup$ Take a look at this for embedding a perfect grid graph. If the graph is not a perfect grid, this method won't work though. $\endgroup$ – Szabolcs Oct 20 '16 at 19:16
8
$\begingroup$

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]]]]
   ]
$\endgroup$
  • $\begingroup$ @halmir Very nice answer! Is there a nice way to sort of map / snap the vertices in your output to a square / integer lattice? $\endgroup$ – Roger Harris Feb 7 '13 at 19:50
  • $\begingroup$ @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. $\endgroup$ – Szabolcs Feb 8 '13 at 0:33
  • $\begingroup$ @halmir Why does your procedure only appear to work for a 10 x 12 integer lattice? $\endgroup$ – Roger Harris Feb 8 '13 at 15:37
  • $\begingroup$ @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}}] $\endgroup$ – halmir Feb 8 '13 at 23:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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