6
$\begingroup$

I have n x n GridGraph (or n x m), I trying to add diagonal edges for each square box automatically and then assign same weights to the diagonals, same weights to horizontal edges and same weights to Vertical edges.

9 X9 grid graph with cross edges

I am using

n = 3;
G = GridGraph[{n, n}, VertexLabels -> "Name"];
ce = {1 <-> 5, 2 <-> 6, 4 <-> 8, 5 <-> 9, 2 <-> 4, 3 <-> 5, 5 <-> 7, 6 <-> 8};
ea = EdgeAdd[G, ce]
GG = Normal[AdjacencyMatrix[ea]];

Is there any way i can do this for any n x n grid without manually adding edges.

for 3x3 graph the upward edge is (n -> n + 4) until n - 4 (5th node is the last to have this edge). And for downward edge its (n -> n + 2) until (n - 3).

I found one more code here which was adding the diagonal edges but the edges are added randomly.

n = 20;
G = GridGraph[{n, n}];
adjMgg = Normal[AdjacencyMatrix[G]];
ind = RandomVariate[BernoulliDistribution[1/2], {n - 1, n - 1}] + 1;
crossedges = 
  Table[
    {(i - 1) n + j <-> (i - 1) n + j + n + 1,
     (i - 1) n + j + 1 <-> (i - 1) n + j + n}[[ind[[i, j]]]], 
    {i, 1, n - 1}, {j, 1, n - 1}] // Flatten;
adjMdg = Normal[AdjacencyMatrix[EdgeAdd[G, crossedges]]];
adjWeight = 300*adjMgg + (adjMdg - adjMgg) /. {0 -> ∞};
dg = 
  WeightedAdjacencyGraph[adjWeight, 
    GraphLayout -> {"GridEmbedding", "Dimension" -> {n, n}}, 
    VertexLabels -> "Name", EdgeLabels -> "EdgeWeight", 
    VertexLabelStyle -> Directive[RGBColor[0.08, 0.35, 0.65], Bold, 10], 
    EdgeStyle -> Directive[GrayLevel[.7]], 
    VertexStyle -> RGBColor[0.08, 0.35, 0.65], 
    VertexSize -> 0.15, 
    ImagePadding -> 10, 
    ImageSize -> Scaled[0.8]];
Module[{i = 1, j = n^2, path}, 
  path = FindShortestPath[dg, i, 381];
  HighlightGraph[dg, PathGraph @ path, GraphHighlightStyle -> "Thick"]]
$\endgroup$
7
$\begingroup$
n = {3, 5};
g = GridGraph[{n, n}, VertexLabels -> "Name"];
edAdd = Sort /@ UndirectedEdge @@@ Position[Outer[EuclideanDistance@## &, #, #, 1], 
                                            N@Sqrt@2] &@ GraphEmbedding@g // Union
EdgeAdd[g, edAdd]

Mathematica graphics

$\endgroup$
  • $\begingroup$ I believe v10 has DistanceMatrix that should simplify this even more (by replacing the Outer[ ...]) $\endgroup$ – Dr. belisarius Mar 23 '16 at 23:19
9
$\begingroup$

Mathematica has a built-in function :)

GraphData[{"King", {m, n}}]

GraphData[{"King", {3, 7}}]

enter image description here

$\endgroup$
  • $\begingroup$ The downside is that this does not work for general arguments $n$ and $m$. For example, at the time of writing, GraphData[{"King", {11, 11}}] results in an error. $\endgroup$ – Juho Nov 1 at 18:12
2
$\begingroup$
Clear[diagGraph]
diagGraph[n_Integer] :=
 EdgeAdd[
   GridGraph[{n, n}, VertexLabels -> "Name"],
   Join[
    Table[i <-> i + n + 1, {i, Select[Range[1, n^2 - n], Mod[#, n] != 0 &]}],
    Table[i <-> i + n - 1, {i, Select[Range[2, n^2 - n + 1], Mod[#, n] != 1 &]}]
   ]
 ]

diagGraph[5]

Mathematica graphics

$\endgroup$
  • 1
    $\begingroup$ I just changed range equation to Range[1, n^2-n] and Range[2, N^2-n+1]; this makes the graph universal you can use any number and generate n X n graph. Thanks a lot for the help $\endgroup$ – Nakul Padalkar Mar 24 '16 at 15:41
  • $\begingroup$ @NakulPadalkar Thank you for pointing that out, I forgot to change those out from a previous draft! I fixed them now. $\endgroup$ – MarcoB Mar 24 '16 at 16:07
2
$\begingroup$

Update: Using RelationGraph (new in version 10.2) with ChessboardDistance:

ClearAll[ggF]
ggF[r_, c_, o : OptionsPattern[]] := Module[{v = Join @@ Array[{##} &, {c, r}]},
  RelationGraph[ChessboardDistance[v[[#]], v[[#2]]] == 1 &, 
   Range[r c], o, VertexCoordinates -> v, VertexLabels -> "Name"]]

Example:

ggF[4, 7, VertexLabels -> Placed["Name", Center], ImageSize -> 500,  
 VertexStyle -> Yellow, VertexLabelStyle -> Directive[Bold, Blue, 16], 
 VertexSize -> Large]

enter image description here

Original answer:

ClearAll[diagGridGraph];
diagGridGraph[n_Integer, m_Integer, opts : OptionsPattern[]] := 
 Module[{v = Range[n m], mat, edges},
  mat = Transpose[Reverse@Partition[Reverse@v, n]];
  edges = UndirectedEdge @@@ DeleteDuplicates[Sort /@ Flatten[Thread /@ 
        ComponentMeasurements[mat, "Neighbors", CornerNeighbors -> True]]];
  Graph[v, edges, GraphLayout -> {"GridEmbedding", "Dimension" -> {n, m}}, opts]]

diagGridGraph[4, 8, VertexLabels -> Placed["Name", Center], VertexSize -> .3]

Mathematica graphics

$\endgroup$
1
$\begingroup$

You will like this maybe

NearestNeighborGraph[GraphEmbedding@GridGraph[{5, 6}], 
 DistanceFunction -> ChessboardDistance]

i

$\endgroup$
1
$\begingroup$

Create a grid of points:

pts = Tuples[{Range[4], Range[6]}];

Create a nearest neighbour graph with an appropriate cutoff distance. At the same time, add edge weights as euclidean distances.

NearestNeighborGraph[pts, {All, 3/2}, 
 EdgeWeight -> {edge_ :> Apply[EuclideanDistance, edge]}]
$\endgroup$
0
$\begingroup$
grid = GridGraph[{5, 6}];

EdgeDelete[
 GraphPower[
  VertexReplace[grid, 
   Thread[VertexList[grid] -> GraphEmbedding@grid]], 
  2], _?(MemberQ[Abs[Subtract @@ #], 2.] &)]

Mathematica graphics

$\endgroup$

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.