Topology for neighbours

library(tidyverse)
library(sf)
library(scsf)

## Loading required package: sc

nc = st_read(system.file("shape/nc.shp", package="sf"), quiet = TRUE)
x <- PRIMITIVE(nc)


## this function uniquifies the segments, very much WIP
u_edges <- function(x, ...) UseMethod("u_edges")
u_edges.PRIMITIVE <- function(x, ...) {
  u_edges(x[["segment"]])
}
u_edges.data.frame <- function(x, ...) {
  u2 <- x %>%         mutate(uu = paste(pmin(.vertex0, .vertex1), pmax(.vertex0, .vertex1), sep = "_"))
  #dplyr::distinct(select(u2, uu, segment_), uu,  .keep_all = TRUE)
  select(u2, uu, segment_)
}


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

## filter to the ith
for (ith in seq_len(nrow(nc))) {
  xith <- x$object[ith, "object_"] %>% inner_join(x$path, "object_") %>% 
    inner_join(x$path_link_vertex, "path_") %>% 
    inner_join(x$vertex, "vertex_")
  
  ## join by vertex 
  idx_vertex <- xith %>% dplyr::select(vertex_) %>% 
    inner_join(x$path_link_vertex, "vertex_") %>% 
    inner_join(x$path, "path_") %>% 
    distinct(object_) ##%>% inner_join(nc %>% mutate(object_ = x$object_))
  v_idx <- match(idx_vertex$object_, x$object$object_)
  
  
  ## join the subset data to the main on unique segment 
  ## (unique as in order of vertices is irrelevant)
  idx_edge <- u_edges.data.frame(x$object[ith, "object_"] %>% 
                                   inner_join(x$path, "object_") %>% 
                                   inner_join(x$segment, "path_")) %>%  
    select(-segment_) %>% inner_join(u_edges.PRIMITIVE(x), "uu") %>% 
    inner_join(x$segment, "segment_") %>% inner_join(x$path, "path_") %>% 
    distinct(object_)
  e_idx <- match(idx_edge$object_, x$object$object_)
  
  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")
    plot(nc[ith, 1], add = TRUE, col = nc$colour[ith])
    
    plot(nc[, 1], col = "firebrick", main = "Edge share"); plot(nc[e_idx, 1], add = TRUE, col = nc$colour[e_idx])
    plot(nc[, 1], col = "firebrick", main = "Vertex share"); 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] 15  9  5 16 24

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

##  [1] 67 70 89 47 48 60 63 82 86 92
## [1] 70 67 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] 70 71 85 84 69 50 42
## [1] 85 71 84 69 50 70

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

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

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

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

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