r - 使用带有简单特征 (SF) 函数的 apply()

Question

我编写了一个函数来计算质心与其多边形边缘之间的最大距离，但我无法弄清楚如何在简单特征(“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"

我该怎么做才能为“sf”类对象中的每个单独的多边形运行这个函数(或类似的函数)？

Answer 1

这里的问题是直接在 sf 上使用类似应用的函数object 是“有问题的”，因为几何列是一个列表列，它不能与“应用”构造很好地交互。

最简单的解决方法可能是只使用 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调用，因为否则你会得到很多“In st_cast.MULTIPOLYGON(polygon, "POINT") : point from first坐标 only”警告，结果不正确(我没有调查原因 - 显然 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