Given a spatial (hexagonal) grid how can I obtain a sample of higher order neighbors?

Question

I would like to "thin" a grid made with sf::st_make_grid and obtain a subset of higher order neighbors.

First order neighbors share at least one side, 2nd order neighbors share a side with 1st order neighbors, etc.

Here is an example:

require(sf)
require(ggplot2)

x = st_sfc(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0,0)))))
g = st_make_grid(x, cellsize = .3, square = FALSE )
g = st_as_sf(g)
g$id = 1:nrow(g)

ggplot(g) + geom_sf() + geom_sf_text(aes(label = id)) 

A possible subset of 2nd order neighbors would then be:

gs = g[g$id %in% c(3:5, 11:12, 18:20),]
ggplot(gs) + geom_sf() + geom_sf_text(aes(label = id)) 

but other samples are also possible eg c(1,2,9,8,10,16,17)

How can I subset to any higher order neighbors?

Answer 1

I would try solving your problem as follows. Just one "disclaimer": I'm not sure that the following approach is 100% correct and that it works in all situations. Moreover, as discussed in the previous comment, the following solution is not unique and you can get different "thinning" according to the starting point and the choices behind the algorithm.

Load packages

# packages
library(sf)
library(igraph)
library(ggplot2)

Generate data and plot all polygons

x = st_sfc(st_polygon(list(rbind(c(0,0), c(1,0), c(1,1), c(0, 1), c(0,0)))))
g = st_make_grid(x, cellsize = .3, square = FALSE)
g = st_as_sf(g)
g$id = 1:nrow(g)

# plot all polygons
ggplot(g) + 
  geom_sf() + 
  geom_sf_text(aes(label = id)) 

Extract the graph structure behind the cells, and plot it

my_graph <- graph_from_adj_list(st_touches(g))
plot(my_graph)

You can notice that it's more or less the same as before, without any geographical structure. If you apply the same code to a "real-world problem", you may need to use a different spatial predicate and tune the sf objects' precision since there may be rounding errors in the coordinates.

Now, calculate the list of first-order neighbours (that should be excluded) starting from the first cell

id_to_be_ignored <- ego(my_graph, order = 1, nodes = 1)[[1]]

and the list of first and second-order neighbours

all_second_order_neighbours <- ego(my_graph, order = 2, nodes = 1)[[1]]

The final sample should include the difference between these two ids

final_sample <- difference(all_second_order_neighbours, id_to_be_ignored)

Now I need to repeat this operation for the second-order cells

i <- 1
while (TRUE) {
  # We need to end the loop sooner or later
  if (i > length(final_sample)) break
  
  # Extract the id of the node
  id <- final_sample[[i]]
  
  # Determine and exclude first order neighbours considering the id-th node
  ego1_id <- ego(my_graph, order = 1, nodes = id)[[1]]
  id_to_be_ignored <- union(id_to_be_ignored, difference(ego1_id, V(my_graph)[id]))
  
  # Determine and add second order neighbours considering the id-th node
  ego2_id <- difference(
    ego(my_graph, order = 2, nodes = id)[[1]], 
    ego1_id
  )
  final_sample <- difference(union(final_sample, ego2_id), id_to_be_ignored)
  
  # Increment i
  i <- i + 1
}

So this is the result

ggplot(g[c(1, as.integer(final_sample)), ]) + 
  geom_sf() + 
  geom_sf_text(aes(label = id))

Now I repeat with neighbours of order 3

id_to_be_ignored <- ego(my_graph, order = 2, nodes = 1)[[1]]
all_third_order_neighbours <- ego(my_graph, order = 3, nodes = 1)[[1]]
final_sample <- difference(all_third_order_neighbours, id_to_be_ignored)
i <- 1
while (TRUE) {
  if (i > length(final_sample)) break
  
  id <- final_sample[[i]]
  
  ego2_id <- ego(my_graph, order = 2, nodes = id)[[1]]
  id_to_be_ignored <- union(id_to_be_ignored, difference(ego2_id, V(my_graph)[id]))
  
  ego3_id <- difference(
    ego(my_graph, order = 3, nodes = id)[[1]], 
    ego2_id
  )
  final_sample <- difference(union(final_sample, ego3_id), id_to_be_ignored)
  
  # Increment i
  i <- i + 1
}

Again, this is the result

ggplot(g[c(1, as.integer(final_sample)), ]) + 
  geom_sf() + 
  geom_sf_text(aes(label = id))

^{Created on 2021-01-28 by the reprex package (v0.3.0)}

The same code should also work with different spatial structures and orders of neighbourhoods.