使用带有简单特征(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对象上使用类似应用的函数是"有问题的",因为几何列是列表列,它与"应用"构造不能很好地交互.

最简单的解决方法是使用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调用,因为否则会得到很多"在st_cast.MULTIPOLYGON(多边形,"POINT"):从第一个坐标指向"警告,结果不正确(我没有调查这个的原因 - 显然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