处理R

Question

我正在努力处理两个包含个体和细胞塔坐标的数据集：

• 第一个数据集，包含9,459个个体，其中包含1,214个变量（包括其经度和纬度）。
• 包含31,176个蜂窝塔的第二个数据集，其中包括4个变量，包括纬度和经度（以度为单位）和范围（以米为单位）。

我想确定一个人是否在至少一个手机信号塔的范围内，并创建一个等于1的虚拟对象。

但是，由于数据集的大小，我无法使用cross-join命令将它们合并。我尝试通过以下命令使用geosphere软件包：

distm(c(df1$longitude, df2$latitude), c(df2$longitude, df2$latitude), fun= distHaversine)

不幸的是，由于两个数据集的大小不相等，因此无法使用。关于如何解决此问题的任何想法？

Answer 1

通常，可以更有效地完成此操作，以最大化RAM和处理器使用率并减少开销。但是，如果您要执行的是一次性操作，则采用以下方法就足够了（在当前笔记本电脑上大约需要5分钟）。

辅助功能

# More info: https://github.com/RomanAbashin/distGeo_v
distGeo_v <- function(x, y, xx, yy) { 
    if(!"geosphere" %in% installed.packages())  {
        stop("The 'geosphere' package needs to be installed for this function to work.")
    }
    matrix(.Call("_inversegeodesic", 
                 as.double(x), as.double(y), as.double(xx), as.double(yy), 
                 as.double(6378137), 1/298.257223563, PACKAGE='geosphere'), 
           ncol = 3, byrow = TRUE)[,1]
}

数据

library(geosphere)
library(tidyverse)
set.seed(1702)

users <- tibble(userid = 1:10000,
                x = rnorm(10000, 16.3738, 5),
                y = rnorm(10000, 48.2082, 5))

towers <- tibble(lon = rnorm(35000, 16.3738, 10),
                 lat = rnorm(35000, 48.2082, 10),
                 range = runif(35000, 50, 10000))

代码

result <- NULL
for(i in 1:nrow(users)) {

    is_match <- users[i, 1:3] %>%
        tidyr::crossing(towers[, 1:3]) %>%
        filter(distGeo_v(x, y, lon, lat) <= range) %>%
        nrow() > 0

    result <- bind_rows(result, tibble(userid = users$userid[i],
                                       match = is_match))

}

结果

> head(result)
# A tibble: 6 x 2
  userid match
   <int> <lgl>
1      1 TRUE 
2      2 FALSE
3      3 FALSE
4      4 TRUE 
5      5 FALSE
6      6 FALSE

现在您可以将结果left_join恢复为原始数据。

Answer 2

我在下面添加了使用spatialrisk软件包的解决方案。此软件包中的关键功能是用C ++（Rcpp）编写的，因此非常快。

spatialrisk :: points_in_circle（）函数计算从中心点开始的半径范围内的观测值。请注意，距离是使用Haversine公式计算的。由于输出的每个元素都是一个数据帧，因此使用purrr :: map_dfr将它们行绑定在一起：

library(tibble)
library(spatialrisk)
library(dplyr)

set.seed(1702)
users <- tibble(userid = as.character(1:10000),
                lon = rnorm(10000, 16.3738, 1),
                lat = rnorm(10000, 48.2082, 1))

towers <- tibble(lon = rnorm(35000, 16.3738, 1),
                 lat = rnorm(35000, 48.2082, 1))

# Users with tower within 200 meters
purrr::map2_dfr(users$lon, users$lat, 
                   ~points_in_circle(towers, .x, .y, radius = 200)[1,], 
                   .id = "userid") %>%
     mutate(inrange = ifelse(is.na(distance_m), FALSE, TRUE))