用于根据不均匀日期创建不均匀组的 R 函数

R function for creating uneven groups based on uneven dates

我正在尝试找到一个可以迭代索引组的 R 函数,给定一组不均匀间隔的日期、不均匀的组大小和分组案例。以下是示例数据:

> h
# A tibble: 20 x 2
      ID date      
   <int> <date>    
 1     1 2021-01-07
 2     1 2021-01-11
 3     1 2021-01-15
 4     1 2021-01-16
 5     1 2021-01-21
 6     1 2021-01-26
 7     1 2021-02-04
 8     1 2021-02-08
 9     1 2021-02-13
10     1 2021-02-20
11     1 2021-02-23
12     1 2021-02-27
13     2 2021-01-05
14     2 2021-01-11
15     2 2021-02-02
16     2 2021-02-08
17     2 2021-02-08
18     2 2021-02-14
19     2 2021-02-17
20     2 2021-02-21

对于每个唯一 ID,我想找到第一个日期(按时间顺序)并为该案例和 7 天内的任何其他行创建一个组(即 group==1)。对于 7 天后的下一个日期,为该案例和接下来 7 天内的任何其他案例创建第二组(即 group==2)。注意:下一个日期不一定正好是初始日期后的 7 天。对剩余的剩余案例重复此过程以获得所需的输出:

# A tibble: 20 x 3
      ID date       group
   <int> <date>     <dbl>
 1     1 2021-01-07     1
 2     1 2021-01-11     1
 3     1 2021-01-15     2
 4     1 2021-01-16     2
 5     1 2021-01-21     2
 6     1 2021-01-26     3
 7     1 2021-02-04     4
 8     1 2021-02-08     4
 9     1 2021-02-13     5
10     1 2021-02-20     5
11     1 2021-02-23     6
12     1 2021-02-27     6
13     2 2021-01-05     1
14     2 2021-01-11     1
15     2 2021-02-02     2
16     2 2021-02-08     2
17     2 2021-02-08     2
18     2 2021-02-14     3
19     2 2021-02-17     3
20     2 2021-02-21     3

使用 7 天的滚动 window 函数 不会 工作,据我所知,因为它会错误地分组案例。但我想知道是否可以使用某种 custom rolling window 函数?我更喜欢使用 dplyr 的解决方案,但其他选项也可以。在此感谢任何帮助。

> dput(h)
structure(list(ID = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), date = structure(c(18634, 
18638, 18642, 18643, 18648, 18653, 18662, 18666, 18671, 18678, 
18681, 18685, 18632, 18638, 18660, 18666, 18666, 18672, 18675, 
18679), class = "Date")), row.names = c(NA, -20L), class = c("tbl_df", 
"tbl", "data.frame"))

对于每个 ID 组,创建 group 作为 NA 的向量。虽然一些 group 元素仍然是 NA,但取 group 是 NA 的第一个日期值并向其添加 0 天和 7 天以构成一个日期范围。对于 date 在计算日期范围内的任何行,将组的元素设置为比 group 的当前最大值多 1(如果组仍然全部为 NA,则为 0)。

library(data.table)
setDT(df)

df[order(ID, date), {
     group <- rep(NA_real_, .N)
     while(any(is.na(group))){
       group_range <- first(date[is.na(group)]) + c(0, 7)
       group[date %between% group_range] <- 1 + max(fcoalesce(group, 0)) 
     }
     list(date, group) 
   }, by = ID]

# ID       date group
# 1:  1 2021-01-07     1
# 2:  1 2021-01-11     1
# 3:  1 2021-01-15     2
# 4:  1 2021-01-16     2
# 5:  1 2021-01-21     2
# 6:  1 2021-01-26     3
# 7:  1 2021-02-04     4
# 8:  1 2021-02-08     4
# 9:  1 2021-02-13     5
# 10:  1 2021-02-20     5
# 11:  1 2021-02-23     6
# 12:  1 2021-02-27     6
# 13:  2 2021-01-05     1
# 14:  2 2021-01-11     1
# 15:  2 2021-02-02     2
# 16:  2 2021-02-08     2
# 17:  2 2021-02-08     2
# 18:  2 2021-02-14     3
# 19:  2 2021-02-17     3
# 20:  2 2021-02-21     3

这是我尝试限制计算的另一个版本。不知道它是否真的更快

df[order(ID, date), {
     group <- rep(NA_integer_, .N)
     i <- 1L
     g <- 1L
     while(i <= .N){
       group_range <- date[i] + c(0, 7)
       chg <- date %between% group_range
       group[chg] <- g
       g <- g + 1L
       i <- i + sum(chg)
     }
     list(date, group) 
   }, by = ID]

定义一个函数 date1,它给出了前一行点的组的第一个日期和当前行的日期 returns当前组的开始日期——必须是两者之一争论。然后按 ID 分组使用 Reduce 将其应用于每个 ID 中的日期,并将结果转换为因子,然后再转换为整数。

library(dplyr)

date1 <- function(prev, x) if (x > prev + 7) x else prev
h %>% 
  group_by(ID) %>%
  mutate(group = as.integer(factor(Reduce(date1, date, acc = TRUE)))) %>%
  ungroup

给予:

# A tibble: 20 x 3
      ID date       group
   <int> <date>     <dbl>
 1     1 2021-01-07     1
 2     1 2021-01-11     1
 3     1 2021-01-15     2
 4     1 2021-01-16     2
 5     1 2021-01-21     2
 6     1 2021-01-26     3
 7     1 2021-02-04     4
 8     1 2021-02-08     4
 9     1 2021-02-13     5
10     1 2021-02-20     5
11     1 2021-02-23     6
12     1 2021-02-27     6
13     2 2021-01-05     1
14     2 2021-01-11     1
15     2 2021-02-02     2
16     2 2021-02-08     2
17     2 2021-02-08     2
18     2 2021-02-14     3
19     2 2021-02-17     3
20     2 2021-02-21     3