Euklidische und geodätische Pufferung in R.

Um das geodätische Puffern zu verstehen , unterscheidet das Esri Geoprocessing Development Team zwischen euklidischem und geodätischem Puffern. Sie schließen mit "Euklidische Pufferung, die an projizierten Feature-Classes durchgeführt wird, kann zu irreführenden und technisch inkorrekten Puffern führen. Geodätische Pufferung führt jedoch immer zu geografisch genauen Ergebnissen, da geodätische Puffer nicht durch die durch projizierte Koordinatensysteme verursachten Verzerrungen beeinflusst werden."

Ich muss mit einem globalen Punktdatensatz arbeiten und die Koordinaten sind nicht projiziert ( +proj=longlat +ellps=WGS84 +datum=WGS84). Gibt es eine Funktion zum Erstellen eines geodätischen Puffers in R, wenn die Breite in metrischen Einheiten angegeben wird? Mir ist gBufferaus dem rgeosPaket bekannt. Diese Funktion erstellt einen Puffer in Einheiten des verwendeten räumlichen Objekts ( Beispiel ). Daher muss ich die Koordinaten projizieren, um einen Puffer mit den gewünschten X km erstellen zu können. Projizieren und dann ein gBufferMittel anwenden , um tatsächlich einen euklidischen Puffer zu erstellen, im Gegensatz zu einem geodätischen, den ich brauche. Unten finden Sie einen Code, der meine Bedenken veranschaulicht:

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")

Das Bild unten zeigt die verzerrten euklidischen Puffer (Radius 1000 km), die mit dem Code von oben erzeugt wurden.

Robert J. Hijmans in Abschnitt Einführung in das Paket "Geosphäre"4 Point at distance and bearing gibt ein Beispiel für die Herstellung von "kreisförmigen Polygonen mit festem Radius, jedoch in Längen- / Breitengradkoordinaten", die meines Erachtens als "geodätischer Puffer" bezeichnet werden können. Ich bin dieser Idee gefolgt und habe Code geschrieben, der hoffentlich das Richtige tut, aber ich frage mich, ob es in einem Paket bereits eine geodätische Puffer-R-Funktion gibt, die den metrischen Radius als Eingabe zulässt:

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")

Das Bild unten zeigt die geodätischen Puffer (Radius 1000 km).

Edit 2019-02-12 : Der Einfachheit halber habe ich eine Version der Funktion in das Geobuffer- Paket eingeschlossen. Fühlen Sie sich frei, mit Pull-Anfragen beizutragen.

Für die meisten Zwecke ist es genau genug, um ein sphärisches Modell der Erde zu verwenden - und die Codierung wird einfacher und die Berechnungen viel schneller.

Nach den Vorschlägen von M. Kennedy in einem Kommentar puffert diese Lösung den Nordpol (was einfach ist: Die Puffergrenze liegt auf einem festen Breitengrad) und dreht diesen Puffer dann an eine beliebige gewünschte Stelle.

Die Drehung erfolgt durch Konvertieren des ursprünglichen Puffers in geozentrische kartesische (XYZ) Koordinaten, Drehen derjenigen mit einer (schnellen) Matrixmultiplikation entlang des Nullmeridians zum Zielbreiten, Konvertieren seiner Koordinaten zurück in geografische (lat-lon) und anschließendes Drehen den Puffer um die Erdachse einfach durch Hinzufügen der Ziellänge zu jeder zweiten Koordinate.

Warum in zwei Schritten, wenn (normalerweise) eine einzelne Matrixmultiplikation funktionieren würde? Weil kein spezieller Code erforderlich ist, um die Brüche am +/- 180-Grad-Meridian zu identifizieren. Stattdessen kann dieser Ansatz Längengrade erzeugen, die über den ursprünglichen Bereich hinausgehen (ob -180 bis 180 Grad oder 0 bis 360 Grad oder was auch immer). Auf diese Weise funktionieren Standardverfahren zum Zeichnen von Polygonen (und andere Analyseverfahren) ohne Änderung einwandfrei. Wenn Sie Längengrade in einem bestimmten Bereich haben müssen, reduzieren Sie diese ganz am Ende einfach um 360 Grad: Das geht schnell und einfach.

Beim Puffern von Punkten haben normalerweise alle Puffer den gleichen Radius. Diese modulare Lösung ermöglicht in diesem Fall eine Beschleunigung: Sie können den Nordpol puffern und ihn dann ein für alle Mal in XYZ-Koordinaten umwandeln. Das Puffern jedes Punktes erfordert dabei eine (sehr schnelle) Matrixmultiplikation, eine Umrechnung in Lat-Lon-Koordinaten und eine Verschiebung der Längen (ebenfalls sehr schnell). Erwarten Sie etwa 10.000 hochauflösende Puffer (360 Eckpunkte) pro Sekunde.

Dieser RCode zeigt die Details. Da es sich um eine Illustration handelt, werden keine Zusatzpakete verwendet. nichts ist verborgen oder begraben. Es enthält einen Test, bei dem eine Reihe von zufälligen Punkten generiert, gepuffert und unter Verwendung der rohen Lat-Lon-Koordinaten (geografisch) angezeigt wird. Hier ist die Ausgabe:

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)))
}