R 中多邊形的長度

Question

我想計算每個多邊形的長度。 -圍繞每個多邊形我創建了點（st_sample），-從點的組合我創建了所有可能的折線，-對於多邊形內部的折線，我計算了長度，-最長的折線是我的結果（poylgon 的最大長度）。

我寫的代碼得到了我的結果，但它真的很慢。 您有改進我的代碼的解決方案嗎？ 我知道有兩個循環我不能指望速度會出現奇跡，但我不知道如何以另一種方式獲得結果。

如果不出意外的話，我至少有一些替代解決方案，可以在沒有循環的情況下一步從一個多邊形的點組合創建所有多段線？ :)

謝謝你

library(sf)
library(data.table)

poly=st_read(system.file("shape/nc.shp", package="sf"))
poly=poly[1:10,]
poly=st_cast(poly,"POLYGON")
poly$max_length=0

##Combination of 10 points, withot repetiton
aa=CJ(1:10,1:10)
aa=aa[!duplicated(t(apply(aa[,.(V1, V2)], 1, sort))),][V1!=V2]

##for each polygon create sample of coordinates along line, from them I create polyline and calculated length for linestring which are inside polygon

for (ii in 1:nrow(poly)){
  ncl=st_cast(poly[ii,],"LINESTRING")
  ##sample of point along line
  ncp=st_cast(st_sample(ncl,10, type="regular", exact=T),"POINT")
  
  ##create empty sf 
  aaa=st_sf(st_sfc())
  st_crs(aaa)="NAD27"
  
  ##for each combination of points create linestring and calculate length only for polylines which are inside polygon
  for (i in 1:nrow(aa)){
 aaa=rbind(aaa,st_sf(geometry=st_cast(st_union(ncp[t(aa[i])]),"LINESTRING")))
  }
poly$max_length[ii]=as.numeric(max(st_length(aaa[unlist(st_contains(poly[ii,],aaa)),])))
}

第二次嘗試在 data.table 中運行 function。少了一個循環，但問題可能是第二個循環。

poly=st_read(system.file("shape/nc.shp", package="sf"))
poly=poly[1:10,]
poly=st_cast(poly,"POLYGON")
poly$max_length=0

##Combination of 10 points, withot repetiton
aa=CJ(1:10,1:10)
aa=aa[!duplicated(t(apply(aa[,.(V1, V2)], 1, sort))),][V1!=V2]

overFun <- function(x){
  
  ncl=st_cast(x[,geometry],"LINESTRING")
  ##sample of point along line
  ncp=st_cast(st_sample(ncl,40, type="regular", exact=T),"POINT")
  
  ##create empty sf 
  aaa=st_sf(st_sfc())
  st_crs(aaa)="NAD27"
  
  ##for each combination pof points create linestring and calculate length
  for (i in 1:nrow(aa)){
    aaa=rbind(aaa,st_sf(geometry=st_cast(st_union(ncp[t(aa[i])]),"LINESTRING")))
  }
  
  as.numeric(max(st_length(aaa[unlist(st_contains(x[,geometry],aaa)),])))}  

setDT(poly)

##run function inside data.table
poly[,max_length:=overFun(poly), by=seq(nrow(poly))]

編輯：我為我的問題找到了一些解決方案，這足以滿足我的需求。 在 data.table 和 function 中使用並行庫，它也適用於 data.table。仍然有一個問題，為什么一些折線被 function st_contains 排除（見上圖）。 也許精度有問題？

library(sf)
library(data.table)

poly=st_read(system.file("shape/nc.shp", package="sf"))
poly=st_cast(poly,"POLYGON")
setDT(poly)

##Combination of 10 points, withot repetiton
aa=CJ(1:10,1:10)
aa=aa[!duplicated(t(apply(aa[,.(V1, V2)], 1, sort))),][V1!=V2]

overFun <- function(x){
  
ncl=st_cast(poly[1,geometry],"LINESTRING")
##sample of point along line
ncp=st_cast(st_sample(ncl,10, type="regular", exact=T),"POINT")
  
df=data.table(ncp[aa[,V1]],ncp[aa[,V2]] )
  
df[,v3:=st_cast(st_union(st_as_sf(V1),st_as_sf(V2)),"LINESTRING"), by=seq(nrow(df))]
as.numeric(max(st_length(df[unlist(st_contains(poly[1,geometry], df$v3)),]$v3)))}

library(parallel)
cl <- makeCluster(detectCores() - 1)
clusterExport(cl, list("overFun","data.table","st_cast","CJ","poly","st_sample","st_sf","st_sfc","aa","st_length","st_union",
                       "st_as_sf","st_contains"))
system.time(poly[,c("max_length"):=.(clusterMap(cl, overFun, poly$geometry)),])
stopCluster(cl)

Answer 1

我遇到了類似的問題，坦率地說還沒有找到任何現成的解決方案。

我將使用來自sf package 的同一個 Ashe 縣。

library(sf)
library(dplyr)

shape <- st_read(system.file("shape/nc.shp", package="sf")) %>% 
  dplyr::filter(CNTY_ID == 1825) %>% # Keep only one polygon
  st_transform(32617) # Reproject to WGS 84 / UTM zone 17N

解決方案 1

只需使用dplyr 、 tidyr和sf就可以將多邊形轉換為點並計算所有點之間的距離。 從這個品種中，選擇最大值。 這將是您示例圖中的一條綠線。

library(tidyr)

shape %>% 
  st_cast("POINT") %>% # turn polygon into points
  distinct() %>% # remove duplicates
  st_distance() %>% # calculate distance matrix
  as.data.frame() %>% 
  gather(point_id, dist) %>% # convert to long format
  pull(dist) %>% # keep only distance column
  max()
#> Warning in st_cast.sf(., "POINT"): repeating attributes for all sub-geometries
#> for which they may not be constant
#> 45865.15 [m]

方案二

您還可以使用Momocs package。它是為二維形態分析而創建的。 雖然在第一種情況下將我們的形狀重新投影到 UTM 不是必需的（ sf可以處理地理坐標），但在Momocs package 的情況下，您的多邊形應該被投影。

library(Momocs)

shape %>% 
  st_cast("POINT") %>% # Polygon to points
  distinct() %>% # remove duplicates
  st_coordinates() %>% # get coordinates matrix
  coo_calliper() # calculate max length
#> Warning in st_cast.sf(., "POINT"): repeating attributes for all sub-geometries
#> for which they may not be constant
#> [1] 45865.15

注釋

Momocs package 中還有其他幾個函數。例如，您可以根據它們的慣性軸（即 alignment 到 x 軸）計算形狀的長度。 coo_length將返回44432.02 [m] 。

例如，可以將Momocs package 中的幾個函數應用於坐標矩陣，如下所示：

point_matrix <- shape %>% 
  st_cast("POINT") %>% 
  distinct() %>% 
  st_coordinates() 
#> Warning in st_cast.sf(., "POINT"): repeating attributes for all sub-geometries
#> for which they may not be constant

funs <- list("length" = coo_length,
             "width" = coo_width,
             "elongation" = coo_elongation)

sapply(funs, function(fun, x) fun(x), x = point_matrix)
#>       length        width   elongation 
#> 4.443202e+04 3.921162e+04 1.174917e-01

Answer 2

如果您是在多邊形的周長之后，請考慮以下代碼：

library(sf)
library(dplyr)

shape <- st_read(system.file("shape/nc.shp", package="sf")) # included with sf package

lengths <- shape %>% 
  mutate(circumference = st_length(.)) %>% 
  st_drop_geometry() %>% 
  select(NAME, circumference) 
   
head(lengths)   
         NAME circumference
1        Ashe  141665.4 [m]
2   Alleghany  119929.0 [m]
3       Surry  160497.7 [m]
4   Currituck  301515.3 [m]
5 Northampton  211953.8 [m]
6    Hertford  160892.0 [m]

如果內部有一些孔並且不希望它們包含在圓周中，請考慮通過nngeo::st_remove_holes()將它們移除。