Cách tính đa giác đa giác theo R (đối với hình dạng không liền kề)

Tôi đã dành một chút thời gian để tìm ra câu trả lời cho câu hỏi này. Nó không rõ ràng ngay lập tức từ một tìm kiếm Google , vì vậy nghĩ rằng nó có thể hữu ích để đăng câu trả lời ở đây. Ngoài ra còn có một câu hỏi bổ sung về đa giác không tiếp giáp .

Câu trả lời dễ dàng ngay lập tức: sử dụng lệnh:

centroids <- getSpPPolygonsLabptSlots(polys)

(Điều này đã được tìm thấy trong mô tả lớp của lớp dữ liệu SpatialPolygonsDataFrame R cho gói không gian bao trùm trong R, sp )

Điều này dường như làm chính xác như

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

trong đoạn mã sau, có thể được sao chép trên bất kỳ cài đặt R nào (hãy thử nó!)

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

Trong đó xu (màu xanh) và centroid (màu đỏ) là các centroid giống hệt nhau (biểu đồ này sẽ xuất hiện sau khi bạn chạy mã):

Càng xa càng tốt. Nhưng khi bạn tính toán các đa giác đa giác trong QGIS (menu: Vector | Geometry | Polygon Centroid), có các kết quả hơi khác nhau cho các đa giác không liền kề:

Vì vậy, câu hỏi này là 3 điều:

1. Một câu trả lời nhanh chóng và dễ dàng
2. Một cảnh báo cho những người sử dụng R để tính toán trọng tâm cho đa giác không liền kề
3. Một câu hỏi về cách nó nên được thực hiện trong R để giải thích chính xác cho đa giác (không liền kề)

Đầu tiên, tôi không thể tìm thấy bất kỳ tài liệu nào nói rằng coordinateshoặc getSpPPolygonsLabptSlotstrả về trọng tâm khối lượng. Trong thực tế, chức năng thứ hai hiện hiển thị là 'Không dùng nữa' và sẽ đưa ra cảnh báo.

Những gì bạn muốn để tính toán centroid là trung tâm của một tính năng là gCentroidchức năng từ rgeosgói. Làm help.search("centroid")sẽ tìm thấy điều này.

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

sẽ cho thấy sự khác biệt, và giống như các nhân giáp Qgis.

đây là một cách tiếp cận sử dụng sf. Như tôi chứng minh, kết quả từ sf :: st_centroid và rgeos :: gCentroid là như nhau.

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

Những gì tôi đã làm để khắc phục vấn đề này là tạo ra một hàm đệm âm cho đa giác cho đến khi nó đủ nhỏ để mong đợi một đa giác lồi. Chức năng sử dụng làcentroid(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
}