如何在我的數據框中添加一列來計算具有匹配 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如果你有一個小數據集，第二個版本將比第一個版本慢（由於設置並行計算的開銷）。 但是如果你有一個大數據集，第二個版本會快得多。