Ограниченная накопленная сумма?

r

896 просмотра

3 ответа

763 Репутация автора

Как я могу сделать кумулятивную сумму по вектору (например cumsum), но ограниченную так, чтобы суммирование никогда не опускалось ниже нижней границы или выше верхней границы?

Стандартная функция cumsum привела бы к следующему.

foo <- c(100, -200, 400, 200)
cumsum(foo)
# [1]  100 -100  300  500

Я ищу что-то такое же эффективное, как и базовая cumsumфункция. Я ожидаю, что результат будет выглядеть следующим образом.

cumsum.bounded(foo, lower.bound = 0, upper.bound = 500)
# [1]  100  0  400  500

Спасибо

Автор: Nick Allen Источник Размещён: 21.01.2014 03:32

Ответы (3)

12 плюса

38484 Репутация автора

Решение

Как уже упоминалось в комментариях, Rcppэто хороший путь.

cumsumBounded.cpp:

#include <Rcpp.h>
using namespace Rcpp;
// [[Rcpp::export]]                                                             
NumericVector cumsumBounded(NumericVector x, double low, double high) {
  NumericVector res(x.size());
  double acc = 0;
  for (int i=0; i < x.size(); ++i) {
    acc += x[i];
    if (acc < low)  acc = low;
    else if (acc > high)  acc = high;
    res[i] = acc;
  }
  return res;
}

Скомпилируйте и используйте новую функцию:

library(Rcpp)
sourceCpp(file="cumsumBounded.cpp")
foo <- c(100, -200, 400, 200)
cumsumBounded(foo, 0, 500)
# [1] 100   0 400 500
Автор: josliber Размещён: 21.01.2014 05:20

3 плюса

172283 Репутация автора

Вот пара чистых версий R Маловероятно, что он будет таким же быстрым, как C / C ++, но один из них может быть достаточно быстрым для ваших нужд и его будет проще поддерживать:

# 1 Reduce
cumsum.bounded <- function(x, lower.bound = 0, upper.bound = 500) {
    bsum <- function(x, y) min(upper.bound, max(lower.bound, x+y))
    if (length(x) > 1) Reduce(bsum, x, acc = TRUE) else x
}

# 2 for loop
cumsum.bounded2 <- function(x, lower.bound = 0, upper.bound = 500) {
   if (length(x) > 1) 
      for(i in  2:length(x)) x[i] <- min(upper.bound, max(lower.bound, x[i] + x[i-1]))
   x
}

Их может потребоваться немного улучшить, если xдлина равна 0 или 1, в зависимости от того, насколько строгие требования.

Автор: G. Grothendieck Размещён: 21.01.2014 07:07

3 плюса

763 Репутация автора

Я полагаю, это может сработать.

library ("Rcpp")

cumsum.bounded <- cppFunction(
    'NumericVector cumsum_bounded (NumericVector x, const double lower, const double upper) {

        double acc = 0;
        NumericVector result(x.size());

        for(int i = 0; i < x.size(); i++) {
            acc += x[i];

            if (acc < lower) acc = lower;
            if (acc > upper) acc = upper;

            result[i] = acc;
        }

        return result;
    }')
Автор: Nick Allen Размещён: 21.01.2014 07:56
Вопросы из категории :
32x32