r - 按间隔限制大小的日期组

Question

我有一个包含日期的数据框，我想按 9 天的间隔对日期进行分组，但组大小最多应为 7 个日期。因此，如果我们在间隔中找到 9 天，则最后 2 个日期应该滚动到下一组，依此类推。

并且一个区间的起始日期只能是数据集已有的日期。

这是一个例子:

start_date <- as.Date("2020-04-17")
dates <- c(start_date,  
           start_date + 10:16, 
           start_date + c(17, 18, 20), 
           start_date + c(30, 39))
x <- data.frame(date = dates)

> x
         date
1  2020-04-17
2  2020-04-27
3  2020-04-28
4  2020-04-29
5  2020-04-30
6  2020-05-01
7  2020-05-02
8  2020-05-03
9  2020-05-04
10 2020-05-05
11 2020-05-07
12 2020-05-17
13 2020-05-26

以及预期的输出:

         date group
1  2020-04-17     1
2  2020-04-27     2
3  2020-04-28     2
4  2020-04-29     2
5  2020-04-30     2
6  2020-05-01     2
7  2020-05-02     2
8  2020-05-03     2
9  2020-05-04     3
10 2020-05-05     3
11 2020-05-07     3
12 2020-05-17     4
13 2020-05-26     4

我真的被困在这个问题上，到目前为止我所做的一切都没有奏效，我们将不胜感激任何帮助，谢谢!

Answer 1

我相信这就是您想要的。如您所见，代码效率很低，但我想不出不按顺序进行的方式。

start_date <- as.Date("2020-04-17")
dates <- c(start_date,  
           start_date + 10:16, 
           start_date + c(17, 18, 20), 
           start_date + c(30, 39))
x <- data.frame(date = dates)

assign_group <- function(group_var, group_number) {
  # finding the start of the group
  start_idx <- min(which(is.na(group_var))) 
  # finding the end of the group (either group size == 7 or the dates in the range)
  end_idx <- start_idx + min(6, sum(x$date > x$date[start_idx] &
                                      x$date <= x$date[start_idx] + 9))
  # taking care of the out of range index
  end_idx <- min(end_idx, length(group_var))
  # assign group number
  group_var[start_idx:end_idx] <- group_number 
  return(group_var)
}

group <- rep(NA, nrow(x))
group_number <- 1

while(sum(is.na(group[length(group)])) > 0){
  group <- assign_group(group, group_number)
  group_number <- group_number + 1
  print(group)
}
#>  [1]  1 NA NA NA NA NA NA NA NA NA NA NA NA
#>  [1]  1  2  2  2  2  2  2  2 NA NA NA NA NA
#>  [1]  1  2  2  2  2  2  2  2  3  3  3 NA NA
#>  [1] 1 2 2 2 2 2 2 2 3 3 3 4 4

x$group <- group
x
#>          date group
#> 1  2020-04-17     1
#> 2  2020-04-27     2
#> 3  2020-04-28     2
#> 4  2020-04-29     2
#> 5  2020-04-30     2
#> 6  2020-05-01     2
#> 7  2020-05-02     2
#> 8  2020-05-03     2
#> 9  2020-05-04     3
#> 10 2020-05-05     3
#> 11 2020-05-07     3
#> 12 2020-05-17     4
#> 13 2020-05-26     4

^{由 reprex package 创建于 2020-05-27 (v0.3.0)}