使用 R 根据来自另一个数据框的 3 列在数据框中添加列

Question

我有 2 个数据框，如下所示：

Dataframe 1： traffic_df，每小时数据。

Date_Time	Traffic
2020-03-09 06:00:00	10
2020-03-09 07:00:00	20
2020-03-10 07:00:00	20
2020-03-24 08:00:00	15

数据框 2： Alert.level

Start	End	Alert.level
10/03/2020 13:30	23/03/2020 13:30	2
23/03/2020 13:30	25/03/2020 23:59	3

我想在 traffic_df 中添加第三列，如果 Date_Time 在 Start Alert.level df 的 和 End Date_Time，以便生成的数据框如下所示：

数据框 1： traffic_df

Date_Time	Traffic	Alert.Level
2020-03-09 06:00:00	10
2020-03-09 07:00:00	20
2020-03-10 07:00:00	20	2
2020-03-24 08:00:00	15	3

有没有办法做到这一点而不必制作一个匹配的每小时数据框然后使用连接？ 我正在考虑以某种方式使用地图功能？

生成df的代码：

traffic_df <- structure(list(Date_Time = c("2020-03-09 06:00:00", "2020-03-09 07:00:00", "2020-03-10 07:00:00", 
                              "2020-03-24 08:00:00"), Traffic = c(10L, 20L, 20L, 15L)), 
                row.names = c(NA, -4L), class = "data.frame")

Alert.Level = data.frame(Start = c("10/03/2020 13:30", "23/03/2020 13:30"), 
           End = c("23/03/2020 13:30", "25/03/2020 23:59"), 
           Alert.level = c(2, 3))

Answer 1

你可以试试fuzzyjoin 包。

数据

library(lubridate)

traffic_df <- structure(list(Date_Time = c("2020-03-09 06:00:00", "2020-03-09 07:00:00", "2020-03-10 07:00:00", 
                                           "2020-03-24 08:00:00"), Traffic = c(10L, 20L, 20L, 15L)), 
                        row.names = c(NA, -4L), class = "data.frame") %>%
  mutate(Date_Time = ymd_hms(Date_Time))

Alert.Level = data.frame(Start = c("10/03/2020 13:30", "23/03/2020 13:30"), 
                         End = c("23/03/2020 13:30", "25/03/2020 23:59"), 
                         Alert.level = c(2, 3)) %>% 
  mutate(Start = dmy_hms(Start),
         End = dmy_hms(End))

代码

library(fuzzyjoin)

traffic_df %>%
  fuzzy_left_join(Alert.Level,
                  match_fun = list(`>=`, `<=`),
                  by = list(x = c("Date_Time",
                                  "Date_Time"),
                            y = c("Start",
                                  "End"))) %>%
  select(-Start, -End)

输出
与上面的预期输出相反，第三行不匹配，因为 7:00 点在开始时间 13:30 之前。

            Date_Time Traffic Alert.level
1 2020-03-09 06:00:00      10          NA
2 2020-03-09 07:00:00      20          NA
3 2020-03-10 07:00:00      20          NA
4 2020-03-24 08:00:00      15           3

Answer 2

这是使用sqldf 的解决方案。请注意，为了方便使用 SQL，我将 data.frame 重命名为下划线。

library(sqldf)

Alert_level <- Alert.level

sqldf("SELECT * FROM traffic_df
       LEFT JOIN Alert_level
       ON traffic_df.Date_Time BETWEEN Alert_level.Start AND Alert_level.End")

输出

            Date_Time Traffic               Start                 End Alert.level
1 2020-03-09 06:00:00      10                <NA>                <NA>          NA
2 2020-03-09 07:00:00      20                <NA>                <NA>          NA
3 2020-03-10 07:00:00      20                <NA>                <NA>          NA
4 2020-03-24 08:00:00      15 2020-03-23 13:30:00 2020-03-25 23:59:00           3

Answer 3

我喜欢outer 在这种情况下的方法。首先，定义一个Vectorized FUNction，查看特定的x 是否在y 区间之间。把它放在outer 中，它会以Alert.Level 的每个开始/结束间隔迭代每个Date_Time。这给出了一个矩阵o，通知which 间隔适用（我使用unname 以避免混淆）。然后，在traffic_df 中，我们创建一个NA 列alert_lv（应该与“Alert.Level”有不同的名称），用正数colSums 对其进行子集化，并放入Alert.Level 的相应级别。

FUN <- Vectorize(function(x, y) x >= y[1] & x < y[2])
(o <- unname(outer(traffic_df$Date_Time, Alert.Level[-3], FUN)))
#       [,1]  [,2]  [,3]  [,4]
# [1,] FALSE FALSE  TRUE FALSE
# [2,] FALSE FALSE FALSE  TRUE

w <- unlist(apply(o, 1, which))

traffic_df <- within(traffic_df, {
  alert_lv <- NA
  alert_lv[rowSums(o) > 0] <- Alert.Level[w, 3]
})
traffic_df
#             Date_Time Traffic alert_lv
# 1 2020-03-09 06:00:00      10       NA
# 2 2020-03-09 07:00:00      20       NA
# 3 2020-03-10 07:00:00      20        2
# 4 2020-03-24 08:00:00      15        3

注意：要使用此解决方案，您首先需要通常的 'POSIXct' 格式，所以首先您应该这样做

traffic_df$Date_Time <- as.POSIXct(traffic_df$Date_Time)
Alert.Level[1:2] <- lapply(Alert.Level[1:2], strptime, format='%d/%m/%Y %H:%M')