跨重叠日期总结

Question

我正在尝试了解如何创建一个变量来总结多个日期的观察结果。

library(data.table)
library(lubridate)
library(magrittr)

sample <- data.table(start = c("2018-12-22 23:00:00",
                               "2018-12-23 06:00:00",
                               "2018-12-22 06:00:00",
                               "2018-12-23 06:00:00"),
                     end = c("2018-12-23 06:00:00",
                             "2018-12-23 13:00:00",
                             "2018-12-23 12:00:00",
                             "2018-12-24 01:00:00"),
                     store = c("A", "A", "B", "B"))

sample[, start:= ymd_hms(start)]
sample[, end := ymd_hms(end)]

sample 

> sample
                 start                 end store
1: 2018-12-22 23:00:00 2018-12-23 06:00:00     A
2: 2018-12-23 06:00:00 2018-12-23 13:00:00     A
3: 2018-12-22 06:00:00 2018-12-23 12:00:00     B
4: 2018-12-23 06:00:00 2018-12-24 01:00:00     B

这里，sample 是每个商店使用的“轮班”时间卡。我们看到商店 A 有两个观察值，每个观察值都有一个开始时间和结束时间。如果跨日期没有“出血”（例如，第一次观察从 2018 年 12 月 22 日开始，到 2018 年 12 月 23 日结束），我会简单地减去开始时间和结束时间，然后在商店之间求和以获得总金额每个商店使用的分钟数。比如：

worked_mins <- sample %>%
.[, date := ymd(substr(start,1,10))] %>%
.[, minutes := end - start] %>%
.[, .(worked_mins = sum(minutes)), by = .(store,date)]

但是，我正在尝试了解如何最好地计算多天（甚至可能 >=2 天）轮班重叠时的分钟数。

根据上述，所需的输出将是：

worked_mins = data.table(store = c("A","A", "B", "B", "B"),
                         date = c("2018-12-22", "2018-12-23",
                                  "2018-12-22", "2018-12-23",
                                  "2018-12-24"),
                         worked_mins = c(1, 13, 18, 30, 1))

> worked_mins
   store       date worked_mins
1:     A 2018-12-22           1
2:     A 2018-12-23          13
3:     B 2018-12-22          18
4:     B 2018-12-23          30
5:     B 2018-12-24           1

谢谢！

Answer 1

这能满足你的需要吗？

sample %>%
  rowwise() %>%
  mutate(
    worked_hours = map2(start, end, ~seq(.x, .y, "hours") %>% head(-1))
    ) %>%
  unnest(cols = c(worked_hours)) %>%
  select(store, worked_hours) %>%
  mutate(date = floor_date(worked_hours, "days")) %>%
  group_by(store, date) %>%
  count(name = "worked_mins")

# A tibble: 5 x 3
# Groups:   store, date [5]
store date                worked_mins
<chr> <dttm>                    <int>
1 A     2018-12-22 00:00:00           1
2 A     2018-12-23 00:00:00          13
3 B     2018-12-22 00:00:00          18
4 B     2018-12-23 00:00:00          30
5 B     2018-12-24 00:00:00           1

Answer 2

计算实际时间的更新解决方案，而不仅仅是计算小时数。这应该考虑小数小时。

library(lubridate) # ceiling_date, floor_date
func <- function(st, en, units = "hours") {
  midns <- ceiling_date(seq(st, en, by = "day"), unit = "day")
  times <- unique(sort(c(midns[ st < midns & midns < en], st, en)))
  if (length(times) < 2) {
    data.table(date = as.Date(floor_date(st)), d = structure(0, class = "difftime", units = units))
  } else {
    data.table(date = as.Date(floor_date(times[-length(times)], unit = "days")), d = `units<-`(diff(times), units))
  }
}

sample[, rbindlist(Map(func, start, end)), by = .(store)
  ][, .(d = sum(d)), by = .(store, date)]
#     store       date          d
#    <char>     <Date> <difftime>
# 1:      A 2018-12-22    1 hours
# 2:      A 2018-12-23   13 hours
# 3:      B 2018-12-22   18 hours
# 4:      B 2018-12-23   30 hours
# 5:      B 2018-12-24    1 hours

（1 hours 仍然是一个数字列，它只是附加了一个单位标签；这可以通过将diff 包装在as.numeric 中轻松删除。）

func 在st 和en 之间包含午夜；创建这些唯一时间戳的times 有序向量允许我们跨越它们diff，然后floor_date 它们，以便我们知道每个差异开始的日期。

您可以看到 func 在这个快速演示中做了什么，它使第一行有 0 秒的差异（用于测试和验证）：

copy(sample)[1, end:=start][, rbindlist(Map(func, start, end)), by = .(store)]
#     store       date          d
#    <char>     <Date> <difftime>
# 1:      A 2018-12-22    0 hours
# 2:      A 2018-12-23    7 hours
# 3:      B 2018-12-22   18 hours
# 4:      B 2018-12-23   12 hours
# 5:      B 2018-12-23   18 hours
# 6:      B 2018-12-24    1 hours