R'de poligon centroidler nasıl hesaplanır (bitişik olmayan şekiller için)

Bu sorunun cevabını bulmak için biraz zaman harcadım. Bir Google aramasından hemen belli olmadığından , cevabı buraya göndermenin yararlı olabileceğini düşündüm. Bitişik olmayan poligonlar hakkında ek bir soru da var .

Anında kolay cevap: komutu kullanın:

centroids <- getSpPPolygonsLabptSlots(polys)

(Bu bulunmuştur sınıf açıklama R kapsayıcı uzamsal paket için SpatialPolygonsDataFrame R veri sınıfı, sp )

Bu tam olarak aynı şeyi yapmak gibi görünüyor

cents <- SpatialPointsDataFrame(coords=cents, data=sids@data, proj4string=CRS("+proj=longlat +ellps=clrk66"))

Aşağıdaki kodda, herhangi bir R kurulumunda çoğaltılabilir olması gerekir (deneyin!)

#Rcentroids
install.packages("GISTools")
library(GISTools)
sids <- readShapePoly(system.file("shapes/sids.shp", package="maptools")[1], 
                      proj4string=CRS("+proj=longlat +ellps=clrk66"))
class(sids)
plot(sids)
writeSpatialShape(sids, "sids")
cents <- coordinates(sids)
cents <- SpatialPointsDataFrame(coords=cents, data=sids@data, 
                  proj4string=CRS("+proj=longlat +ellps=clrk66"))
points(cents, col = "Blue")
writeSpatialShape(cents, "cents")

centroids <- getSpPPolygonsLabptSlots(sids)
points(centroids, pch = 3, col = "Red")

Sentlerin (mavi) ve centroidlerin (kırmızı) özdeş centroidler olduğu yerlerde (kodu çalıştırdıktan sonra bu grafik görüntülenmelidir):

Çok uzak çok iyi. Ancak QGIS'de poligon centroidleri hesapladığınızda (menü: Vector | Geometry | Polygon Centroids), bitişik olmayan poligonlar için biraz farklı sonuçlar vardır:

Yani bu soru 3 şeydir:

1. Hızlı ve kolay cevap
2. Bitişik olmayan çokgenler için centroid hesaplamak için R kullanan insanlar için bir uyarı
3. Çok parçalı (bitişik olmayan) çokgenleri düzgün bir şekilde hesaba katmak için R'de nasıl yapılması gerektiği hakkında bir soru

Öncelikle, bunu söyleyen coordinatesveya getSpPPolygonsLabptSlotskütle merkezi merkezini döndüren hiçbir belge bulamıyorum . Aslında, ikinci işlev şimdi 'Onaysız' olarak görünür ve bir uyarı vermelidir.

Centroid'i bir özelliğin kütle merkezi olarak hesaplamak istediğiniz şey paketin gCentroidişlevidir rgeos. Bunu yapmak help.search("centroid")bulmuş olacak.

trueCentroids = gCentroid(sids,byid=TRUE)
plot(sids)
points(coordinates(sids),pch=1)
points(trueCentroids,pch=2)

farkı göstermeli ve Qgis centroidleri ile aynı olmalıdır.

Burada sf kullanan bir yaklaşım var. Gösterdiğim gibi, sf :: st_centroid ve rgeos :: gCentroid sonuçları aynı.

library(sf)
library(ggplot2)

# I transform to utm because st_centroid is not recommended for use on long/lat 
nc <- st_read(system.file('shape/nc.shp', package = "sf")) %>% 
  st_transform(32617)

# using rgeos
sp_cent <- gCentroid(as(nc, "Spatial"), byid = TRUE)

# using sf
sf_cent <- st_centroid(nc)

# plot both together to confirm that they are equivalent
ggplot() + 
  geom_sf(data = nc, fill = 'white') +
  geom_sf(data = sp_cent %>% st_as_sf, color = 'blue') + 
  geom_sf(data = sf_cent, color = 'red') 

Bu problemin üstesinden gelmek için yaptığım şey, dışbükey bir poligonu bekleyecek kadar küçük olana kadar poligonu negatif bir şekilde tamponlayan bir fonksiyon üretmektir. Kullanılacak işlevcentroid(polygon)

#' find the center of mass / furthest away from any boundary
#' 
#' Takes as input a spatial polygon
#' @param pol One or more polygons as input
#' @param ultimate optional Boolean, TRUE = find polygon furthest away from centroid. False = ordinary centroid

require(rgeos)
require(sp)

centroid <- function(pol,ultimate=TRUE,iterations=5,initial_width_step=10){
  if (ultimate){
    new_pol <- pol
    # For every polygon do this:
    for (i in 1:length(pol)){
      width <- -initial_width_step
      area <- gArea(pol[i,])
      centr <- pol[i,]
      wasNull <- FALSE
      for (j in 1:iterations){
        if (!wasNull){ # stop when buffer polygon was alread too small
          centr_new <- gBuffer(centr,width=width)
          # if the buffer has a negative size:
          substract_width <- width/20
          while (is.null(centr_new)){ #gradually decrease the buffer size until it has positive area
            width <- width-substract_width
            centr_new <- gBuffer(centr,width=width)
            wasNull <- TRUE
          }
          # if (!(is.null(centr_new))){
          #   plot(centr_new,add=T)
          # }
          new_area <- gArea(centr_new)
          #linear regression:
          slope <- (new_area-area)/width
          #aiming at quarter of the area for the new polygon
          width <- (area/4-area)/slope
          #preparing for next step:
          area <- new_area
          centr<- centr_new
        }
      }
      #take the biggest polygon in case of multiple polygons:
      d <- disaggregate(centr)
      if (length(d)>1){
        biggest_area <- gArea(d[1,])
        which_pol <- 1                             
        for (k in 2:length(d)){
          if (gArea(d[k,]) > biggest_area){
            biggest_area <- gArea(d[k,])
            which_pol <- k
          }
        }
        centr <- d[which_pol,]
      }
      #add to class polygons:
      new_pol@polygons[[i]] <- remove.holes(new_pol@polygons[[i]])
      new_pol@polygons[[i]]@Polygons[[1]]@coords <- centr@polygons[[1]]@Polygons[[1]]@coords
    }
    centroids <- gCentroid(new_pol,byid=TRUE)
  }else{
    centroids <- gCentroid(pol,byid=TRUE)  
  }  
  return(centroids)
}

#Given an object of class Polygons, returns
#a similar object with no holes


remove.holes <- function(Poly){
  # remove holes
  is.hole <- lapply(Poly@Polygons,function(P)P@hole)
  is.hole <- unlist(is.hole)
  polys <- Poly@Polygons[!is.hole]
  Poly <- Polygons(polys,ID=Poly@ID)
  # remove 'islands'
  max_area <- largest_area(Poly)
  is.sub <- lapply(Poly@Polygons,function(P)P@area<max_area)  
  is.sub <- unlist(is.sub)
  polys <- Poly@Polygons[!is.sub]
  Poly <- Polygons(polys,ID=Poly@ID)
  Poly
}
largest_area <- function(Poly){
  total_polygons <- length(Poly@Polygons)
  max_area <- 0
  for (i in 1:total_polygons){
    max_area <- max(max_area,Poly@Polygons[[i]]@area)
  }
  max_area
}