L oop расчет с предыдущим значением не используется для в R

Question

Я начинающий программист R У меня проблемы с вычислением al oop с предыдущим значением, таким как рекурсия. Пример моих данных:

 dt <- data.table(a = c(0:4), b = c( 0, 1, 2, 1, 3))

И вычисленное значение 'c' это y [n] = (y [n-1] + b [n]) * a [n]. Начальное значение c равно 0. (c [1] = 0)

Я использовал для l oop, а код и результат приведены ниже.

dt$y <- 0
for (i in 2:nrow(dt)) {
  dt$y[i] <- (dt$y[i - 1] + dt$b[i]) * dt$a[i]
}

   a b  y
1: 0 0  0
2: 1 1  1
3: 2 2  6
4: 3 1 21
5: 4 3 96

Это результат - то, чего я хочу. Однако мои данные содержат более 1 000 000 строк и несколько столбцов, поэтому я пытаюсь найти другие способы, не используя для l oop. Я пытался использовать «Reduce ()», но он работает только с одним вектором (например, y [n] = y_ [n-1] + b [n]). Как показано выше, моя функция использует два вектора, a и b, поэтому я не могу найти решение.

Есть ли более эффективный способ быть быстрее без использования a для l oop, например, с помощью рекурсивная функция или какие-либо хорошие пакетные функции?

Answer 1

Можно использовать Rcpp, поскольку для этого рекурсивного уравнения легко кодировать на C ++:

library(Rcpp)
cppFunction("
NumericVector func(NumericVector b, NumericVector a) {
    int len = b.size();
    NumericVector y(len);

    for (int i = 1; i < len; i++) {
        y[i] = (y[i-1] + b[i]) * a[i];
    }

    return(y);
}
")
func(c( 0, 1, 2, 1, 3), c(0:4))
#[1]  0  1  6 21 96

временной код:

vec_length <- 1e7
dt <- data.frame(a=1:vec_length, b=1:vec_length, y=0)
y <- as.numeric(dt$y)
a <- as.numeric(dt$a)
b <- as.numeric(dt$b)

system.time(for (i in 2:length(y)) {
    y[i] <- (y[i - 1] + b[i]) * a[i]
})
#   user  system elapsed 
#  19.22    0.06   19.44 

system.time(func(b, a))
#   user  system elapsed 
#   0.09    0.02    0.09 

Answer 2

Вот базовое решение R.

1. Согласно информации от @ ThetaF C, указанием для ускорения является использование матрицы или вектора (вместо data.frame для data.table). Таким образом, перед вычислением df$y лучше выполнить следующую предварительную обработку, то есть

a <- as.numeric(df$a)
b <- as.numeric(df$b)

Затем у вас есть два подхода для получения df$y:

• написания вашей настраиваемой функции рекурсии

f <- function(k) {
  if (k == 1) return(0)
  c(f(k-1),(tail(f(k-1),1) + b[k])*a[k])
}

df$y <- f(nrow(df))

• Или не -рекурсивная функция (думаю, это будет намного быстрее, чем рекурсивный подход)

g <- Vectorize(function(k) sum(rev(cumprod(rev(a[2:k])))*b[2:k]))

df$y <- g(seq(nrow(df)))

, такой что

> df
  a b  y
1 0 0  0
2 1 1  1
3 2 2  6
4 3 1 21
5 4 3 96

Answer 3

Этот вид вычислений не может использовать преимущество векторизации R из-за итеративных зависимостей. Но замедление, похоже, действительно связано с индексированием производительности на data.frame или data.table.

Интересно, что мне удалось значительно ускорить l oop, открыв a, b и y непосредственно как цифры c vectors (преимущество в 1000 раз больше для 2 * 10 ^ 5 строк) или matrix "столбцов" (преимущество в 100 раз больше для 2 * 10 ^ 5 строк) по сравнению со столбцами в data.table или data.frame.

Это старое обсуждение может все же пролить некоторый свет на этот довольно удивительный результат: https://stat.ethz.ch/pipermail/r-help/2011-July/282666.html

Обратите внимание, что я также сделал другую игрушку data.frame, поэтому я можно протестировать более крупный пример, не возвращая Inf при росте y с i:

Option data.frame (число c векторов, встроенных в data.frame или data.table для вашего примера) :

vec_length <- 200000
dt <- data.frame(a=seq(from=0, to=1, length.out = vec_length), b=seq(from=0, to=-1, length.out = vec_length), y=0)
system.time(for (i in 2:nrow(dt)) {
  dt$y[i] <- (dt$y[i - 1] + dt$b[i]) * dt$a[i]
})
#user  system elapsed 
#79.39  146.30  225.78
#NOTE: Sorry, I didn't have the patience to let the data.table version finish for vec_length=2*10^5.  
tail(dt$y)
#[1] -554.1953 -555.1842 -556.1758 -557.1702 -558.1674 -559.1674

Опция vector (numeric векторы, извлеченные до l oop):

vec_length <- 200000
dt <- data.frame(a=seq(from=0, to=1, length.out = vec_length), b=seq(from=0, to=-1, length.out = vec_length), y=0)
y <- as.numeric(dt$y)
a <- as.numeric(dt$a)
b <- as.numeric(dt$b)
system.time(for (i in 2:length(y)) {
  y[i] <- (y[i - 1] + b[i]) * a[i]
})
#user  system elapsed 
#0.03    0.00    0.03 
tail(y)
#[1] -554.1953 -555.1842 -556.1758 -557.1702 -558.1674 -559.1674

Опция matrix (data.frame, преобразованная в * 1038) * до l oop):

vec_length <- 200000
dt <- as.matrix(data.frame(a=seq(from=0, to=1, length.out = vec_length), b=seq(from=0, to=-1, length.out = vec_length), y=0))
system.time(for (i in 2:nrow(dt)) {
  dt[i, 1] <- (dt[i - 1, 3] + dt[i, 2]) * dt[i, 1]
})
#user  system elapsed 
#0.67    0.01    0.69
tail(dt[,3])
#[1] -554.1953 -555.1842 -556.1758 -557.1702 -558.1674 -559.1674
#NOTE: a matrix is actually a vector but with an additional attribute (it's "dim") that says how the "matrix" should be organized into rows and columns

Опция data.frame с индексированием в матричном стиле:

vec_length <- 200000
dt <- data.frame(a=seq(from=0, to=1, length.out = vec_length), b=seq(from=0, to=-1, length.out = vec_length), y=0)
system.time(for (i in 2:nrow(dt)) {
    dt[i, 3] <- (dt[(i - 1), 3] + dt[i, 2]) * dt[i, 1]
})
#user  system elapsed 
#110.69    0.03  112.01 
tail(dt[,3])
#[1] -554.1953 -555.1842 -556.1758 -557.1702 -558.1674 -559.1674

Answer 4

Я не думаю, что это будет быстрее, но вот один из способов сделать это без явного l oop

dt[, y := purrr::accumulate2(a, b, function(last, a, b) (last + b)*a
                             , .init = 0)[-1]]

dt      
#    a b  y
# 1: 0 0  0
# 2: 1 1  1
# 3: 2 2  6
# 4: 3 1 21
# 5: 4 3 96