# How can I sequentially apply different graph embeddings?

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

• 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. Oct 20, 2016 at 19:16

Here's the one way:

g = Graph[RandomSample[EdgeList[GridGraph[{10, 12}]], 218],
GraphLayout -> {"GridEmbedding", "Dimension" -> {10, 12}}] Apply SpringElectricalEmbedding to see how it work:

SetProperty[g, GraphLayout -> "SpringElectricalEmbedding"] Since you know your graph is rectangular, you can pick four corners by checking vertex degree.

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


Get possible tuples of corners:

In:= tuples = Subsets[corners, {2}]
Out= {{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:= bound = shortpath @@@ tuples;
{m, n} = Most[Sort[Union[Length /@ bound]]];
paths = Select[bound, Length[#] == m &]
Out= {{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[] = Reverse[paths[]];
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] 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[] = Reverse[paths[]];
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[] = Reverse[paths[]];
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]]]]
]

• @halmir Very nice answer! Is there a nice way to sort of map / snap the vertices in your output to a square / integer lattice? Feb 7, 2013 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. Feb 8, 2013 at 0:33
• @halmir Why does your procedure only appear to work for a 10 x 12 integer lattice? Feb 8, 2013 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}}] Feb 8, 2013 at 23:03