R语言实现无活动天数检测

Question

我在RStudio中载入了一个包含许多事件（数百万）的数据框。

每行都是单个事件的条目，除了其他信息外，还包括两个日期信息属性。第一个包含事件开始的日期，第二个包含事件结束的日期。但是这些事件不是按顺序排列的，因此它们可能会在时间上重叠。

                              fecha                   fecha_fin
7510607 2014-02-13 20:09:59.8270000 2014-02-27 09:55:40.9700000
7510608 2014-02-13 20:10:01.1870000 2014-02-27 09:55:42.5630000
7557931 2014-02-16 05:32:08.6230000 2014-02-16 14:03:19.4970000

如何最好和最有效地找出哪些日历日期没有活动（即没有任何事件正在进行）？请注意，必须考虑事件的持续时间。

- daloman

Answer 1

对于这种情况，我倾向于使用data.table包中的foverlaps函数：

library(data.table)
dt <- fread("id,fecha,fecha_fin
7510607,2014-02-01 20:09:59.8270000,2014-02-10 09:55:40.9700000
7510607,2014-02-13 20:09:59.8270000,2014-02-27 09:55:40.9700000
7510608,2014-02-13 20:10:01.1870000,2014-02-27 09:55:42.5630000
7557931,2014-02-16 05:32:08.6230000,2014-02-16 14:03:19.4970000")
setkey(dt, fecha, fecha_fin)
set(dt, j = 1L, value = NULL)
dt <- dt[,lapply(.SD, as.POSIXct, tz = "CET"),.SDcols=1:2]

dt2 <- data.table(fecha=as.POSIXct(seq(min(as.Date(dt$fecha)), max(as.Date(dt$fecha_fin)), "1 day")))[,fecha_fin:=fecha+60*60*24-1]
as.Date(foverlaps(dt2, dt)[is.na(fecha) & is.na(fecha_fin),i.fecha])
# [1] "2014-02-11" "2014-02-12"

- lukeA

---

你的解决方案当然比我的好，但是我已经成功地通过将你的dt2赋值更改为dt2 <- data.table( fecha = seq(min(dt$fecha), max(dt$fecha_fin), by = '1 day') )[, fecha_fin := fecha]，稍微提高了一些时间。当然，前提是dt$fecha已经是日期格式。 - m-dz

已经发布了基准测试结果并编辑了我的回答，随意复制这里的内容，我将删除整个回答。 - m-dz

我已经阅读过，当在大型数据集中使用时，函数findOverlaps比foverlaps更快（https://www.r-bloggers.com/comparing-the-execution-time-between-foverlaps-and-findoverlaps/）。您选择`foverlaps`有特定的原因吗？ - daloman

对我来说，需要使用“GRanges或GRangesList对象”是不使用findOverlaps的好借口。 - m-dz

@m-dz：感谢您进行基准测试。（我有点懒，所以我会留下答案。:)）@daloman：我选择了foverlaps因为它很方便。可能还有更快的替代方法-请随意添加并对它们进行基准测试。 - lukeA

Answer 2

更新，使用稍作修改的lukeA代码：

我希望这里的基准测试没有问题...

library(data.table)
library(lubridate)
library(microbenchmark)

# Create dt ---------------------------------------------------------------

size = 99999
# With this size result is an empty set, check smaller sizes like 999 to confirm
# results are same for both functions

create_dt <- function() {
  set.seed(2016)
  dt <- data.table(
    ID = 1:size,
    fecha = sample(
      seq(ymd('2000/01/01'), ymd('2016/11/16'), by="day"),
      size, replace = TRUE)
  )
  dt[, fecha_fin := fecha + sample(1:3, size, replace = TRUE)]
  setkey(dt, fecha, fecha_fin)
  set(dt, j = 1L, value = NULL)
  dt <- dt[,lapply(.SD, as.POSIXct, tz = "CET"),.SDcols=1:2]
}

dt <- create_dt()

# Declare functions -------------------------------------------------------

f_mdz <- function() {
  dt_2 <- data.table(
    fecha = seq(min(dt$fecha), max(dt$fecha_fin), by = '1 day')
  # Function simplified here!!!
  )[, fecha_fin := fecha]
  # ---------------------------
  as.Date(
    foverlaps(dt_2, dt)[is.na(fecha) & is.na(fecha_fin),i.fecha])#,
    # origin = '1970-01-01')
}

f_lukeA <- function() {
  dt2 <- data.table(
    fecha = seq(min(dt$fecha), max(dt$fecha_fin), "1 day")
  )[,fecha_fin:=fecha+60*60*24-1]
  as.Date(
    foverlaps(dt2, dt)[is.na(fecha) & is.na(fecha_fin),i.fecha])
}

# Benchmark! --------------------------------------------------------------

microbenchmark(
  dt_mdz <- f_mdz(),
  dt_lukeA <- f_lukeA(),
  times = 100)

# Unit: milliseconds
#                  expr      min       lq      mean   median       uq      max neval cld
#     dt_mdz <- f_mdz() 46.96793 55.11631  95.59214 60.33659 191.5536 212.4523   100   a
# dt_lukeA <- f_lukeA() 50.57496 56.42464 105.07356 60.81974 194.0779 211.8037   100   a

identical(dt_mdz, dt_lukeA)

旧答案如下：

一个起点（远非高效，例如在data.table上进行逐行操作...）用于进一步的调查可能是：

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

dt <- data.table(
  ID = c(7510607L, 7510608L, 7557931L),
  fecha = ymd(c('2014-02-15', '2014-02-16', '2014-02-11')),
  fecha_fin = ymd(c('2014-02-27', '2014-02-27', '2014-02-12'))
)
#         ID      fecha  fecha_fin
# 1: 7510607 2014-02-15 2014-02-27
# 2: 7510608 2014-02-16 2014-02-27
# 3: 7557931 2014-02-11 2014-02-12

# Make the data "long"
long_dt <- dt[, .(days = seq(fecha, fecha_fin, by = '1 day')), by = ID]

# Get the diff with days sequence from min to max date
setdiff(
  seq(long_dt[, min(days)], long_dt[, max(days)], by = '1 day'),
  long_dt[, sort(unique(days))]
) %>% as.Date(origin = '1970-01-01')
# [1] "2014-02-13" "2014-02-14"

请注意，我已经更改了您的数据，实际上有两天（2014年2月13日和2014年2月14日）没有任何活动。

- m-dz

---

看起来你忽略了时间组件。 - Marichyasana

@Marichyasana，OP问道“要找出哪些日历日期”，因此我假定处理2014-02-13 20:09:59.8270000和2014-02-13会得到相同的结果，对吗？ - m-dz

如果一个事件在某一天上午8:00开始，并在同一天下午5:00结束，你会说没有事件发生，因为这一天是相同的吗？ - Marichyasana

不，事件发生在那一天，这将被考虑在内。请使用以下代码：dt <- data.table( ID = c(7510607L, 7510608L, 7557931L), fecha = ymd(c('2014-02-15', '2014-02-27')), fecha_fin = ymd(c('2014-02-15', '2014-02-27')) ) - m-dz

Answer 3

一个基于R的解决方案是这样的：

df$fecha <- strptime(df$fecha, "%Y-%m-%d")
df$fecha_fin <- strptime(df$fecha_fin, "%Y-%m-%d")

dates_list <- lapply(1:3, function(x){

  interval_events <- seq(from = df$fecha[x], to = df$fecha_fin[x], by = "days")

})

interval_events  <- unique(do.call("c", dates_list))

interval_complete <- seq(from = min(df$fecha), max(df$fecha_fin), by = "days")

interval_complete[!(interval_complete %in% interval_events)]
#[1] "2014-02-13 CET" "2014-02-14 CET"

- J_F

Answer 4

这是一个简单的问题！您只需扩展日期并取所有日期的并集即可。

## Data
dt1=as.Date(c('2014/01/01','2014/01/08','2014/01/05'))
dt2=as.Date(c('2014/01/10','2014/01/14','2014/01/05'))
df=data.frame(id=sample(1:3), dt1=dt1, dt2=dt2)
## Code
date=apply(df, 1, function(x) seq(as.Date(x[2]), as.Date(x[3]), by="day"))
event_dates=as.Date(Reduce(union, date), origin = "1970-01-01")

- Chirayu Chamoli