Euclidean dan Geodesic Buffering di R

Dalam Memahami Buffer Geodesik , Tim Pengembangan Geoproses Esri membedakan antara Euclidean dan Buffering Geodesik. Mereka menyimpulkan dengan "Buffer Euclidean yang dilakukan pada kelas fitur yang diproyeksikan dapat menghasilkan buffer yang menyesatkan dan salah secara teknis. Namun, buffering geodesik akan selalu menghasilkan hasil yang akurat secara geografis karena buffer geodesik tidak terpengaruh oleh distorsi yang diperkenalkan oleh sistem koordinat yang diproyeksikan".

Saya harus bekerja dengan dataset global titik dan koordinatnya tidak diproyeksikan ( +proj=longlat +ellps=WGS84 +datum=WGS84). Apakah ada fungsi untuk membuat buffer geodesik dalam R ketika lebar diberikan dalam satuan metrik? Saya tahu gBufferdari rgeospaket. Fungsi ini membuat buffer dalam satuan objek spasial yang digunakan ( contoh ), jadi, saya harus memproyeksikan koordinat untuk dapat membuat buffer X km yang diinginkan. Memproyeksikan dan kemudian menerapkan gBuffercara yang benar-benar membuat buffer Euclidean sebagai lawan dari Geodesic yang saya butuhkan. Di bawah ini adalah beberapa kode untuk menggambarkan kekhawatiran saya:

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

Gambar di bawah ini menggambarkan buffer Euclidian yang terdistorsi (radius 1000 km) yang dihasilkan dengan kode dari atas.

Robert J. Hijmans dalam Pengantar paket "geosphere" , bagian 4 Point at distance and bearingmemberikan contoh tentang bagaimana membuat "poligon melingkar dengan jari-jari tetap, tetapi dalam koordinat bujur / lintang", yang saya pikir dapat disebut "buffer geodesik". Saya mengacaukan ide ini dan saya menulis beberapa kode yang semoga melakukan hal yang benar, tetapi saya bertanya-tanya apakah sudah ada beberapa fungsi R-geodesik-buffer dalam beberapa paket yang memungkinkan radius metrik sebagai input:

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

Gambar di bawah ini menggambarkan buffer Geodesic (radius 1000 km).

Sunting 2019-02-12 : Untuk kenyamanan, saya membungkus versi fungsi dalam paket geobuffer . Jangan ragu untuk berkontribusi dengan permintaan tarik.

Untuk sebagian besar tujuan, cukup akurat untuk menggunakan model bola bumi - dan pengkodeannya akan lebih mudah dan perhitungannya jauh lebih cepat.

Mengikuti saran dari M. Kennedy dalam komentar, solusi ini mendukung Kutub Utara (yang mudah: batas buffer terletak pada garis lintang tetap) dan kemudian memutar buffer ini ke lokasi yang diinginkan.

Rotasi dilakukan dengan mengubah buffer asli ke koordinat Geosentris Cartesian (XYZ), memutarnya dengan multiplikasi matriks (cepat) di sepanjang Prime Meridian ke garis lintang target, mengubah koordinatnya kembali ke Geographic (lat-lon), dan kemudian memutar. penyangga di sekitar poros Bumi hanya dengan menambahkan garis bujur target ke setiap koordinat detik.

Mengapa melakukannya dalam dua langkah ketika (biasanya) perkalian satu matriks akan bekerja? Karena tidak perlu kode khusus untuk mengidentifikasi celah pada +/- 180 derajat meridian. Sebaliknya, pendekatan ini dapat menghasilkan garis bujur di luar kisaran asli (apakah -180 hingga 180 derajat atau 0 hingga 360 atau apa pun), tetapi dengan melakukan itu, prosedur menggambar poligon standar (dan prosedur analitik lainnya) akan berfungsi dengan baik tanpa modifikasi. Jika Anda harus memiliki garis bujur dalam kisaran yang diberikan, cukup kurangi mereka modulo 360 derajat di bagian paling akhir: itu cepat dan mudah.

Saat buffering point, biasanya semua buffer memiliki radius yang sama. Solusi modular ini memungkinkan untuk mempercepat dalam hal ini: Anda dapat menyangga Kutub Utara dan kemudian mengubahnya menjadi koordinat XYZ sekali dan untuk semua. Dengan demikian, setiap penyangga membutuhkan multiplikasi matriks (sangat cepat), konversi kembali ke koordinat lat-lon, dan pergeseran garis bujur (juga sangat cepat). Harapkan untuk menghasilkan sekitar 10.000 buffer resolusi tinggi (360 simpul) per detik.

RKode ini menunjukkan detailnya. Karena tujuannya adalah ilustrasi, ia tidak menggunakan paket tambahan; tidak ada yang disembunyikan atau dikubur. Ini termasuk tes di mana satu set titik acak dihasilkan, buffered, dan ditampilkan menggunakan koordinat lat-lon (Geografis). Inilah hasilnya:

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