Amortiguación euclidiana y geodésica en R

Al comprender el almacenamiento en búfer geodésico , el equipo de desarrollo de geoprocesamiento de Esri distingue entre el almacenamiento en búfer geodésico y euclidiano. Concluyen con "El almacenamiento en búfer euclidiano realizado en clases de entidad proyectadas puede producir amortiguadores engañosos y técnicamente incorrectos. Sin embargo, el almacenamiento en búfer geodésico siempre producirá resultados geográficamente precisos porque los amortiguadores geodésicos no se ven afectados por las distorsiones introducidas por los sistemas de coordenadas proyectados".

Tengo que trabajar con un conjunto de datos global de puntos y las coordenadas no están proyectadas ( +proj=longlat +ellps=WGS84 +datum=WGS84). ¿Existe una función para crear un búfer geodésico en R cuando el ancho se da en unidades métricas? Soy consciente de gBufferde rgeospaquete. Esta función crea un búfer en unidades del objeto espacial que se usa ( ejemplo ), por lo tanto, tengo que proyectar las coordenadas para poder crear un búfer de X km deseado. Proyectando y luego aplicando un gBuffermedio en realidad haciendo un búfer euclidiano en lugar de uno geodésico que necesito. A continuación hay un código para ilustrar mis preocupaciones:

require(rgeos)
require(sp)
require(plotKML)

# Generate a random grid-points for a (almost) global bounding box
b.box <- as(raster::extent(120, -120, -60, 60), "SpatialPolygons")
proj4string(b.box) <- "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"
set.seed(2017)
pts <- sp::spsample(b.box, n=100, type="regular")
plot(pts@coords)

# Project to Mollweide to be able to apply buffer with `gBuffer` 
# (one could use other projection)
pts.moll <- sp::spTransform(pts, CRSobj = "+proj=moll")
# create 1000 km buffers around the points
buf1000km.moll <- rgeos::gBuffer(spgeom = pts.moll, byid = TRUE, width = 10^6)
plot(buf1000km.moll)
# convert back to WGS84 unprojected
buf1000km.WGS84 <- sp::spTransform(buf1000km.moll, CRSobj = proj4string(pts))
plot(buf1000km.WGS84) # distorsions are present
# save as KML to better visualize distorted Euclidian buffers on Google Earth
plotKML::kml(buf1000km.WGS84, file.name = "buf1000km.WGS84.kml")

La imagen a continuación muestra los buffers euclidianos distorsionados (radio de 1000 km) producidos con el código desde arriba.

Robert J. Hijmans en Introducción al paquete de "geosfera" , sección 4 Point at distance and bearingda un ejemplo de cómo hacer "polígonos circulares con un radio fijo, pero en coordenadas de longitud / latitud", que creo que se puede llamar un "amortiguador geodésico". Seguí esta idea y escribí un código que con suerte hace lo correcto, pero me pregunto si ya hay alguna función R de búfer geodésico en algún paquete que permita el radio métrico como entrada:

require(geosphere)

make_GeodesicBuffer <- function(pts, width) {
    ### A) Construct buffers as points at given distance and bearing
    # a vector of bearings (fallows a circle)
    dg <- seq(from = 0, to = 360, by = 5)

    # Construct equidistant points defining circle shapes (the "buffer points")
    buff.XY <- geosphere::destPoint(p = pts, 
                                    b = rep(dg, each = length(pts)), 
                                    d = width)

    ### B) Make SpatialPolygons
    # group (split) "buffer points" by id
    buff.XY <- as.data.frame(buff.XY)
    id  <- rep(1:length(pts), times = length(dg))
    lst <- split(buff.XY, id)

    # Make SpatialPolygons out of the list of coordinates
    poly   <- lapply(lst, sp::Polygon, hole = FALSE)
    polys  <- lapply(list(poly), sp::Polygons, ID = NA)
    spolys <- sp::SpatialPolygons(Srl = polys, 
                                  proj4string = CRS(as.character("+proj=longlat +ellps=WGS84 +datum=WGS84")))
    # Disaggregate (split in unique polygons)
    spolys <- sp::disaggregate(spolys)
    return(spolys)
}

buf1000km.geodesic <- make_GeodesicBuffer(pts, width=10^6)
# save as KML to visualize geodesic buffers on Google Earth
plotKML::kml(buf1000km.geodesic, file.name = "buf1000km.geodesic.kml")

La siguiente imagen muestra los amortiguadores geodésicos (radio de 1000 km).

Editar 2019-02-12 : por conveniencia, incluí una versión de la función en el paquete de geobuffer . Siéntase libre de contribuir con solicitudes de extracción.

Para la mayoría de los propósitos, será lo suficientemente preciso como para usar un modelo esférico de la Tierra, y la codificación será más fácil y los cálculos mucho más rápidos.

Siguiendo las sugerencias de M. Kennedy en un comentario, esta solución amortigua el Polo Norte (lo cual es fácil: el límite del buffer se encuentra en una latitud fija) y luego gira este buffer en cualquier ubicación deseada.

La rotación se efectúa convirtiendo el búfer original en coordenadas cartesianas geocéntricas (XYZ), rotando aquellas con una multiplicación de matriz (rápida) a lo largo del meridiano principal a la latitud objetivo, convirtiendo sus coordenadas nuevamente en Geográfico (lat-lon) y luego girando el búfer alrededor del eje de la Tierra simplemente agregando la longitud objetivo a cada segunda coordenada.

¿Por qué hacerlo en dos pasos cuando (normalmente) una sola multiplicación de matriz funcionaría? Porque no hay necesidad de un código especial para identificar los descansos en el meridiano de +/- 180 grados. En cambio, este enfoque puede generar longitudes más allá del rango original (ya sea -180 a 180 grados o 0 a 360 o lo que sea), pero al hacerlo, los procedimientos estándar de dibujo de polígonos (y otros procedimientos analíticos) funcionarán bien sin modificación. Si debe tener longitudes en un rango determinado, simplemente reduzca el módulo 360 grados al final: eso es rápido y fácil.

Cuando se almacenan puntos en el búfer, generalmente todos los búferes tienen el mismo radio. Esta solución modular permite una aceleración en este caso: puede amortiguar el Polo Norte y luego convertirlo en coordenadas XYZ de una vez por todas. Para amortiguar cada punto, se requiere una multiplicación de matriz (muy rápida), conversión de nuevo a coordenadas lat-lon y desplazamiento de las longitudes (también muy rápido). Espere generar alrededor de 10,000 buffers de alta resolución (360 vértices) por segundo.

Este Rcódigo muestra los detalles. Como su propósito es ilustrativo, no utiliza paquetes adicionales; Nada está escondido o enterrado. Incluye una prueba en la que se genera, almacena y almacena un conjunto de puntos aleatorios utilizando sus coordenadas lat-lon (geográficas) sin procesar. Aquí está la salida:

degrees.to.radians <- function(phi) phi * (pi / 180)
radians.to.degrees <- function(phi) phi * (180 / pi)
#
# Create a 3X3 matrix to rotate the North Pole to latitude `phi`, longitude 0.
# Solution: A rotation is a linear map, and therefore is determined by its
#           effect on a basis.  This rotation does the following:
#           (0,0,1) -> (cos(phi), 0, sin(phi))  {North Pole (Z-axis)}
#           (0,1,0) -> (0,1,0)                  {Y-axis is fixed}
#           (1,0,0) -> (sin(phi), 0, -cos(phi)) {Destination of X-axis}
#
rotation.create <- function(phi, is.radians=FALSE) {
  if (!is.radians) phi <- degrees.to.radians(phi)
  cos.phi <- cos(phi)
  sin.phi <- sin(phi)
  matrix(c(sin.phi, 0, -cos.phi, 0, 1, 0, cos.phi, 0, sin.phi), 3)
}
#
# Convert between geocentric and spherical coordinates for a unit sphere.
# Assumes `latlon` in degrees.  It may be a 2-vector or a 2-row matrix.
# Returns an array with three rows for x,y,z.
#
latlon.to.xyz <- function(latlon) {
  latlon <- degrees.to.radians(latlon)
  latlon <- matrix(latlon, nrow=2)
  cos.phi <- cos(latlon[1,])
  sin.phi <- sin(latlon[1,])
  cos.lambda <- cos(latlon[2,])
  sin.lambda <- sin(latlon[2,])
  rbind(x = cos.phi * cos.lambda,
        y = cos.phi * sin.lambda,
        z = sin.phi)
}
xyz.to.latlon <- function(xyz) {
  xyz <- matrix(xyz, nrow=3) 
  radians.to.degrees(rbind(phi=atan2(xyz[3,], sqrt(xyz[1,]^2 + xyz[2,]^2)),
                           lambda=atan2(xyz[2,], xyz[1,])))
}
#
# Create a circle of radius `r` centered at the North Pole, oriented positively.
# `r` is measured relative to the sphere's radius `R`.  For the authalic Earth,
# r==1 corresponds to 6,371,007.2 meters.
#
# `resolution` is the number of vertices to use in a polygonal approximation.
# The first and last vertex will coincide.
#
circle.create <- function(r, resolution=360, R=6371007.2) {
  phi <- pi/2 - r / R                       # Constant latitude of the circle
  resolution <- max(1, ceiling(resolution)) # Assures a positive integer
  radians.to.degrees(rbind(phi=rep(phi, resolution+1),
                           lambda=seq(0, 2*pi, length.out = resolution+1)))
}
#
# Rotate around the y-axis, sending the North Pole to `phi`; then
# rotate around the new North Pole by `lambda`.
# Output is in geographic (spherical) coordinates, but input points may be
# in Earth-centered Cartesian or geographic.
# No effort is made to clamp longitudes to a 360 degree range.  This can 
# facilitate later computations.  Clamping is easily done afterwards if needed:
# reduce the longitude modulo 360 degrees.
#
rotate <- function(p, phi, lambda, is.geographic=FALSE) {
  if (is.geographic) p <- latlon.to.xyz(p)
  a <- rotation.create(phi)   # First rotation matrix
  q <- xyz.to.latlon(a %*% p) # Rotate the XYZ coordinates
  q + c(0, lambda)            # Second rotation
}
#------------------------------------------------------------------------------#
#
# Test.
#
n <- 50                  # Number of circles
radius <- 1.5e6          # Radii, in meters
resolution <- 360
set.seed(17)             # Makes this code reproducible

#-- Generate random points for testing.
centers <- rbind(phi=(rbeta(n, 2, 2) - 1/2) * 180,
                 lambda=runif(n, 0, 360))

system.time({
  #-- Buffer the North Pole and convert to XYZ once and for all.
  p.0 <- circle.create(radius, resolution=resolution) 
  p <- latlon.to.xyz(p.0)

  #-- Buffer the set of points (`centers`).
  circles <- apply(centers, 2, function(center) 
    rotate(p, center[1], center[2]))

  #-- Convert into an array indexed by (latlon, vertex, point id).
  circles <- array(circles, c(2, resolution+1, n))
})
#
# Display the buffers (if there are not too many).
#
if (n <= 1000) {
  #-- Create a background map area and graticule.
  xlim <- range(circles[2,,]) # Extent of all longitudes in the buffers
  plot(xlim, c(-90, 90), type="n", xlim=xlim, ylim=c(-90,90), asp=1,
       xlab="Longitude", ylab="Latitude",
       main=paste(n, "Random Disks of Radius", signif(radius/1e3, 3), "Km"),
       sub="Centers shown with gray dots")
  abline(v=seq(-360, 720, by=45), lty=1, col="#d0d0d0")
  abline(h=seq(-90, 90, by=30), lty=1, col="#d0d0d0")

  #-- Display the buffers themselves.
  colors <- terrain.colors(n, alpha=1/3) # Vary their colors
  invisible(sapply(1:n, function(i) {
    polygon(circles[2,,i], circles[1,,i], col=colors[i])
  }))

  #-- Show the original points (and, optionally, labels).
  points(centers[2,], centers[1,], pch=21, bg="Gray", cex=min(1, sqrt(25/n)))
  # text(centers[2,], centers[1,], labels=1:n, cex=min(1, sqrt(100/n)))
}