寻找距离某个点X米以内的所有点的高效方法?(空间上)

14

我有一个庞大的空间数据集(1200万行),其几何结构是地图上的点。对于数据集中的每一行,我想找到距离该点500米内的所有点。

在r中,使用sf,我一直在尝试通过并行循环遍历每一行并运行st_buffer和st_intersects,然后将结果保存为键值格式的列表(键为原始点,值为相邻点)来实现此目标。

问题在于数据集太大了。即使并行化到60个核心以上,操作也太长时间(>1周且通常崩溃)。

有什么替代这种蛮力方法的方法吗?是否可以使用sf建立索引?也许将操作推到外部数据库?

Reprex:

library(sf)
library(tidyverse)
library(parallel)
library(foreach)


# example data, convert to decimal:
nc <- st_read(system.file("shape/nc.shp", package="sf")) %>% st_transform(32618)
# expand the data a a bit to make the example more interesting:
nc <- rbind(nc,nc,nc)
nc <- nc %>% mutate(Id = row_number())


## can run in parallel if desired:
# num_cores <- parallel::detectCores()-2
# cl <- makeSOCKcluster(num_cores)
# registerDoSNOW(cl)

# or just run in sequence:
registerDoSEQ()

neighbors <- foreach(ii = 1:nrow(nc)
                      , .verbose = FALSE
                      , .errorhandling = "pass") %dopar% {

                        l = 500 # 500 meters

                        # isolate the row as the origin point:
                        row_interest <- filter(nc, row_number()==ii)

                        # create the buffer:
                        buffer <- row_interest %>% st_buffer(dist = l)

                        # extract the row numbers of the neighbors
                        comps_idx <- suppressMessages(st_intersects(buffer, nc))[[1]]

                        # get all the neighbors:
                        comps <- nc %>% filter(row_number() %in% comps_idx)

                        # remove the geometry:
                        comps <- comps %>% st_set_geometry(NULL)

                        # flow control in case there are no neibors:
                        if(nrow(comps)>0) {
                          comps$Origin_Key <- row_interest$Id
                        } else {
                          comps <- data_frame("lat" = NA_integer_,"lon" = NA_integer_, "bbl" = row_interest$bbl)
                          comps$Origin_Key <- row_interest$Id
                        }


                        return(comps)
                      }

closeAllConnections()

length(neighbors)==nrow(nc)
[1] TRUE

你能否提供一个最简示例,这样我们可以尝试一些东西吗?请参阅 https://dev59.com/eG025IYBdhLWcg3whGSx。 - denis
抱歉,我原以为我提供的示例代码应该足够了?那我发布的示例不符合可重现性的标准吗? - Tim_K
@Tim_K 最终我变得好奇并实现了一个集成的sf + data.table可能的解决方案。您可能会对下面更新的答案感兴趣。 - lbusett
你应该考虑查看这篇文章:https://gis.stackexchange.com/questions/255671/approximate-distance-between-two-points-longitude-latitude-without-haversine;我曾经遇到过同样的问题,并通过近似和`data.table`子集解决了它,这也可以很容易地并行运行。我不确定这是否是最快的方法,但对于9*10^6,单核需要大约80小时,2个核心需要40小时等等。 - nilsole
1
nilsole,这篇帖子对于思考问题非常有帮助。提出的解决方案是在进行点与多边形计算之前使用正方形子集进行预过滤。类似于下面@lbusett的答案,但是,子集是针对每个单独的点而不是将整个平面划分为nxn网格来完成的。 - Tim_K
3个回答

13
当使用sf对象时,显式循环特征执行交集等二进制操作通常是低效的(另请参阅如何在`dplyr::mutate()`中加速空间操作?
类似于您的方法(即缓冲和相交),但没有显式的for循环效果更好。
让我们看看它在一个相当大的50000个点的数据集上的表现:
library(sf)
library(spdep)
library(sf)

pts <- data.frame(x = runif(50000, 0, 100000),
                  y = runif(50000, 0, 100000))
pts     <- sf::st_as_sf(pts, coords = c("x", "y"), remove = F)
pts_buf <- sf::st_buffer(pts, 5000)
coords  <- sf::st_coordinates(pts)

microbenchmark::microbenchmark(
  sf_int = {int <- sf::st_intersects(pts_buf, pts)},
  spdep  = {x   <- spdep::dnearneigh(coords, 0, 5000)}
  , times = 1)
#> Unit: seconds
#>    expr       min        lq      mean    median        uq       max neval
#>  sf_int  21.56186  21.56186  21.56186  21.56186  21.56186  21.56186     1
#>   spdep 108.89683 108.89683 108.89683 108.89683 108.89683 108.89683     1

你可以看到,这里的st_intersects方法比dnearneigh方法快了5倍。
不幸的是,这可能无法解决你的问题。查看不同大小数据集的执行时间,我们得到:
subs <- c(1000, 3000, 5000, 10000, 15000, 30000, 50000)
times <- NULL
for (sub in subs[1:7]) {
  pts_sub <- pts[1:sub,]
  buf_sub <- pts_buf[1:sub,]
  t0 <- Sys.time()
  int <- sf::st_intersects(buf_sub, pts_sub)
  times <- cbind(times, as.numeric(difftime(Sys.time() , t0, units = "secs")))
}

plot(subs, times)

times <- as.numeric(times)
reg <- lm(times~subs+I(subs^2))
summary(reg)
#> 
#> Call:
#> lm(formula = times ~ subs + I(subs^2))
#> 
#> Residuals:
#>        1        2        3        4        5        6        7 
#> -0.16680 -0.02686  0.03808  0.21431  0.10824 -0.23193  0.06496 
#> 
#> Coefficients:
#>               Estimate Std. Error t value Pr(>|t|)    
#> (Intercept)  2.429e-01  1.371e-01   1.772    0.151    
#> subs        -2.388e-05  1.717e-05  -1.391    0.237    
#> I(subs^2)    8.986e-09  3.317e-10  27.087  1.1e-05 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 0.1908 on 4 degrees of freedom
#> Multiple R-squared:  0.9996, Adjusted R-squared:  0.9994 
#> F-statistic:  5110 on 2 and 4 DF,  p-value: 1.531e-07

在这里,我们看到时间和点数之间几乎呈现完美的二次关系(这是可以预期的)。在一个1000万点子集上,假设行为不变,您将获得:

predict(reg, newdata = data.frame(subs = 10E6))
#>        1 
#> 898355.4

假设趋势恒定,<p>对应大约10天时间(但是同样适用于dnearneigh...)

我的建议是将你的点“分块”,然后按每个块进行处理。

例如,你可以在开始时沿x轴对你的点进行排序,然后使用data.table轻松快速地提取缓冲区和点的子集并进行比较。

显然,“points”缓冲区需要比“buffers”缓冲区更大,根据比较距离。因此,例如,如果你使用[50000-55000]中心的pts_buf子集,则相应的pts子集应包括范围内的点[49500-55500]。

这种方法很容易通过将不同的子集分配给foreach或类似结构中的不同核心来并行化。

我甚至不知道在这里使用空间对象/操作是否有益,因为一旦我们有了坐标,所有需要的就是计算和子集欧几里得距离:我怀疑一个精心编码的暴力data.table为基础的方法也可能是可行的解决方案。

希望对你有所帮助!

更新

最终,我决定尝试一下并看看我们可以从这种方法中获得多少速度。以下是可能的实现:

points_in_distance_parallel <- function(in_pts,
                                        maxdist,
                                        ncuts = 10) {

  require(doParallel)
  require(foreach)
  require(data.table)
  require(sf)
  # convert points to data.table and create a unique identifier
  pts <-  data.table(in_pts)
  pts <- pts[, or_id := 1:dim(in_pts)[1]]

  # divide the extent in quadrants in ncuts*ncuts quadrants and assign each
  # point to a quadrant, then create the index over "xcut"
  range_x  <- range(pts$x)
  limits_x <-(range_x[1] + (0:ncuts)*(range_x[2] - range_x[1])/ncuts)
  range_y  <- range(pts$y)
  limits_y <- range_y[1] + (0:ncuts)*(range_y[2] - range_y[1])/ncuts
  pts[, `:=`(xcut =  as.integer(cut(x, ncuts, labels = 1:ncuts)),
             ycut = as.integer(cut(y, ncuts, labels = 1:ncuts)))] %>%
    setkey(xcut, ycut)

  results <- list()

  cl <- parallel::makeCluster(parallel::detectCores() - 2, type =
                                ifelse(.Platform$OS.type != "windows", "FORK",
                                       "PSOCK"))
  doParallel::registerDoParallel(cl)
  # start cycling over quadrants
  out <- foreach(cutx = seq_len(ncuts)), .packages = c("sf", "data.table")) %dopar% {

    count <- 0

    # get the points included in a x-slice extended by `dist`, and build
    # an index over y
    min_x_comp    <- ifelse(cutx == 1, limits_x[cutx], (limits_x[cutx] - maxdist))
    max_x_comp    <- ifelse(cutx == ncuts,
                            limits_x[cutx + 1],
                            (limits_x[cutx + 1] + maxdist))
    subpts_x <- pts[x >= min_x_comp & x < max_x_comp] %>%
      setkey(y)

    for (cuty in seq_len(pts$ycut)) {

      count <- count + 1

      # subset over subpts_x to find the final set of points needed for the
      # comparisons
      min_y_comp  <- ifelse(cuty == 1,
                            limits_y[cuty],
                            (limits_y[cuty] - maxdist))
      max_y_comp  <- ifelse(cuty == ncuts,
                            limits_y[cuty + 1],
                            (limits_y[cuty + 1] + maxdist))
      subpts_comp <- subpts_x[y >= min_y_comp & y < max_y_comp]

      # subset over subpts_comp to get the points included in a x/y chunk,
      # which "neighbours" we want to find. Then buffer them.
      subpts_buf <- subpts_comp[ycut == cuty & xcut == cutx] %>%
        sf::st_as_sf() %>%
        st_buffer(maxdist)

      # retransform to sf since data.tables lost the geometric attrributes
      subpts_comp <- sf::st_as_sf(subpts_comp)

      # compute the intersection and save results in a element of "results".
      # For each point, save its "or_id" and the "or_ids" of the points within "dist"

      inters <- sf::st_intersects(subpts_buf, subpts_comp)

      # save results
      results[[count]] <- data.table(
        id = subpts_buf$or_id,
        int_ids = lapply(inters, FUN = function(x) subpts_comp$or_id[x]))

    }
    return(data.table::rbindlist(results))
  }
parallel::stopCluster(cl)
data.table::rbindlist(out)
}

该函数以一个 点集 sf 对象、一个目标距离和一个切割数作为输入,用于将范围分成四个象限,并在输出中提供了一个数据框,在每个原始点上报告了maxdist内的点的"id",这些点在int_ids列表列中被报告。在具有不同数量均匀分布点和两个maxdist值的测试数据集上,我得到了这些结果(使用6个核心运行的“并行”运行):

enter image description here

因此,在“串行”实现上,我们已经获得了{{5-6倍的速度提升}},并且由于在6个核心上进行并行化,又获得了{{另外5倍}}的提升。尽管这里显示的时间仅供参考,并且与我们构建的特定测试数据集相关(在分布不太均匀的数据集上,我预计速度提升会更低),但我认为这相当不错。
希望对你有所帮助!
附注:可以在此处找到更详细的分析:

https://lbusettspatialr.blogspot.it/2018/02/speeding-up-spatial-analyses-by.html


为了文档记录,我认为来自SO问题的评论在你的答案顶部看起来很相关:“如果步骤涉及二进制逻辑谓词(如st_intersects、st_crosses等),请避免逐行操作,因为您会失去空间索引效率提升”。 - Tim_K

1

我有两种选择,一种看起来更快,另一种则不是。不幸的是,更快的方法可能不适合并行化处理,因此可能无法帮助。

library(sf)
nc <- st_transform(st_read(system.file("shape/nc.shp", package="sf")), 32618)
# create points
pts <- st_centroid(nc)

dis <- 50000
result <- list()

您的方法。
system.time(
for (i in 1:nrow(pts)) {
    b <- st_buffer(pts[i,], dist = dis)
    result[[i]] <- st_intersects(b, nc)[[1]]
}
)

较慢的替代方案
system.time(
for (i in 1:nrow(pts)) {
    b <- as.vector(st_distance(pts[i,], pts))
    result[[i]] <- which(b <= dis)
}
)

对于较小的数据集,不需要循环:

x <- st_distance(pts)
res <- apply(x, 1, function(i) which(i < dis)) 

更快的替代方法(并行处理不明显),也许是不公平的比较,因为我们没有自己进行循环处理。
library(spdep)
pts2 <- st_coordinates(pts)
system.time(x <- dnearneigh(pts2, 0, dis))

我会先获取一个包含邻居索引的列表,然后提取属性(这应该很快)。

根据您的回答,我找到了这篇博客文章,进一步讨论了同样的主题:cran.r-project.org/web/packages/spdep/vignettes/nb_sf.html可以使用与上述相同的技术,同时保持在sf中,例如:x <- dnearneigh(st_coordinate(pts), 0, dis) - Tim_K

0
借鉴RobertH的答案,使用sf::st_coordinates在这个特定的例子中提取坐标会更快一些。
library(sf)
library(spdep)
nc <- st_transform(st_read(system.file("shape/nc.shp", package="sf")), 32618)
# create points
pts <- st_centroid(nc)

dis <- 50000

# quickest solution:
x <- spdep::dnearneigh(sf::st_coordinates(pts), 0, dis)

微基准测试:
my_method <- function(pts) {
  result <- list()
  for (i in 1:nrow(pts)) {
    b <- st_buffer(pts[i,], dist = dis)
    result[[i]] <- st_intersects(b, nc)[[1]]
  }
  result
}

library(microbenchmark)

microbenchmark(
  my_method(pts),
  dnearneigh(as(pts, 'Spatial'), 0, dis),
  dnearneigh(st_coordinates(pts), 0, dis)
)

Unit: microseconds
                                    expr        min          lq        mean      median          uq        max neval
                          my_method(pts) 422807.146 427434.3450 435974.4320 429862.8705 434968.3975 596832.271   100
  dnearneigh(as(pts, "Spatial"), 0, dis)   3727.221   3939.8540   4155.3094   4112.8200   4221.9525   7592.739   100
 dnearneigh(st_coordinates(pts), 0, dis)    394.323    409.5275    447.1614    430.4285    484.0335    611.970   100

检查等价性:

x <-  dnearneigh(as(pts, 'Spatial'), 0, dis)
y <- dnearneigh(st_coordinates(pts), 0, dis)

all.equal(x,y, check.attributes = F)
[1] TRUE

as(pts, 'Spatial')sf 对象转换为 sp 中定义的 Spatial* 对象。它不是 spdep 的一部分。dnearneigh 接受空间对象或坐标矩阵。提取坐标更快,但两种方法都很快,而且您只需要对整个数据集执行一次,因此差异不应该很重要。(它应该基本上呈线性缩放 --- 而距离计算则不是) - Robert Hijmans
你说得完全正确。我调整了我的回答语言来解决这个问题。我上面的例子非常特定于这种用例,并不一定适用于一般情况。 - Tim_K

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接