limited size dates groups by interval

user_2667955 0
Viewed 64

I have a data frame with dates and I would like to group dates by interval of 9 days, but the group size should be of 7 dates maximum. So if we find 9 days in the interval, the 2 last dates should roll to the next group and so on.

And the starting date of an interval can only be an existing date of the dataset.

Here is an example :

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

And the exected output :

         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

I'm really stuck ony this, nothing worked from what I tried so far, any help would be really apprectiated, thank you !

r
2 Answers

I believe this is what you want. As you can see, the code is quite inefficient, but I can't think of the way without going sequentially. 

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

Created on 2020-05-27 by the reprex package (v0.3.0)

user_66087980

Here is an option using Rcpp:

library(Rcpp)
cppFunction("
IntegerVector grpDates(IntegerVector dates, int winsize, int daysaft) {
    int sz = dates.size(), start = 0;
    IntegerVector res(sz);  

    res[0] = 1;
    for (int i = 1; i < sz; i++) {
        if ((dates[i] - dates[start] > daysaft) || (i - start + 1 > winsize)) {
            res[i] = res[i-1] + 1;
            start = i;
        } else {
            res[i] = res[i-1];
        }
    }

    return res;
}")
x$group <- grpDates(dates, 7L, 9L)
x

output:

         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
14 2020-06-03     5
15 2020-06-04     5
16 2020-06-05     5
17 2020-06-06     5
18 2020-06-07     5
19 2020-06-08     5
20 2020-06-09     5

data with more date rows:

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),
    start_date + 47:53)
x <- data.frame(date = dates)
user_19894800
Related