r语言 - 如何在我的数据框架中添加一列，该列计算前一点与匹配id之间的距离

Question

我有一个具有唯一ID的单个动物的数据框架，它们被发现的晚/长，以及它们被发现的日期。数据库中有同一个人的频繁返回。我有超过2000个人。我想在我的数据框架中添加一列来计算当前位置之间的欧几里德距离&之前的位置。我想添加第二列来告诉我每个个体的计算编号。数据帧已按顺序日期组织。我正在尝试用r来解决这个问题。

<表类> 事件 ID Lat 长 tbody><<tr>1131.89-80.982231.54-80.123131.45-81.924131.64-81.825231.23-80.98

这是一个依赖于sf包和dplyr的选项。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包(v2.0.0)在2022-11-14创建}

试试这个:

1. 加载库地圈
2. 获取所有唯一ID并按ID和事件排序数据帧
3. 将每种动物的最后已知坐标附加到每行
4. 对每一行应用距离函数

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。如果你有一个小的数据集，第二个版本将比第一个版本慢(由于设置并行计算的开销)。但是如果你有一个大的数据集，第二个版本会快得多。