R/st_poly_sample.R

In juoe/spatialtoolbox: Collection of functions for doing spatial stuff.

#' Sample points within polygons
#'
#' @param x A sf polygon object.
#' @param n Number of point samples per point.
#' @param min_dist Optional. Required minimum distance for sampled points in meters.
#' @param n_mod Numeric of length two determining how n is increased for sampling bbox of each polygon. The following formula is used: n+n_mod[1]*n_mod[2].
#' @param ... Arguments passed on to st_sample
#'
#' @return A sf object of points representing samples within input polygons.
#' @export

st_poly_sample <- function(x, n, min_dist = NULL, n_mod =c(5, 2),  ...) {

  # remove empty geometries
  x <- x %>% dplyr::filter(!st_is_empty(x))

  data <- sf::st_set_geometry(x, NULL) %>% split(seq(nrow(.)))

  in_crs <- st_crs(x)
  processing_crs <- in_crs

  if(!is.null(min_dist) & st_is_longlat(x)) {
    x <- st_transform(x, 3857)
    processing_crs <- st_crs(x)
  }

  points <- purrr::map(st_geometry(x), function(geometry){

    p <- sf::st_sample(geometry, n+n_mod[1]*n_mod[2])

    if (!is.null(min_dist)) {
      d <- sf::st_is_within_distance(p, p, dist = min_dist)
      distant <- table(unlist(d)) == 1
      p_good <- p[distant]
      p_bad <- p[!distant]

      if(length(p_good) < n){

        for (i in seq_along(p_bad)) {
          if (sf::st_is_within_distance(p_bad[i], p_good, min_dist) %>% unlist %>% length == 0) {
            p_good <- c(p_good, p_bad[i])
          }
        }

      }

      p <- p_good

    }

    return(p)

  })

  data_points <- purrr::map2(points, data, function(points, data) {

    cbind(points, data) %>%
      dplyr::sample_n(n, replace = TRUE) %>%
      dplyr::distinct()

  })


  out <- do.call(rbind, data_points) %>% sf::st_as_sf(crs= processing_crs)

  if (processing_crs != in_crs) {
    out <- st_transform(out, in_crs)
  }

  rownames(out) <- NULL
  return(out)


}