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 e.g. c(1,2,9,8,10,16,17)
How can I subset to any higher order neighbors?
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.