在 r 中的某个阈值处破坏 cumsum() 函数答案

【问题标题】：Breaking cumsum() function at some threshold in r在 r 中的某个阈值处破坏 cumsum() 函数
【发布时间】：2017-02-19 15:17:45
【问题描述】：

例如我有以下代码：

cumsum(1:100)

我想打破它，如果元素 i+1 将大于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 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

我想得到以下结果：

 [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

【问题讨论】：

我知道 R 中没有内置的东西。你可能很容易在 Rcpp 中写一些东西。

标签： r cumsum

【解决方案1】：

正如我在评论中提到的，即使对像我这样的人来说，用 Rcpp 写一些简单的东西也不应该是什么大不了的事。这是一个似乎可以工作的非常原始的实现（感谢@MatthewLundberg 的改进建议）

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

类似于基本 Rs cumsum，这适用于整数和浮点数，并且不处理 NAs。阈值的默认值设置为0 - 如果您想限制负值cumsum，这并不理想，但我现在想不出更好的值（您可以自己决定）。

虽然它可以使用一些优化...

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

【讨论】：

您可以通过将内部测试更改为if (y && res[i] > y)来删除外部“if”
@DavidArenburg 感谢您对我的答案的评论（使用基础 R）。你是对的 - 我完全错误地测试了它。已删除以免误入歧途！
@SimonJackson 无需删除您的答案。完全没问题（我们仍处于毫秒世界），我只是说你需要确保你的基准测试是正确的。例如，在某些情况下，您的实现会更好，在其他情况下，cumsum 会获胜——但while 循环仍然可能更节省内存等等。
我进行了一些较大的测试，但它变得慢得多（def 超出 ms 时间）。 Rcpp 是更好的方法。你的一个想法 - 会在x 上运行而不是创建res 加快速度吗？如果不出意外，内存效率会更高。
@SimonJackson，是的，它会，但它也会在全球环境中修改x，我们不希望这样。试试cppFunction('NumericVector test(NumericVector x){ NumericVector res = x; for (int i = 1 ; i < x.size() ; i++) {res[i] = res[i - 1] + x[i];}return res;}') ; x <- as.numeric(sample(10, replace = TRUE)) ; test(x) ; test(x)。我的一个朋友向我展示了 this 作为该主题的好读物。

【解决方案2】：

我们可以在cumsum 输出上使用<=

v1[v1 <=3000]

或者另一种选择是

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

在哪里

v1 <- cumsum(1:100)

【讨论】：