计算data.table中两行之间的地理距离

时间:2018-04-24 17:38:37

标签: r data.table

我的问题与此基本相同:calculating distance between two row in a data.table 但我正在寻找使用data.table语法的答案,而不是for循环。

我有一个像这样的data.table:

Lat      Lon      Time                   Bus
52.21808 20.96675 2018-04-20 21:27:26    3
52.25882 20.89850 2018-04-20 21:27:23    8
52.24347 21.08460 2018-04-20 21:27:27    1
52.21935 20.97186 2018-04-20 21:28:31    3
52.25808 20.89790 2018-04-20 21:28:32    8
52.24541 21.08522 2018-04-20 21:28:36    1

我想计算两个连续点之间的距离,按总线分组,使用例如来自地圈包的distGeo。如下所示:

d[,distance:=distGeo(c(Lon, Lat), ???????),by=Bus]

编辑我使用

获得了一些有用的结果
d[,distance:=distGeo(cbind(Lon, Lat)),by=Bus]

但不完全正确:有警告说每个组的一个项目需要回收。有没有办法在每个总线的第一行或最后一行获得NA?

编辑2看起来我拥有它。

d[,distance:=c(distGeo(cbind(Lon, Lat)),NA) ,by=Bus]

3 个答案:

答案 0 :(得分:2)

通过将Lat / Lon行向上移动一个位置来创建两个新列:

setorder(dt, Bus)

dt[, `:=`(Lat_to = shift(Lat, type = "lead"),
          Lon_to = shift(Lon, type = "lead")),
     by = Bus]

使用我为this answer写的这个函数(它是一个更高效,data.table风格的半正弦计算)

dtHaversine <- function(lat_from, lon_from, lat_to, lon_to, r = 6378137){
  radians <- pi/180
  lat_to <- lat_to * radians
  lat_from <- lat_from * radians
  lon_to <- lon_to * radians
  lon_from <- lon_from * radians
  dLat <- (lat_to - lat_from)
  dLon <- (lon_to - lon_from)
  a <- (sin(dLat/2)^2) + (cos(lat_from) * cos(lat_to)) * (sin(dLon/2)^2)
  return(2 * atan2(sqrt(a), sqrt(1 - a)) * r)
}

应用

dt[, dist := dtHaversine(Lat, Lon, Lat_to, Lon_to)]

dt
#         Lat      Lon       Date     Time Bus   Lat_to   Lon_to      dist
# 1: 52.24347 21.08460 2018-04-20 21:27:27   1 52.24541 21.08522 220.05566
# 2: 52.24541 21.08522 2018-04-20 21:28:36   1       NA       NA        NA
# 3: 52.21808 20.96675 2018-04-20 21:27:26   3 52.21935 20.97186 376.08498
# 4: 52.21935 20.97186 2018-04-20 21:28:31   3       NA       NA        NA
# 5: 52.25882 20.89850 2018-04-20 21:27:23   8 52.25808 20.89790  91.96366
# 6: 52.25808 20.89790 2018-04-20 21:28:32   8       NA       NA        NA

数据

library(data.table)

dt <- fread(
'Lat      Lon      Date         Time          Bus
52.21808 20.96675 2018-04-20 21:27:26    3
52.25882 20.89850 2018-04-20 21:27:23    8
52.24347 21.08460 2018-04-20 21:27:27    1
52.21935 20.97186 2018-04-20 21:28:31    3
52.25808 20.89790 2018-04-20 21:28:32    8
52.24541 21.08522 2018-04-20 21:28:36    1')

一百万行的例子

set.seed(123)
dt <- data.table(Lat = sample(-90:90, 1e6, replace = T),
                                 Lon = sample(-90:90, 1e6, replace = T),
                                 Bus = rep(1:5e5,2))


setorder(dt, Bus)
system.time({
    dt[, `:=`(Lat_to = shift(Lat, type = "lead"),
              Lon_to = shift(Lon, type = "lead")),
         by = Bus]
    dt[, dist := dtHaversine(Lat, Lon, Lat_to, Lon_to)] 
})
#  user  system elapsed 
# 7.985   0.033   8.020 

答案 1 :(得分:0)

以下是使用包"videoRect"的解决方案:

gmt

您当然可以轻松删除cols require(data.table) require(gmt) set.seed(123) some_latlon <- data.table(id = sample(x = 1:2, size = 10, replace = TRUE), xfrom = runif(n = 10, min = 3, max = 6), yfrom = runif(n = 10, min = 52, max = 54)) setkey(some_latlon, id) some_latlon[, xto := c(xfrom[-1], NA), by = id] some_latlon[, yto := c(yfrom[-1], NA), by = id] some_latlon[, dist := geodist(Nfrom = yfrom, Efrom = xfrom, Nto = yto, Eto = xto, units = "km"), by = id] xto。 HTH

答案 2 :(得分:0)

geodist::geodist也可以工作,并且比geosphere::distHaversine快。

require(data.table)
require(microbenchmark)

d = 
fread( 
'
Lat,Lon,Time,Bus
52.21808,20.96675,2018-04-20 21:27:26,3
52.25882,20.89850,2018-04-20 21:27:23,8
52.24347,21.08460,2018-04-20 21:27:27,1
52.21935,20.97186,2018-04-20 21:28:31,3
52.25808,20.89790,2018-04-20 21:28:32,8
52.24541,21.08522,2018-04-20 21:28:36,1
')

setorder(d, Bus, Time)

microbenchmark(

 d[, dist_geodist := geodist::geodist(cbind(Lat, Lon),
      measure='haversine', sequential = TRUE) , by = Bus]
,
 d[,dist_geosphere := geosphere::distHaversine(cbind(Lon, Lat) ) , by=Bus]   
 )

Unit: microseconds
                                                                                                                expr      min
 d[, `:=`(dist_geodist, geodist::geodist(cbind(Lat, Lon), measure = "haversine",      sequential = TRUE)), by = Bus]  861.937
                                 d[, `:=`(dist_geosphere, geosphere::distHaversine(cbind(Lon,      Lat))), by = Bus] 1005.890
        lq      mean    median       uq      max neval cld
  868.7585  910.8999  875.4555  920.138 1463.567   100  a 
 1016.2335 1065.2952 1028.3775 1070.428 1738.151   100   b