Question

我已经编写了一个函数来计算质心和多边形边缘之间的最大距离，但是我无法弄清楚如何在一个简单特征的每个单独的多边形上运行它（＆＃ 34; sf）data.frame。

library(sf)

distance.func <- function(polygon){
  max(st_distance(st_cast(polygon, "POINT"), st_centroid(polygon)))
}

如果我在单个多边形上测试该函数，它就可以工作。（警告信息与当前问题无关）。

nc <- st_read(system.file("shape/nc.shp", package="sf")) # built in w/package
nc.1row <- nc[c(1),] # Just keep the first polygon

>distance.func(nc.1row)
24309.07 m
Warning messages:
1: In st_cast.sf(polygon, "POINT") :
   repeating attributes for all sub-geometries for which they may not be constant
2: In st_centroid.sfc(st_geometry(x), of_largest_polygon = of_largest_polygon) :
   st_centroid does not give correct centroids for longitude/latitude data

问题是将此函数应用于整个data.frame。

nc$distance <- apply(nc, 1, distance.func)
Error in UseMethod("st_cast") :
 no applicable method for 'st_cast' applied to an object of class "list"

如何为类＃34; sf＆＃34;中的每个单独的多边形运行此函数（或类似函数）？

Answer 1

这里的问题是直接在sf对象上使用类似应用的函数是有问题的＆＃34;因为几何列是一个列表列，它与＆＃34; apply＆＃34;结构体。

最简单的解决方法是使用for循环：

library(sf)

nc <- st_read(system.file("shape/nc.shp", package="sf")) %>% 
  st_transform(3857)

distance.func <- function(polygon){
  max(st_distance(st_cast(polygon, "POINT"), st_centroid(polygon)))
}
dist <- list()
for (i in seq_along(nc[[1]])) dist[[i]] <- distance.func(nc[i,]) 

head(unlist(dist))
# [1] 30185.34 27001.39 34708.57 52751.61 57273.54 34598.17

，但速度很慢。

为了能够使用类似应用的函数，您需要传递给对象的仅几何列。像这样的东西会起作用：

library(purrr)

distance.func_lapply <- function(polygon){
  polygon <- st_sfc(polygon)
  max(st_distance(st_cast(polygon, "POINT"), st_centroid(polygon)))
}

dist_lapply <- lapply(st_geometry(nc),  distance.func_lapply)
dist_map    <- purrr::map(st_geometry(nc), distance.func_lapply)

all.equal(dist, dist_lapply)
# [1] TRUE
all.equal(dist, dist_map)
# [1] TRUE

但请注意，我必须轻松修改距离函数，添加st_sfc调用，因为否则会得到很多＆＃34;在st_cast.MULTIPOLYGON（多边形，＆＃34; POINT＆＃34; ）：仅从第一个坐标指向＆＃34;警告，结果不正确（我没有调查其原因 - 显然st_cast在sfg个对象上的行为与sfc个对象的行为不同）。

就速度而言，lapply和map解决方案的表现优于for循环几乎一个数量级：

microbenchmark::microbenchmark(
  forloop = {for (i in seq_along(nc[[1]])) dist[[i]] <- distance.func(nc[i,])}, 
  map     = {dist_map <- purrr::map(st_geometry(nc), distance.func_lapply)},  
  lapply  = {dist_lapply <- lapply(st_geometry(nc),  distance.func_lapply)}, times = 10)

Unit: milliseconds
    expr      min       lq     mean   median       uq       max neval
 forloop 904.8827 919.5636 936.2214 920.7451 929.7186 1076.9646    10
     map 122.7597 124.9074 126.1796 126.3326 127.6940  128.7551    10
  lapply 122.9131 125.3699 126.9642 126.8100 129.3791  131.2675    10

使用带有简单特征（SF）函数的apply（）

1 个答案: