6

I'd like to generate cumulative sums with a reset if the "current" sum exceeds some threshold, using dplyr. In the below, I want to cumsum over 'a'.

library(dplyr)
library(tibble)

tib <- tibble(
  t = c(1,2,3,4,5,6),
  a = c(2,3,1,2,2,3)
)

# what I want
## thresh = 5
# A tibble: 6 x 4
#         t     a     g     c
#      <dbl> <dbl> <int> <dbl>
#   1  1.00  2.00     0  2.00
#   2  2.00  3.00     0  5.00
#   3  3.00  1.00     1  1.00
#   4  4.00  2.00     1  3.00
#   5  5.00  2.00     1  5.00
#   6  6.00  3.00     2  3.00

# what I want
## thresh = 4
# A tibble: 6 x 4
#         t     a     g     c
#      <dbl> <dbl> <int> <dbl>
#   1  1.00  2.00     0  2.00
#   2  2.00  3.00     0  5.00
#   3  3.00  1.00     1  1.00
#   4  4.00  2.00     1  3.00
#   5  5.00  2.00     1  5.00
#   6  6.00  3.00     2  3.00

# what I want
## thresh = 6
# A tibble: 6 x 4
#         t     a     g     c
#      <dbl> <dbl> <int> <dbl>
#   1  1.00  2.00     0  2.00
#   2  2.00  3.00     0  5.00
#   3  3.00  1.00     0  6.00
#   4  4.00  2.00     1  2.00
#   5  5.00  2.00     1  4.00
#   6  6.00  3.00     1  7.00

I've examined many of the similar questions here (such as resetting cumsum if value goes to negative in r) and have gotten what I hoped was close, but no.

I've tried variants of

thresh <-5
tib %>%
  group_by(g = cumsum(lag(cumsum(a) >= thresh, default = FALSE))) %>%
  mutate(c = cumsum(a)) %>%
  ungroup()

which returns

# A tibble: 6 x 4
      t     a     g     c
  <dbl> <dbl> <int> <dbl>
1  1.00  2.00     0  2.00
2  2.00  3.00     0  5.00
3  3.00  1.00     1  1.00
4  4.00  2.00     2  2.00
5  5.00  2.00     3  2.00
6  6.00  3.00     4  3.00

You can see that the "group" is not getting reset after the first time.

schnee
  • 1,050
  • 2
  • 9
  • 20

3 Answers3

11

I think you can use accumulate() here to help. And i've also made a wrapper function to use for different thresholds

sum_reset_at <- function(thresh) {
  function(x) {
    accumulate(x, ~if_else(.x>=thresh, .y, .x+.y))
  }  
}

tib %>% mutate(c = sum_reset_at(5)(a))
#       t     a     c
#   <dbl> <dbl> <dbl>
# 1     1     2     2
# 2     2     3     5
# 3     3     1     1
# 4     4     2     3
# 5     5     2     5
# 6     6     3     3
tib %>% mutate(c = sum_reset_at(4)(a))
#       t     a     c
#   <dbl> <dbl> <dbl>
# 1     1     2     2
# 2     2     3     5
# 3     3     1     1
# 4     4     2     3
# 5     5     2     5
# 6     6     3     3
tib %>% mutate(c = sum_reset_at(6)(a))
#       t     a     c
#   <dbl> <dbl> <dbl>
# 1     1     2     2
# 2     2     3     5
# 3     3     1     6
# 4     4     2     2
# 5     5     2     4
# 6     6     3     7
MrFlick
  • 195,160
  • 17
  • 277
  • 295
  • This is looking brilliant. Thanks. Now what if I want to reset based on either the threshold OR the delta between the "current" t and the last t since reset exceeding another threshold? Either condition triggers reset (That's a new question, should I open a new stackoverflow?) – schnee Mar 02 '18 at 21:54
  • Hi MrFlick, I don't understand how you're passing the column to the function.. I see that it takes the form of sum_reset_at(thresh)(columname) but I don't understand how function(x)(y) works? Do you have a reference? – variable Jul 26 '18 at 15:51
  • @variable sum_reset_at is a function that returns a function. So the first () builds a functions with a certain threshold and the second () calls that function on a vector of data. – MrFlick Jul 26 '18 at 15:56
1

if you're interested in the group building based on cumsum < threshold

You can use the following base:: function:

cumSumReset <- function(x, thresh = 4) {
    ans    <- numeric()
    i      <- 0

    while(length(x) > 0) {
        cs_over <- cumsum(x)
        ntimes <- sum( cs_over <= thresh )
        x      <- x[-(1:ntimes)]
        ans <- c(ans, rep(i, ntimes))
        i   <- i + 1
    }
    return(ans)
}

call:

tib %>% mutate(g = cumSumReset(a, 5))

result:

#   A tibble: 6 x 3
#      t     a     g
#  <dbl> <dbl> <dbl>
#1     1     2     0
#2     2     3     0
#3     3     1     1
#4     4     2     1
#5     5     2     1
#6     6     3     2

  • with the group g you can now do whatever you like.
Andre Elrico
  • 10,956
  • 6
  • 50
  • 69
1

I know it is a bit old question, but I came across this while searching for a similar question and thus thought to include this alternate approach here too.

library MESS has a inbuilt function cumsumbinning() for these kind of requirements. Since here you need to cross that threshold before stopping, you can use it like this (using threshold - 1 and setting cutwhenpassed = TRUE in the third argument.

library(tidyverse)
library(MESS)

tib <- tibble(
  t = c(1,2,3,4,5,6),
  a = c(2,3,1,2,2,3)
)
n <- 5 # threshold

tib %>%
  group_by(g = cumsumbinning(a, n-1, TRUE) -1) %>%
  mutate(c = cumsum(a))
#> # A tibble: 6 x 4
#> # Groups:   g [3]
#>       t     a     g     c
#>   <dbl> <dbl> <dbl> <dbl>
#> 1     1     2     0     2
#> 2     2     3     0     5
#> 3     3     1     1     1
#> 4     4     2     1     3
#> 5     5     2     1     5
#> 6     6     3     2     3

n <- 4 # threshold

tib %>%
  group_by(g = cumsumbinning(a, n-1, TRUE) -1) %>%
  mutate(c = cumsum(a))
#> # A tibble: 6 x 4
#> # Groups:   g [3]
#>       t     a     g     c
#>   <dbl> <dbl> <dbl> <dbl>
#> 1     1     2     0     2
#> 2     2     3     0     5
#> 3     3     1     1     1
#> 4     4     2     1     3
#> 5     5     2     1     5
#> 6     6     3     2     3

n <- 6 # threshold

tib %>%
  group_by(g = cumsumbinning(a, n-1, TRUE) -1) %>%
  mutate(c = cumsum(a))
#> # A tibble: 6 x 4
#> # Groups:   g [2]
#>       t     a     g     c
#>   <dbl> <dbl> <dbl> <dbl>
#> 1     1     2     0     2
#> 2     2     3     0     5
#> 3     3     1     0     6
#> 4     4     2     1     2
#> 5     5     2     1     4
#> 6     6     3     1     7
AnilGoyal
  • 25,297
  • 4
  • 27
  • 45