4
$\begingroup$

I have already found a way to generate this graph with the following:

Graph[Sort/@UndirectedEdge@@@Position[Outer[EuclideanDistance@##&,#,#,1],N@Sqrt@2]&@GraphEmbedding@GridGraph@{8,8}//Union]

but I'm wondering if there's a shorter way to do this, possibly by using

GraphData[{"Bishop",{8,8}}]

The issue is that the Bishop Graph contains all diagonal connections, including further than nearest neighbor. TransitiveReductionGraph is a step in the right direction, but that takes out too many edges.

Improve this question
$\endgroup$
2
  • $\begingroup$ I do not think that there is a well-founded method to retrieve this graph from the bishop graph. (Note that kglr's relies on a particular ordering of the adjacency matrix, which is not a property of the graph.) $\endgroup$ – Szabolcs Mar 14 '19 at 12:19
  • $\begingroup$ As for TransitiveReductionGraph, it is really meaningful only for directed graphs. For an undirected graph, it would be a simple spanning tree. You should also be aware that TransitiveReductionGraph is still buggy despite multiple requests to fix it during the past 4 years. Personally I am very frustrated with Wolfram Research's neglect of Graph processing functions. $\endgroup$ – Szabolcs Mar 14 '19 at 12:22
3
$\begingroup$

Update: Inspired by Henrik's answer, an alternative way to use SparseArray to construct the adjacency matrix directly:

nzp[n_] := SparseArray[{Band[{1, n + 2}, {n^2, n^2}] -> Join[ConstantArray[1, n - 1], {0}],
    Band[{2, n + 1}, {n^2, n^2}] -> Join[ConstantArray[1, n - 1], {0}]}, {n^2, n^2}][
  "NonzeroPositions"]

Graph[Range[8^2], UndirectedEdge @@@ nzp[8]]

enter image description here

And using the original grid layout (as suggested in Szabolcs's deleted answer):

Graph[Range[8^2], UndirectedEdge @@@ nzp[8], VertexCoordinates -> Tuples[Range@8, {2}]]

enter image description here

Update 2: If you have to work with GraphData[{"Bishop", {8,8}}] you can process its AdjacencyMatrix to delete the unwanted elements:

n = 8;
e = UndirectedEdge @@@ DeleteCases[
      GraphData[{"Bishop", {n, n}}, "AdjacencyMatrix"][  "NonzeroPositions"],
        {i_, j_} /; i > j || j > i + n + 2];

Graph[Range[n^2], e]

same picture as above

Original answer:

AdjacencyGraph[1 - Unitize[DistanceMatrix @ Tuples[Range@8, {2}] - Sqrt[2]]]

enter image description here

Also

RelationGraph[Sqrt[2] == EuclideanDistance @ ## &, Tuples[Range @ 8, {2}]]

same picture

RelationGraph[Abs[# - #2] == {1, 1} &, Tuples[Range@8, {2}]]

same picture

Improve this answer
$\endgroup$
1
  • $\begingroup$ Oh, you're right. Must have been a caching issue on my side. I'm sorry for the disturbance. $\endgroup$ – Henrik Schumacher Mar 14 '19 at 8:29
1
$\begingroup$

Here is an alternative method; not really short, though.

It imploys that on a grid graph, the only pairs of distinct points that are connected by precisely two paths of length 2 are precisely those that have "diagonal distance" 1. Thus, we can determine these pairs by utilizing the square of the adjacency matrix as follows:

n = 8;
G = GridGraph[{n, n}];
A = AdjacencyMatrix[G];
edges = SparseArray[UpperTriangularize[1 - Unitize[A.A - 2], 1]]["NonzeroPositions"];
Graph[VertexList[G], UndirectedEdge @@@ edges]

This does not contain any construction of a dense distance matrix, so it should scale much better for larger values of n (it is already 100 times faster than OP's method). Just in case OP would like to increase n.

Improve this answer
$\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.