4

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.

J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
Kai
  • 2,099
  • 8
  • 17
  • 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.) – Szabolcs Mar 14 '19 at 12:19
  • 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. – Szabolcs Mar 14 '19 at 12:22

2 Answers2

3

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

kglr
  • 394,356
  • 18
  • 477
  • 896
1

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.

Henrik Schumacher
  • 106,770
  • 7
  • 179
  • 309