Skip to content

Instantly share code, notes, and snippets.

@obrl-soil
Last active October 7, 2020 17:09
Show Gist options
  • Save obrl-soil/5eb280b924f08b0caf57575233170b73 to your computer and use it in GitHub Desktop.
Save obrl-soil/5eb280b924f08b0caf57575233170b73 to your computer and use it in GitHub Desktop.
'random' sampling with minimum distance separation with sf in R
# re https://twitter.com/Dale_Masch/status/1184744060428242944
library(sf)
nc <- st_read(system.file("shape/nc.shp", package="sf"))
# I should get this damn epsg code tattooed somewhere
nc1 <- st_transform(nc[1, ], 32617)
# randomise grid origin a little
rx <- sample(seq(-250, 250), 1)
ry <- sample(seq(-250, 250), 1)
or <- st_bbox(nc1)[c("xmin", "ymin")] + c(rx, ry)
gr <- st_make_grid(nc1, n = c(20,20), what = 'polygons', square= F, offset = or)
# min sep 1000m
gr2 <- st_buffer(gr, -500)
#grpts <- st_sample(gr2, rep(1, length(gr2)))
# wait, this is heaps faster:
grpts <- sapply(gr2, st_sample, size = 1)
grpts <- st_as_sfc(grpts, crs = 32617)
plot(nc1[0], reset = F)
plot(grpts, add = T, col = 'red', pch = 20)
# proof
library(spatstat)
bbg <- st_bbox(grpts)
grcppp <- ppp(st_coordinates(grpts)[,1], st_coordinates(grpts)[,2],
window = owin(c(bbg[1], bbg[3]), c(bbg[2], bbg[4])))
summary(nndist(grcppp))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment