rgeospatialigraphr-sfspdep

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


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)) 

ggplot

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)) 

ggplot2

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?


Solution

  • 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.