#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.