Return to Answer

replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/

edited Apr 13, 2017 at 12:56

It's a modification of solution in How can I sequentially apply different graph embeddings?How can I sequentially apply different graph embeddings?.

gridPosition[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]]; shortpath @@@ pairs] g = GridGraph[{5, 6}]; graph = Graph[RandomSample[VertexList@g], EdgeList@g, VertexLabels -> "Name"]; gridPosition[graph]

{1, 6, 11, 16, 21, 26}, {2, 7, 12, 17, 22, 27}, {3, 8, 13, 18, 23, 28}, {4, 9, 14, 19, 24, 29}, {5, 10, 15, 20, 25, 30}

It's a modification of solution in How can I sequentially apply different graph embeddings?.

gridPosition[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]]; shortpath @@@ pairs] g = GridGraph[{5, 6}]; graph = Graph[RandomSample[VertexList@g], EdgeList@g, VertexLabels -> "Name"]; gridPosition[graph]

{1, 6, 11, 16, 21, 26}, {2, 7, 12, 17, 22, 27}, {3, 8, 13, 18, 23, 28}, {4, 9, 14, 19, 24, 29}, {5, 10, 15, 20, 25, 30}

It's a modification of solution in How can I sequentially apply different graph embeddings?.

gridPosition[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]]; shortpath @@@ pairs] g = GridGraph[{5, 6}]; graph = Graph[RandomSample[VertexList@g], EdgeList@g, VertexLabels -> "Name"]; gridPosition[graph]

{1, 6, 11, 16, 21, 26}, {2, 7, 12, 17, 22, 27}, {3, 8, 13, 18, 23, 28}, {4, 9, 14, 19, 24, 29}, {5, 10, 15, 20, 25, 30}

Source Link

answered Oct 20, 2016 at 16:45

halmir

16.2k
38
59

It's a modification of solution in How can I sequentially apply different graph embeddings?.

gridPosition[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]]; shortpath @@@ pairs] g = GridGraph[{5, 6}]; graph = Graph[RandomSample[VertexList@g], EdgeList@g, VertexLabels -> "Name"]; gridPosition[graph]

{1, 6, 11, 16, 21, 26}, {2, 7, 12, 17, 22, 27}, {3, 8, 13, 18, 23, 28}, {4, 9, 14, 19, 24, 29}, {5, 10, 15, 20, 25, 30}