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$ Commented Mar 14, 2019 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$ Commented Mar 14, 2019 at 12:22

2 Answers 2

Reset to default
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$ Commented Mar 14, 2019 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$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.