Breaking cumsum() function at some threshold in r

问题

For example I have the following code:

cumsum(1:100)

And I want to break it,if an element i+1 will be greater than 3000. How can I do that?

So instead of this result:

[1]    1    3    6   10   15   21   28   36   45   55   66   78   91  105  120  136  153  171  190  210  231  253  276  300
 [25]  325  351  378  406  435  465  496  528  561  595  630  666  703  741  780  820  861  903  946  990 1035 1081 1128 1176
 [49] 1225 1275 1326 1378 1431 1485 1540 1596 1653 1711 1770 1830 1891 1953 2016 2080 2145 2211 2278 2346 2415 2485 2556 2628
 [73] 2701 2775 2850 2926 3003 3081 3160 3240 3321 3403 3486 3570 3655 3741 3828 3916 4005 4095 4186 4278 4371 4465 4560 4656
 [97] 4753 4851 4950 5050

I want get the following result:

 [1]    1    3    6   10   15   21   28   36   45   55   66   78   91  105  120  136  153  171  190  210  231  253  276  300
 [25]  325  351  378  406  435  465  496  528  561  595  630  666  703  741  780  820  861  903  946  990 1035 1081 1128 1176
 [49] 1225 1275 1326 1378 1431 1485 1540 1596 1653 1711 1770 1830 1891 1953 2016 2080 2145 2211 2278 2346 2415 2485 2556 2628
 [73] 2701 2775 2850 2926

回答1:

As I mentioned in the comment, writing something simple in Rcpp shouldn't be a big deal even for someone like myself. Here's a very primitive implementation that seem to work (Thanks to @ MatthewLundberg for the improvements suggestions)

library(Rcpp)
cppFunction('NumericVector cumsumCPP(NumericVector x, int y = 0){

    // y = 0 is the default
    // Need to do this in order to avoid modifying the original x
    int n = x.size();
    NumericVector res(n);
    res[0] = x[0];

    for (int i = 1 ; i < n ; i++) {
      res[i] = res[i - 1] + x[i];
      if (res[i] > y && (y != 0)) { 
        // This breaks the loop if condition met
        return res[seq(0, i - 1)];
      }
    }

    // This handles cases when y== 0 OR y != 0 and y > cumsum(res)
    return res;
}')

cumsumCPP(1:100, 3000)
#  [1]    1    3    6   10   15   21   28   36   45   55   66   78   91  105  120  136  153  171  190  210  231  253  276  300
# [25]  325  351  378  406  435  465  496  528  561  595  630  666  703  741  780  820  861  903  946  990 1035 1081 1128 1176
# [49] 1225 1275 1326 1378 1431 1485 1540 1596 1653 1711 1770 1830 1891 1953 2016 2080 2145 2211 2278 2346 2415 2485 2556 2628
# [73] 2701 2775 2850 2926

Similarly to base Rs cumsum, this works for both integers and floats and doesn't handles NAs. The default value for the treshhold was set to 0 - which is not ideal if you want to limit a negative cumsum, but I couldn't think of any better value for now (you can decide on one by yourself).

Though it could use some optimization...

set.seed(123)
x <- as.numeric(sample(1:1e3, 1e7, replace = TRUE))
microbenchmark::microbenchmark(cumsum(x), cumsumCPP(x))
# Unit: milliseconds
#         expr      min        lq      mean   median        uq       max neval cld
#    cumsum(x) 58.61942  61.46836  72.50915  76.7568  80.97435  99.01264   100  a 
# cumsumCPP(x) 98.44499 100.09979 110.45626 112.1552 119.22958 131.97619   100   b

identical(cumsum(x), cumsumCPP(x))
## [1] TRUE

回答2:

We can use <= on the cumsum output

v1[v1 <=3000]

Or another option is

setdiff(pmin(cumsum(1:100), 3000), 3000)

where

v1 <- cumsum(1:100)

来源：https://stackoverflow.com/questions/42328945/breaking-cumsum-function-at-some-threshold-in-r

标签

cumsum