polygon_neighbour_set.R

nc <- sf::read_sf(system.file("shape/nc.shp", package="sf"), quiet = TRUE)
library(silicate)

## 
## Attaching package: 'silicate'

## The following object is masked from 'package:stats':
## 
##     filter

x <- SC(nc)
objects <- sc_object(x) %>% dplyr::select(object_)  ## objects (SF calls these "features")
nobj <- nrow(objects)

set.seed(100)
nc$colour <- sample(viridis::viridis(nobj))

## for a given object, what other objects are touching by 1) vertex 2) edge
## per ith object
for (ith in seq_len(nobj)) {
  ## objects by edge
 u_edge <-   dplyr::slice(objects, ith) %>%
    dplyr::inner_join(x$object_link_edge, "object_") %>%
    dplyr::inner_join(sc_edge(x), "edge_") %>%
   dplyr::select(edge_) %>%
   dplyr::inner_join(x$object_link_edge, "edge_") %>%
    dplyr::distinct(object_)
 u_vertex <-
   dplyr::slice(objects, ith) %>%
   dplyr::inner_join(x$object_link_edge, "object_") %>%
   dplyr::inner_join(sc_edge(x), "edge_") %>%
tidyr::pivot_longer( cols = c(.vx0, .vx1), names_to = "node", values_to = "vertex_") %>%
   dplyr::inner_join(sc_vertex(x), "vertex_") %>%
   dplyr::select(vertex_) %>%
   dplyr::inner_join(tidyr::pivot_longer(sc_edge(x),  cols = c(.vx0, .vx1), names_to = "node", values_to = "vertex_"), "vertex_" ) %>%
   dplyr::inner_join(x$object_link_edge, "edge_") %>%
   dplyr::distinct(object_)


 e_idx <- match(u_edge$object_, objects$object_)
 v_idx <- match(u_vertex$object_, objects$object_)
  ## only look at it if the set of neighbours is different by vertex vs. edge
  if (!length(e_idx) == length(v_idx)) {
    par(mfrow = c(3, 1), mar = c(rep(0.75, 4)))

    # Target county
    plot(nc[1], col = "firebrick", main = "Target county", reset = FALSE) ## this format requires special care to make a map
    plot(nc[ith, 1], add = TRUE, col = nc$colour[ith])

    plot(nc[, 1], col = "firebrick", main = "Edge share", reset = FALSE); plot(nc[e_idx, 1], add = TRUE, col = nc$colour[e_idx])
    plot(nc[, 1], col = "firebrick", main = "Vertex share", reset = FALSE); plot(nc[v_idx, 1], add = TRUE, col = nc$colour[v_idx])
    print(v_idx)
    print(e_idx)
  }

}

## [1]  9 15 24  5 16 31
## [1]  9 15  5 16 24

## [1]  3 10 25 12 26
## [1] 10 25  3 12

## [1] 12 27 26 11 10 25
## [1] 12 27 26 10 11

## [1] 16 36 33 28 31  9 24  5
## [1] 16 36 33 31  9  5 28

## [1] 24 37 31 54 13 15  9 16
## [1] 24 37 13 15  9 31

## [1] 25 42 26 40 23  3 10 12
## [1] 25 42 40 23  3 10 26

## [1] 26 47 42 27 25 10 12
## [1] 26 47 42 25 12 27

## [1] 31 54 49 24 37  9 16 33
## [1] 31 54 24 16 33 49

## [1] 37 48 63 30 13 24 31 54
## [1] 37 48 30 13 24 54 63

## [1] 42 70 50 71 47 40 25 26
## [1] 42 70 50 40 25 26 47

## [1] 43 46 61 22 34 52 64 65
## [1] 43 46 22 34 52 64 61

## [1] 39 69 50 71 40 42 70
## [1] 50 69 39 40 42 71

## [1] 43 52 64 65 39 34 41
## [1] 52 65 43 34 41 39

## [1] 53 72 61 55 75 38 35 46
## [1] 53 72 55 38 35 46 61

## [1] 54 63 79 37 24 31 49 62
## [1] 54 63 37 31 49 62 79

## [1] 55 75 53 72 66 58 38
## [1] 55 75 66 58 38 53

## [1] 64 76 61 43 52 65
## [1] 64 61 43 65 76

## [1] 64 65 76 68 43 52 39
## [1] 65 76 64 52 39 68

##  [1] 67 70 89 47 48 60 63 82 86 92
## [1] 67 70 47 48 60 63 82 86 89

## [1] 70 71 85 42 50 47 67 89
## [1] 70 71 42 47 67 89 85

## [1] 71 85 70 84 69 50 42
## [1] 71 85 84 69 50 70

## [1] 72 75 53 55 61 77
## [1] 72 75 53 61 77

## [1] 66 75 55 53 72
## [1] 75 66 55 72

## [1] 86 92 94 67 89 82
## [1] 86 92 67 82 94

## [1] 85 89 92 70 67 86
## [1] 89 85 70 67 92

## [1] 92 94 89 67 86
## [1] 92 89 86 94