如何在给定时间段之间添加具有时间段的行？

Question

我有一个包含时间段的数据集，这些时间段可能会重叠，显示是否有人在场 (example_df)。我想获得一个数据集，将一个大的时间段（从 2014-01-01 到 2014-10-31）分成有人在场的较小时间段（present = 1）和没有人在场的时间段（ present = 0)。结果应该类似于 result_df

示例数据框

example_df <- data.frame(ID = 1, 
                     start = c(as.Date("2014-01-01"), as.Date("2014-03-05"), as.Date("2014-06-13"), as.Date("2014-08-15")), 
                     end = c(as.Date("2014-04-07"), as.Date("2014-04-12"), as.Date("2014-08-05"), as.Date("2014-10-02")), 
                     present = 1)

结果应如下所示

result_df <- data.frame(ID = 1, 
                     start = c(as.Date("2014-01-01"), as.Date("2014-04-12"), as.Date("2014-06-13"), as.Date("2014-08-05"), as.Date("2014-08-15"), as.Date("2014-10-02")), 
                     end = c(as.Date("2014-04-12"), as.Date("2014-06-13"), as.Date("2014-08-05"), as.Date("2014-08-15"), as.Date("2014-10-02"), as.Date("2014-10-31")), 
                     present = c(1, 0, 1, 0, 1, 0))

我不知道如何解决这个问题，因为它需要拆分时间段或添加行（或其他？）。非常感谢任何帮助！

Answer 1

假设您想为每个 ID 单独执行此操作，您可以创建一个数据 table，其中包含有人在场的所有日期，然后将其与 table该时间段内的所有日期。结果并不完全相同，因为现在和 not-present 期间不重叠。

library(data.table)
setDT(example_df)


example_df[, {
  pres <- unique(unlist(Map(`:`, start, end)))
  class(pres) <- 'Date'
  all <- min(pres):max(pres)
  class(all) <- 'Date'
  pres <- data.table(day = pres)
  all <- data.table(day = all)
  out.full <- pres[all, on = .(day), .(day = i.day, present = +!is.na(x.day))]
  out.full[, .(start = min(day), end = max(day)), 
           by = .(present, rid = rleid(present))][, -'rid']
  }, by = ID]

#    ID present      start        end
# 1:  1       1 2014-01-01 2014-04-12
# 2:  1       0 2014-04-13 2014-06-12
# 3:  1       1 2014-06-13 2014-08-05
# 4:  1       0 2014-08-06 2014-08-14
# 5:  1       1 2014-08-15 2014-10-02

Answer 2

希望我能对您有所帮助，因为我也曾为此苦苦挣扎过。

与 IceCreamToucan 的示例一样，这假定人员 ID 是独立的。这种方法使用 dplyr 查看日期范围内的重叠，然后将它们展平。这种方法的其他已在 Whosebug 和使用 dplyr 中进行了描述。最终结果包括此人在场的时间范围。

library(tidyr)
library(dplyr)

pres <- example_df %>%
  group_by(ID) %>%
  arrange(start) %>% 
  mutate(indx = c(0, cumsum(as.numeric(lead(start)) > cummax(as.numeric(end)))[-n()])) %>%
  group_by(ID, indx) %>%
  summarise(start = min(start), end = max(end), present = 1) %>%
  select(-indx)

然后，可以添加额外的行来指示不存在的时间段。在这些情况下，对于给定的 ID，它将确定较旧的结束日期和较新（最近）的开始日期之间的间隔。然后最后结果按ID和开始日期排序。

result <- pres

for (i in unique(pres$ID)) {
  pres_i <- subset(pres, ID == i)
  if (nrow(pres_i) > 1) {
    adding <- data.frame(ID = i, start = pres_i$end[-nrow(pres_i)]+1, end = pres_i$start[-1]-1, present = 0)
    adding <- adding[adding$start <= adding$end, ]
    result <- bind_rows(result, adding)
  }
}
result[order(result$ID, result$start), ]

# A tibble: 5 x 4
# Groups:   ID [1]
     ID start      end        present
  <dbl> <date>     <date>       <dbl>
1     1 2014-01-01 2014-04-12       1
2     1 2014-04-13 2014-06-12       0
3     1 2014-06-13 2014-08-05       1
4     1 2014-08-06 2014-08-14       0
5     1 2014-08-15 2014-10-02       1

如何在给定时间段之间添加具有时间段的行？

How to add rows with time periods inbetween given time period?

r

time-series

lubridate

dplyr

示例数据框

结果应如下所示