Nothing
#' Remove geographical identity
#'
#' Build a buffer around the a set of geographical coordinates
#' and take a random point around the buffer. The function is
#' used to omit the precise location of tricot participants
#' but keeping a close distance to its agro-environment
#'
#' @param longlat a data.frame or matrix with geographical coordinates long lat
#' @param dist numeric, buffer distance for all \var{lonlat}
#' @param nQuadSegs integer, number of segments per quadrant
#' @param ... further arguments passed to \code{\link[sf]{sf}} methods
#' @return A data frame with the random coordinates long lat whithin a pre-defined buffer
#' @examplesIf interactive()
#' xy <- matrix(c(11.097799, 60.801090,
#' 11.161298, 60.804199,
#' 11.254428, 60.822457),
#' nrow = 3, ncol = 2, byrow = TRUE)
#'
#' rmGeoIdentity(xy)
#'
#' #' the function also handles NAs
#'
#' xy2 <- matrix(c(11.097799, 60.801090,
#' NA, NA,
#' 11.161298, 60.804199,
#' 11.254428, 60.822457,
#' 11.254428, NA),
#' nrow = 5, ncol = 2, byrow = TRUE)
#'
#' rmGeoIdentity(xy2)
#'
#' @export
rmGeoIdentity <- function(longlat, dist = 0.015, nQuadSegs = 2L, ...){
longlat <- as.matrix(longlat)
n <- nrow(longlat)
# check NAs in lonlat
anyNAs <- is.na(longlat[,1]) | is.na(longlat[,2])
# put all both xy as NA
longlat[anyNAs, ] <- NA
# split lonlat by rows
longlat <- split(longlat, seq_len(n))
# transform into sf points
longlat <- lapply(longlat, function(l) {
a <- list(x = l)
do.call("st_point", a)
})
# and then into a geometry list column
longlat <- do.call("st_sfc", longlat)
args <- list(x = longlat,
dist = dist,
nQuadSegs = nQuadSegs)
lonlatb <- do.call("st_buffer", args)
result <- split(lonlatb, seq_len(n))
result[!anyNAs] <- lapply(result[!anyNAs], function(x){
a <- list(x = x, size = 1, type = "random", by_polygon = TRUE)
do.call("st_sample", a)
})
result <- do.call(rbind, result)
result <- do.call("st_sfc", result)
r <- matrix(NA, nrow = n, ncol = 2)
r[!anyNAs, ] <- matrix(unlist(result),
ncol = 2,
nrow = sum(!anyNAs),
byrow = TRUE)
r <- as.data.frame(r)
names(r) <- c("long", "lat")
return(r)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.