Miscellaneous functions for simple features

st_miscellaneous.R

#' Count intersections of y within geometries in x
#' 
#' @param x sf object
#' @param y sf object
#' @param varname the name of the new count column
#' @return x with an added 'count' column
st_count <- function(x, 
                     y,
                     varname = "count"){
  
  suppressMessages({
    sf::sf_use_s2(FALSE)
    ix <- sf::st_intersects(x,y)
    sf::sf_use_s2(TRUE)
  })
  
  gcol <- attr(x, "sf_column")
  x |>
    dplyr::mutate({{varname}} := lengths(ix), .before = dplyr::all_of(gcol))
  
}


#' Aggregate a variable in y within geometries in x
#' 
#' @param x sf object
#' @param y sf object
#' @param fun function to use for summarizing
#' @param na.rm logical, if TRUE remove NA values before summarizing
#' @return x with an added column
st_aggregate <- function(x, 
                         y,
                         varname = colnames(y)[1],
                         fun = sum,
                         na.rm = TRUE){
  
  suppressMessages({
    sf::sf_use_s2(FALSE)
    ix <- sf::st_intersects(x,y)
    sf::sf_use_s2(TRUE)
  })
  
  value <- rep(NA_real_, length(ix))
  for(i in seq_len(length(ix))){
    if (length(ix[[i]]) > 0) value[i] <- fun(y[[varname]][ix[[i]]], na.rm = na.rm)
  }
  gcol <- attr(x, "sf_column")
  x |>
    dplyr::mutate({{varname}} := value, .before = dplyr::all_of(gcol))
  
}