Заполните элементов рекурсивно после первого не-NA значения

Question

Пример данных:

>w 
    date   V1   V2   V3 
    1  1   NA   NA   NA 
    2  2   NA   NA   NA 
    3  3 -0.2357066   NA -0.5428883 
    4  4   NA   NA   NA 
    5  5   NA -0.4333103   NA 
    6  6   NA   NA   NA 
    7  7 -0.6494716 0.7267507 1.1519118 
    8  8   NA   NA   NA 
    9  9   NA   NA   NA 
    10 10   NA   NA   NA 

> r 
    date   V1   V2   V3 
1  1 1.262954285 0.7635935 -0.22426789 
2  2 -0.326233361 -0.7990092 0.37739565 
3  3 1.329799263 -1.1476570 0.13333636 
4  4 1.272429321 -0.2894616 0.80418951 
5  5 0.414641434 -0.2992151 -0.05710677 
6  6 -1.539950042 -0.4115108 0.50360797 
7  7 -0.928567035 0.2522234 1.08576936 
8  8 -0.294720447 -0.8919211 -0.69095384 
9  9 -0.005767173 0.4356833 -1.28459935 
10 10 2.404653389 -1.2375384 0.04672617 

Я пытаюсь заполнить w с помощью следующего правила: w(t+1) <- w(t)*r(t), но только после того, как значения первого не NA элемента , Эквивалент для цикла является:

for (i in 1:(nrow(w)-1)) { 
    for (j in 2:ncol(w)){ 
    if (is.na(w[i+1,j])) { 
     w[i+1,j] <- w[i,j]*r[i,j] 
    } 
    } 
} 

и дает:

> w 
    date   V1   V2   V3 
1  1   NA   NA   NA 
2  2   NA   NA   NA 
3  3 -0.235706556   NA -0.542888255 
4  4 -0.313442405   NA -0.072386744 
5  5 -0.398833307 -0.43331032 -0.058212660 
6  6 -0.165372814 0.12965300 0.003324337 
7  7 -0.649471647 0.72675075 1.151911754 
8  8 0.603077961 0.18330358 1.250710490 
9  9 -0.177739406 -0.16349234 -0.864183216 
10 10 0.001025054 -0.07123088 1.110129201 

Это немного похоже на cumprod, может быть, но я застрял. Можно ли избежать циклов for (или, по крайней мере, одного из них), чтобы ускорить работу?

данные могут быть воспроизведены:

set.seed(0) 
r <- as.data.frame(matrix(data = rnorm(30), nrow = 10, ncol = 3)) 
w <- as.data.frame(matrix(data = NA, nrow =10, ncol = 3)) 

w[3, c(1,3)] <- rnorm(2) 
w[5, 2] <- rnorm(1) 
w[7,] <- rnorm(ncol(w)) 
date <- 1:nrow(w) 
w <- cbind(date, w) 
r <- cbind(date, r) 

Answer 1

Если у вас есть несколько столбцов, вы можете заменить внутреннюю петлю, следуя data.table операции.

library(data.table) # v1.9.5 
fdt <- function(w, r){ 
    for (j in 2:ncol(w)){ 
    w[,j] <- data.table(x=r[, j], z=w[, j])[,ifelse(is.na(z), z[1L]*shift(cumprod(x)), z), cumsum(!is.na(z))][,V1] 
    } 
    w 
} 

Для фреймов данных с 100000 строк он занимает около 3 секунд на моем компьютере.

w <- do.call('rbind', lapply(1:10000, function(i)w)) 
r <- do.call('rbind', lapply(1:10000, function(i)r)) 
system.time(fdt(w, r)) 
#user system elapsed 
#2.923 0.004 2.928 

тогда, вложенная цикл занимает 200s

system.time(f(w, r)) 
# user system elapsed 
#206.406 0.043 206.559 

---

f <- function(w, r){ 
    for (i in 1:(nrow(w)-1)) { 
    for (j in 2:ncol(w)){ 
     if (is.na(w[i+1,j])) { 
     w[i+1,j] <- w[i,j]*r[i,j] 
     } 
    } 
    } 
    w 
} 

---

[Редактировать]

dplyr версия работает немного быстрее, чем fd.

library(dplyr) 
fdp <- function(w, r){  
    for (j in 2:ncol(w)){ 
    d <- data_frame(x=r[, j], z=w[, j]) %>% 
     group_by(cumsum(!is.na(z))) %>% 
     mutate(v=ifelse(is.na(z), z[1L]*lag(cumprod(x)), z)) 
    w[, j] <- d$v 
    }  
    w 
} 
system.time(fdp(w, r)) 
# user system elapsed 
# 2.458 0.008 2.467 

[Edit2]

на пару миллионов строк, data.table решение по-прежнему довольно медленно. Вы можете быстро улучшить ситуацию с помощью Rcpp.

Rcpp::cppFunction('NumericMatrix fill(NumericMatrix w, NumericMatrix r) { 
    for (int i = 0; i < w.nrow()-1; i++) { 
    for (int j = 0; j < w.ncol(); j++) { 
     if (NumericVector::is_na(w(i+1,j))) { 
     w(i+1,j) = w(i,j)*r(i,j); 
     } 
    }  
    } 
    return w; 
}') 

Для строк 1М требуется менее секунды.

system.time(fill(as.matrix(w[,-1]), as.matrix(r[,-1]))) 
# user system elapsed 
# 0.913 0.004 0.917 

Answer 2

Вот альтернативный подход:

library(zoo) 

cumprodsplit <- function(col, r, w){ 

    # fill the NAs 
    fill_w <- na.locf(w)[[col]] 

    # groups 
    f <- cumsum(!is.na(w[[col]])) 

    # split w 
    splits <- split(fill_w, f) 

    # generate the cumprods 
    cumprods <- lapply(split(r[[col]], f), 
          function(x) c(1, cumprod(x)[-length(x)])) 
        # multiply 
    vec <- mapply('*', splits, cumprods, SIMPLIFY = FALSE) 

        #unlist 
    setNames(data.frame(unlist(vec, use.names = FALSE)), col) 
} 


do.call("cbind", lapply(names(w)[-1], cumprodsplit, r, w)) 

      V1   V2   V3 
1   NA   NA   NA 
2   NA   NA   NA 
3 -0.235706556   NA -0.542888255 
4 -0.313442405   NA -0.072386744 
5 -0.398833307 -0.43331032 -0.058212660 
6 -0.165372814 0.12965300 0.003324337 
7 -0.649471647 0.72675075 1.151911754 
8 0.603077961 0.18330358 1.250710490 
9 -0.177739406 -0.16349234 -0.864183216 
10 0.001025054 -0.07123088 1.110129201