r dplyr根据重叠的日期时间间隔加入表

Question

我有两个表，label 其中包含 label 时间间隔（开始和结束），以及 items 每个表都有唯一的时间戳项目。

我想根据时间戳来映射items。如果项目时间戳落在标签的时间间隔内，则该项目属于该标签。

例如，这两个项 a123、b682位于与label X547<对应的时间间隔内/code>，所以a123、b682属于X547

# Label, start - end time
have_label_start_end <- data.frame(label = c('X547', 'X285', 'X290')
                   , time = c(lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 9L, min = 58L, sec = 51, tz = "UTC"),
                              lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 10L, min = 4L, sec = 54, tz = "UTC"),
                              lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 11L, min = 8L, sec = 34, tz = "UTC"))) %>% 
  dplyr::mutate(start_time = time, stop_time = lead(time)) %>% dplyr::select(-time) 

> have_label_start_end
  label          start_time           stop_time
1  X547 2022-04-11 09:58:51 2022-04-11 10:04:54
2  X285 2022-04-11 10:04:54 2022-04-11 11:08:34
3  X290 2022-04-11 11:08:34                <NA>


# Item
have_item_time <- data.frame(item = c('a123', 'b682', 'c3324', 'd4343', 'e5343')
           , timestamp = c(lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 9L, min = 59L, sec = 34, tz = "UTC"),
                      lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 10L, min = 3L, sec = 13, tz = "UTC"),
                      lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 10L, min = 5L, sec = 17, tz = "UTC"),
                      lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 11L, min = 8L, sec = 35, tz = "UTC"),
                      lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 11L, min = 10L, sec = 09, tz = "UTC")))

> have_item_time
   item           timestamp
1  a123 2022-04-11 09:59:34
2  b682 2022-04-11 10:03:13
3 c3324 2022-04-11 10:05:17
4 d4343 2022-04-11 11:08:35
5 e5343 2022-04-11 11:10:09


# Map Items to Label
want <- data.frame(label = c('X547', 'X547','X285', 'X290', 'X290'),
                   item = c('a123', 'b682', 'c3324', 'd4343', 'e5343')
                   , timestamp = c(lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 9L, min = 59L, sec = 34, tz = "UTC"),
                              lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 10L, min = 3L, sec = 13, tz = "UTC"),
                              lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 10L, min = 5L, sec = 17, tz = "UTC"),
                              lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 11L, min = 8L, sec = 35, tz = "UTC"),
                              lubridate::make_datetime(year = 2022L, month = 4L, day = 11L, hour = 11L, min = 10L, sec = 09, tz = "UTC")))


> want
  label  item           timestamp
1  X547  a123 2022-04-11 09:59:34
2  X547  b682 2022-04-11 10:03:13
3  X285 c3324 2022-04-11 10:05:17
4  X290 d4343 2022-04-11 11:08:35
5  X290 e5343 2022-04-11 11:10:09

Answer 1

以下方法将间隔转换为开始行和结束行，添加 item_time 表，然后填充这些间隔中的标签以填充 item_time 表。

library(tidyverse)
have_label_start_end %>%
  pivot_longer(-label, values_to = "timestamp") %>%
  bind_rows(have_item_time) %>%
  arrange(timestamp) %>%
  fill(label, .direction = "down") %>%
  filter(!is.na(item)) %>%
  select(label, item, timestamp)

这假设每一项都在一个且仅有一个区间内。如果某个项目可能超出任何间隔或超过一个间隔，我们就需要对此进行修改。

---

另一种方法可能是使用 fuzzyjoin 包，它可以容纳像这样的“非等价”连接（就像 data.table 和 sqldf 一样） 。一项调整是我们需要用有效的时间戳替换任何 NA stop_times。在这种情况下，我们可以使用 have_item_time 中的最大值。

在这里，我们获取 have_item_time 中的特定时间戳位于（包含）have_label_start_end 中的任何间隔之间的所有匹配项。

library(fuzzyjoin)
have_item_time %>%
  fuzzy_left_join(have_label_start_end %>%
                    replace_na(list(stop_time = max(have_item_time$timestamp))), 
                  by = c("timestamp" = "start_time",
                         "timestamp" = "stop_time"),
                  match_fun = list(`>=`, `<=`))

Answer 2

我们可以使用{powerjoin}：

library(powerjoin)
power_left_join(
  have_item_time, have_label_start_end, 
  by = ~.x$timestamp > .y$start_time & 
    (.x$timestamp < .y$stop_time | is.na(.y$stop_time)),
  keep = "left")
#>    item           timestamp label
#> 1  a123 2022-04-11 09:59:34  X547
#> 2  b682 2022-04-11 10:03:13  X547
#> 3 c3324 2022-04-11 10:05:17  X285
#> 4 d4343 2022-04-11 11:08:35  X290
#> 5 e5343 2022-04-11 11:10:09  X290

Answer 3

现在，只有DPLYR才能实现这一目标，使用join_by（）函数代替参数，

• 请参见一个相关问题：
  https://stackoverflow.com/a/a/73498674/3848482
• 示例的帮助页： https://dplyr.tidyverse.org/reference/reference/join_by.html

获得所需的结果：

want <- have_item_time |> 
        inner_join(
            have_label_start_end |> 
                mutate(stop_time = if_else(is.na(stop_time), Sys.Date(), stop_time)), 
            by = join_by(between(x=timestamp, y_lower=start_time, y_upper=stop_time, bounds = "[]"))
            )