如何在我的数据框中添加一列来计算具有匹配 ID 的前一个点之间的纬度/经度点之间的距离

Question

我有一个单独的动物数据框，具有唯一 ID、发现它们的纬度/经度以及找到它们的日期。 数据库经常返回同一个人。 我有超过2000个人。 我想在我的数据框中添加一列来计算当前位置和先前位置之间的欧几里得距离。 我想添加第二列来告诉我每个人的计算编号。 数据框已经按顺序日期组织。 我试图在 R 中解决这个问题。

事件	ID	纬度	长
1个	1个	31.89	-80.98
2个	2个	31.54	-80.12
3个	1个	31.45	-81.92
4个	1个	31.64	-81.82
5个	2个	31.23	-80.98

添加一列，现在看起来像

事件	ID	纬度	长	区	计算 ＃
1个	1个	31.89	-80.98	-	0
2个	2个	31.54	-80.12	-	0
3个	1个	31.45	-81.92	事件 1 和 3 之间的距离	1个
4个	1个	31.64	-81.82	事件 3 和 4 之间的距离	2个
5个	2个	31.23	-80.98	事件 2 和 5 之间的距离	1个

如果没有 for 循环，有没有更快的方法来做到这一点？ 我被困在从哪里开始。 我知道我可以使用距地理空间 package 的距离 function 一次，我对 uniqueID 进行了排序，但我无法遍历我的数据。

Answer 1

这是一个依赖于sf package 和dplyr的选项。 function sf::st_distance计算点对之间的距离， dplyr::lag可用于查看“落后一排”。 您需要确认您的坐标系，我猜这里是WGS84 / 4326 。

library(dplyr)
library(sf)



dat <- read.table(text = " Event    ID  Lat Long
1   1   31.89   -80.98
2   2   31.54   -80.12
3   1   31.45   -81.92
4   1   31.64   -81.82
5   2   31.23   -80.98", h = T)


dat_sf <- st_as_sf(dat, coords = c('Long', 'Lat'), crs = 4326)


dat_sf %>%
  arrange(ID) %>%
  group_by(ID) %>%
  mutate(distance = as.numeric(st_distance(geometry, lag(geometry), by_element = TRUE)),
         calculation = row_number() - 1)
#> Simple feature collection with 5 features and 4 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: -81.92 ymin: 31.23 xmax: -80.12 ymax: 31.89
#> Geodetic CRS:  WGS 84
#> # A tibble: 5 x 5
#> # Groups:   ID [2]
#>   Event    ID       geometry distance calculation
#> * <int> <int>    <POINT [°]>    <dbl>       <dbl>
#> 1     1     1 (-80.98 31.89)      NA            0
#> 2     3     1 (-81.92 31.45)  101524.           1
#> 3     4     1 (-81.82 31.64)   23155.           2
#> 4     2     2 (-80.12 31.54)      NA            0
#> 5     5     2 (-80.98 31.23)   88615.           1

^{由reprex package (v2.0.0) 创建于 2022-11-14}

Answer 2

尝试这个：

1. 加载库地理范围
2. 创建演示数据
3. 获取所有唯一 ID 并按 ID 和事件对 dataframe 进行排序
4. append 每行每只动物的最后已知坐标
5. 将距离 function 应用到每一行

library(geosphere)
df <- data.frame(
    event = seq(5),
    id = c(1, 2, 1, 1, 2),
    lat = c(31.89, 31.54, 31.45, 31.64, 31.23),
    long = c(-80.98, -80.12, -81.92, -81.82, -80.98)
)

keys <- df$id %>% unique
df %<>% dplyr::arrange(id, event)
df <- keys %>% lapply(
    function(key){
        tmp <- df[df$id == key, ]
        tmp$last_lat <- tmp$lat
        tmp$last_long <- tmp$long
        tmp[2:nrow(tmp), ]$last_lat <- tmp[1:nrow(tmp) - 1, ]$lat
        tmp[2:nrow(tmp), ]$last_long <- tmp[1:nrow(tmp) - 1, ]$long
        tmp %>% return
    }
) %>% do.call(rbind, .)


df %<>% mutate(dist = distHaversine(cbind(long, lat), cbind(last_long, last_lat)))

既然你说你需要速度，下面是与上面相同但并行运行的代码：

library(tictoc)
library(parallel)

tic()
clust <- makeCluster(detectCores() - 1)

df <- data.frame(
    event = seq(5),
    id = c(1, 2, 1, 1, 2),
    lat = c(31.89, 31.54, 31.45, 31.64, 31.23),
    long = c(-80.98, -80.12, -81.92, -81.82, -80.98)
)
keys <- df$id %>% unique
df %<>% dplyr::arrange(id, event)

clusterExport(clust, "df")
clusterEvalQ(clust, library(magrittr))
df <- keys %>% parLapply(
    clust, ., 
    function(key){
        tmp <- df[df$id == key, ]
        tmp$last_lat <- tmp$lat
        tmp$last_long <- tmp$long
        tmp[2:nrow(tmp), ]$last_lat <- tmp[1:nrow(tmp) - 1, ]$lat
        tmp[2:nrow(tmp), ]$last_long <- tmp[1:nrow(tmp) - 1, ]$long
        tmp %>% return
    }
) %>% do.call(rbind, .)

df %<>% mutate(dist = distHaversine(cbind(long, lat), cbind(last_long, last_lat)))

toc()

上面， tictoc只是记录了执行时间。 我刚刚创建了一个集群，你的 cpu 核心数减 1，并将lapply部分更改为parLapply如果你有一个小数据集，第二个版本将比第一个版本慢（由于设置并行计算的开销）。 但是如果你有一个大数据集，第二个版本会快得多。