R：按最近的时间组合两个数据帧

Question

我有两个数据框；一个包含一年的每小时温度，另一个包含航班信息。波纹管显示了温度数据帧的摘录：

  Time <- c("2000-01-01 00:53:00","2000-01-01 06:53:00","2000-01-01 10:53:00")
  Time <- as.POSIXct(Time)
  Temp <- c(20,30,10)
  Temperature <- data.frame(Time,Temp)
  Temperature
                 Time Temp
1 2000-01-01 00:53:00   20
2 2000-01-01 06:53:00   30
3 2000-01-01 10:53:00   10

下面显示了航班信息数据框的摘录：

  DepartureTime <- c("2000-01-01 03:01:00","2000-01-01 10:00:00","2000-01-01 14:00:00")
  DepartureTime <- as.POSIXct(DepartureTime)
  FlightInformation <- data.frame(DepartureTime)
  FlightInformation
        DepartureTime
1 2000-01-01 03:01:00
2 2000-01-01 10:14:00
3 2000-01-01 14:55:00

我的目标是获取 FlightInformation$DepartureTime 的每一行并在整个温度 $Time 列中找到最接近的时间。然后我想将相应的温度添加到 FlightInformation 数据框中。所需的输出应如下所示：

FlightInformation
        DepartureTime Temp
1 2000-01-01 03:01:00 20
2 2000-01-01 10:14:00 10
3 2000-01-01 14:55:00 10

到目前为止，我的尝试是这样的：

  i <- 1
  j <- 1
  while(i <= nrow(Temperature)){
    while(j <= nrow(FlightInformation)){
      if(Temperature$Time[i] == FlightInformation$Time[j]){
        FlightInformation$Temp[j] == Temperature$Temp[i]
      }
      j <- j + 1
    }
    i <- i + 1
  }

这涉及首先将所有时间四舍五入到最接近的小时。这种方法并不像我希望的那样准确，而且似乎非常低效！有没有一种简单的方法可以找到最近的 posix 来提供我想要的输出？

Answer 1

一些假设：

• 您有所有航班信息前后的温度数据；否则你会看到NA
• 温度数据足够连续，这意味着通过此插值，您不会从 3 个月前获取任何东西（无用）
• 温度数据已排序（如果没有，很容易修复）

我们将使用cut，它会找到值适合一系列breaks 的区间：

(ind <- cut(FlightInformation$DepartureTime, Temperature$Time, labels = FALSE))
# [1]  1  2 NA

这些表示Temperature 中的行，我们应该从中检索$Temp。不幸的是，它是绝对的，不允许更接近下一个值，因此我们可以对此进行补偿：

(ind <- ind + (abs(Temperature$Time[ind] - FlightInformation$DepartureTime) >
                 abs(Temperature$Time[1+ind] - FlightInformation$DepartureTime)))
# [1]  1  3 NA

好的，现在NA: 表示最新的$DepartureTime 超出了已知时间。这表明违反了我上面的第一个假设，但可以修复。我在这里使用“6 小时”的魔法常数来确定数据是否足够接近可以使用它；当然还有许多其他的启发式方法不会出错。对于那些，我们可以假设最新的温度：

(is_recoverable <- is.na(ind) & abs(FlightInformation$DepartureTime - max(Temperature$Time)) < 60*60*6)
# [1] FALSE FALSE  TRUE
ind[is_recoverable] <- nrow(Temperature)
ind
# [1] 1 3 3

结果：

FlightInformation$Temp <- Temperature$Temp[ ind ]
FlightInformation
#         DepartureTime Temp
# 1 2000-01-01 03:01:00   20
# 2 2000-01-01 10:00:00   10
# 3 2000-01-01 14:00:00   10

虽然绝对比双倍while 循环快，但如果您的温度数据有很大差距，这将是一个问题。也就是说，如果您的数据有 3 年的差距，则将使用最近的温度，可能是 2.99 年前。要仔细检查，请使用：

FlightInformation$TempTime <- Temperature$Time[ ind ]
FlightInformation$TimeDelta <- with(FlightInformation, abs(TempTime - DepartureTime))
FlightInformation
#         DepartureTime Temp            TempTime TimeDelta
# 1 2000-01-01 03:01:00   20 2000-01-01 00:53:00  128 mins
# 2 2000-01-01 10:00:00   10 2000-01-01 10:53:00   53 mins
# 3 2000-01-01 14:00:00   10 2000-01-01 10:53:00  187 mins

您可以为时间增量使用不同的单位并检查以下问题：

units(FlightInformation$TimeDelta) <- "secs"
which(FlightInformation$TimeDelta > 60*60*6)
# integer(0)

（integer(0) 说你没有任何超出我 6 小时魔法窗口的时间。）

Answer 2

这是一个方法！如果将时间转换为数值，则最容易使用它。然后，您可以比较数值以找到参考时间之前/之后的最接近时间（以下示例中的 FlightInformation$time_num）。一旦您在参考值之前和之后获得了最接近的时间，请找出最接近您的参考值的时间。使用该时间值查找（索引）正确的温度值并将其添加到您的数据框中。

#convert time to numeric (seconds since origin of time)
Temperature$time_num <- as.numeric(Temperature$Time) 
FlightInformation$time_num <- as.numeric(FlightInformation$DepartureTime)

#make sure time data is in correct order so that indexes for time are in correct order 
Temperature <- Temperature[with(Temperature, order(time_num)), ] #sort data

for (i in 1:nrow(FlightInformation)) #for each row of data in flight...
{
  #find the time in Temp that is closest + prior to Flight time
  #create a logical vector saying which Temperature$time_num are <= to FlightInformation$time_num. 
  #pull the max row index from the logical vector where value == TRUE (this is the closest time for Temp that is prior to Flight Time)
  #use that row index to look up the Temperature$time_num value that is closest + prior to Flight time
  #will return NA/warning message if no time in Temp is before time in Flight
  temptime_prior <- Temperature[max(which(Temperature$time_num <= FlightInformation$time_num[i])), "time_num"] 

  #find the time in Temp that is closest + after to Flight time
  #will return NA/warning message if no time in Temp is after time in Flight
  temptime_after <- Temperature[min(which(Temperature$time_num > FlightInformation$time_num[i])), "time_num"] 

  #compare times before and after to see which is closest to flight time. If no before/after time was found (e.g., NA was returned), always use the other time value
  temptime_closest <- ifelse(is.na(temptime_prior), temptime_after, 
                             ifelse(is.na(temptime_after), temptime_prior, 
                                    ifelse((FlightInformation$time_num[i] - temptime_prior) <= (temptime_after - FlightInformation$time_num[i]),
                                           temptime_prior, temptime_after)))

  #look up the right temp by finding the row index of right Temp$time_num value and add it to Flight info
  FlightInformation$Temp[i] <- Temperature[which(Temperature$time_num == temptime_closest), "Temp"]
}

#get rid of numeric time column, you don't need it anymore
FlightInformation <- FlightInformation[,!(names(FlightInformation) %in% c("time_num"))]

输出

        DepartureTime Temp
1 2000-01-01 03:01:00   20
2 2000-01-01 10:00:00   10
3 2000-01-01 14:00:00   10

如果您在每个数据框中都有需要匹配的数据子集（例如，仅将 df1$group1 时间值与 df2$group1 时间值匹配），则可以使用survival::neardate。这是一个很好的函数，它基本上完成了上面代码的工作，但如果你需要它们还有一些额外的参数。

希望这会有所帮助！没有所有 cmets 的代码会短很多 =)