Cumulative sum for specific range of dates

I'm trying to calculate the rowise cumulative sum of Rates from DATE to DATE_following.

For example:

library(tidyverse)
library(bizdays)
library(lubridate)

set.seed(1)
dat <- seq.Date(from = as.Date(as.Date("2023-04-06")- days(10)),
                to = as.Date(as.Date("2023-04-06")),
                by = "day")  %>% 
  data.frame(DATE = .) %>% 
  mutate(Rates = sample(seq(from=1,to=10,by=1), size = length(DATE),replace=TRUE),
         DATE_following = modified.following(DATE %m+% days(3)))

dat
        DATE Rates DATE_following
1  2023-03-27     9     2023-03-30
2  2023-03-28     4     2023-03-31
3  2023-03-29     7     2023-04-01
4  2023-03-30     1     2023-04-02
5  2023-03-31     2     2023-04-03
6  2023-04-01     7     2023-04-04
7  2023-04-02     2     2023-04-05
8  2023-04-03     3     2023-04-06
9  2023-04-04     1     2023-04-07
10 2023-04-05     5     2023-04-08
11 2023-04-06     5     2023-04-09

The output i'm trying to get is:

1. Result: 9+4+7+1 = 21 (the sum of Rates from 2023-03-27 to 2023-03-30 )
2. Result: 4+7+1+2 = 14 ...

         DATE Rates DATE_following Results
1  2023-03-27     9     2023-03-30      21
2  2023-03-28     4     2023-03-31      14
3  2023-03-29     7     2023-04-01      17
4  2023-03-30     1     2023-04-02      12
5  2023-03-31     2     2023-04-03      14
6  2023-04-01     7     2023-04-04      13
7  2023-04-02     2     2023-04-05      11
8  2023-04-03     3     2023-04-06      14
9  2023-04-04     1     2023-04-07      NA
10 2023-04-05     5     2023-04-08      NA
11 2023-04-06     5     2023-04-09      NA

Is it possible to get this result using dplyr functions like rowwise() and cumsum()? My main problem is that I don't know how to define this condition within these functions.

If you want a rolling sum for four consecutive Rates, you could use zoos rollsum() function:

library(dplyr)
library(zoo)

dat %>% 
  mutate(Result = rollsum(Rates, k = 4, fill = NA_real_, align = "left"))

This returns

# A tibble: 11 × 5
      no DATE       Rates DATE_following Result
   <dbl> <date>     <dbl> <date>          <dbl>
 1     1 2023-03-27     9 2023-03-30         21
 2     2 2023-03-28     4 2023-03-31         14
 3     3 2023-03-29     7 2023-04-01         17
 4     4 2023-03-30     1 2023-04-02         12
 5     5 2023-03-31     2 2023-04-03         14
 6     6 2023-04-01     7 2023-04-04         13
 7     7 2023-04-02     2 2023-04-05         11
 8     8 2023-04-03     3 2023-04-06         14
 9     9 2023-04-04     1 2023-04-07         NA
10    10 2023-04-05     5 2023-04-08         NA
11    11 2023-04-06     5 2023-04-09         NA

A slightly more general answer based on LeMarque's comment:

dat2 %>% 
  mutate(days = as.integer(DATE_following - DATE) + 1,
         res = rollapply(data = Rates, width = days, FUN = sum, align = "left", fill = NA_real_))

This returns

# A tibble: 11 × 6
      no DATE       Rates DATE_following  days   res
   <dbl> <date>     <dbl> <date>         <dbl> <dbl>
 1     1 2023-03-27     9 2023-03-30         4    21
 2     2 2023-03-28     4 2023-03-31         4    14
 3     3 2023-03-29     7 2023-04-01         4    17
 4     4 2023-03-30     1 2023-04-02         4    12
 5     5 2023-03-31     2 2023-04-10        11    NA
 6     6 2023-04-01     7 2023-04-04         4    13
 7     7 2023-04-02     2 2023-04-05         4    11
 8     8 2023-04-03     3 2023-04-06         4    14
 9     9 2023-04-04     1 2023-04-07         4    NA
10    10 2023-04-05     5 2023-04-08         4    NA
11    11 2023-04-06     5 2023-04-09         4    NA

Since the DATE_following in row 5 isn't present in the data, this version returns NA. Furthermore this version doesn't sum four consecutive days but calculates the days between DATE and DATE_following and applies them to the rolling sum.

Data

dat <- structure(list(no = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11), DATE = structure(c(19443, 
19444, 19445, 19446, 19447, 19448, 19449, 19450, 19451, 19452, 
19453), class = "Date"), Rates = c(9, 4, 7, 1, 2, 7, 2, 3, 1, 
5, 5), DATE_following = structure(c(19446, 19447, 19448, 19449, 
19450, 19451, 19452, 19453, 19454, 19455, 19456), class = "Date")), class = c("spec_tbl_df", 
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -11L), spec = structure(list(
    cols = list(no = structure(list(), class = c("collector_double", 
    "collector")), DATE = structure(list(format = ""), class = c("collector_date", 
    "collector")), Rates = structure(list(), class = c("collector_double", 
    "collector")), DATE_following = structure(list(format = ""), class = c("collector_date", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
    "collector")), skip = 1L), class = "col_spec"))

dat2 <- structure(list(no = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11), DATE = structure(c(19443, 
19444, 19445, 19446, 19447, 19448, 19449, 19450, 19451, 19452, 
19453), class = "Date"), Rates = c(9, 4, 7, 1, 2, 7, 2, 3, 1, 
5, 5), DATE_following = structure(c(19446, 19447, 19448, 19449, 
19457, 19451, 19452, 19453, 19454, 19455, 19456), class = "Date")), class = c("spec_tbl_df", 
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -11L), spec = structure(list(
    cols = list(no = structure(list(), class = c("collector_double", 
    "collector")), DATE = structure(list(format = ""), class = c("collector_date", 
    "collector")), Rates = structure(list(), class = c("collector_double", 
    "collector")), DATE_following = structure(list(format = ""), class = c("collector_date", 
    "collector"))), default = structure(list(), class = c("collector_guess", 
    "collector")), skip = 1L), class = "col_spec"))

Did you need something like this:

library(zoo)
library(tidyverse)
set.seed(1)
dat <- seq.Date(from = as.Date(today()- days(10)), to = as.Date(today()), by = "day")  %>% 
data.frame(DATE = .) %>% 
mutate(Rates = sample(seq(from=1,to=10,by=1), size = length(DATE),,replace=TRUE),
DATE_following = DATE %m+% days(3),
Results = rollapply(data = Rates, width = 4, FUN = sum, align = "left", fill = NA, partial = TRUE)) %>%
mutate( Results = ifelse(DATE_following %in% DATE, Results, NA))

dat

which results in:

          DATE Rates DATE_following Results
1  2023-03-27     3     2023-03-30      20
2  2023-03-28     3     2023-03-31      24
3  2023-03-29     8     2023-04-01      27
4  2023-03-30     6     2023-04-02      27
5  2023-03-31     7     2023-04-03      28
6  2023-04-01     6     2023-04-04      22
7  2023-04-02     8     2023-04-05      20
8  2023-04-03     7     2023-04-06      20
9  2023-04-04     1     2023-04-07      NA
10 2023-04-05     4     2023-04-08      NA
11 2023-04-06     8     2023-04-09      NA

Please check and let me know...

If you want a rolling sum you can use filter.

rev(filter(rev(dat$Rates), rep(1,4), side=1))
#rev(stats::filter(rev(dat$Rates), rep(1,4), side=1)) #In case using dplyr which is masking stats::filter
# [1] 21 14 17 12 14 13 11 14 NA NA NA

In case the dates should be matched:

mapply(\(a,b) if(is.na(b)) NA else sum(dat$Rates[a:b]),
seq_len(nrow(dat)), match(dat$DATE_following, dat$DATE))
# [1] 21 14 17 12 14 13 11 14 NA NA NA

Or in case it is not sorted and there is no need that all dates are present nor need to match:

mapply(\(a,b) sum(dat$Rates[dat$DATE >= a & dat$DATE <= b]),
+   dat$DATE, dat$DATE_following)
# [1] 21 14 17 12 14 13 11 14 11 10  5

Thanks to @Martin Gal for providing the data!

Here are some data.table option

1. frollsum approach

library(data.table)
setDT(dat)
dat[
,
Results := frollsum(Rates, DATE_following - DATE + 1, adaptive = TRUE)
][
,
Results := Results[order(is.na(Results))]
][]

2. non-equi join approach

library(data.table)
setDT(dat)
dat[
dat[
dat,
on = .(DATE <= DATE_following)
][
DATE_following >= DATE,
.(Results = sum(Rates)),
i.DATE
],
Results := Results * (match(DATE_following, DATE) > 0),
on = .(DATE = i.DATE)
][]

Output

          DATE Rates DATE_following Results
1: 2023-03-27     9     2023-03-30      21
2: 2023-03-28     4     2023-03-31      14
3: 2023-03-29     7     2023-04-01      17
4: 2023-03-30     1     2023-04-02      12
5: 2023-03-31     2     2023-04-03      14
6: 2023-04-01     7     2023-04-04      13
7: 2023-04-02     2     2023-04-05      11
8: 2023-04-03     3     2023-04-06      14
9: 2023-04-04     1     2023-04-07      NA
10: 2023-04-05     5     2023-04-08      NA
11: 2023-04-06     5     2023-04-09      NA

A rolling sum would indeed be more efficient, but this could be a potential solution if your start and end points are dynamic.

# remotes::install_github("NicChr/timeplyr")
library(timeplyr)
library(dplyr)
library(lubridate)
set.seed(1)
dat <- seq.Date(from = as.Date(Sys.Date()- days(10)),
                to = as.Date(Sys.Date()),
                by = "day")  %>% 
  data.frame(DATE = .) %>% 
  mutate(Rates = sample(seq(from=1,to=10,by=1), size = length(DATE),,replace=TRUE),
         DATE_following =DATE %m+% days(3))
# Vectorised seq function
x1 <- time_seq_v(dat$DATE, dat$DATE_following, by = "days")
# Label these based on the relevant rows
x2 <- rep(seq_len(nrow(dat)), time_seq_len(dat$DATE, dat$DATE_following, by = "days"))

# Add these sequences to the data
dat <- dat %>%
  as_tibble() %>%
  mutate(dates = split(x1, x2))



# Sum
my_sum <- numeric(nrow(dat))
for (i in seq_len(nrow(dat))){
  my_sum[[i]] <- sum(dat$Rates[dat$DATE %in% dat$dates[[i]]])
}
dat$Result <- my_sum

dat
#> # A tibble: 11 x 5
#>    DATE       Rates DATE_following dates        Result
#>    <date>     <dbl> <date>         <named list>  <dbl>
#>  1 2023-03-27     9 2023-03-30     <date [4]>       21
#>  2 2023-03-28     4 2023-03-31     <date [4]>       14
#>  3 2023-03-29     7 2023-04-01     <date [4]>       17
#>  4 2023-03-30     1 2023-04-02     <date [4]>       12
#>  5 2023-03-31     2 2023-04-03     <date [4]>       14
#>  6 2023-04-01     7 2023-04-04     <date [4]>       13
#>  7 2023-04-02     2 2023-04-05     <date [4]>       11
#>  8 2023-04-03     3 2023-04-06     <date [4]>       14
#>  9 2023-04-04     1 2023-04-07     <date [4]>       11
#> 10 2023-04-05     5 2023-04-08     <date [4]>       10
#> 11 2023-04-06     5 2023-04-09     <date [4]>        5

^{Created on 2023-04-06 with reprex v2.0.2}