R有效地填充矢量

Question

我有一個相當大的矢量（長度> 500,000）。它包含一串穿着1的NA，始終保證它始於1。

我想與1替換一些NA在v1，基於（作爲v1相同長度的）另一矢量v2的連續指標的比較操作。

有沒有一種有效的方法來做到這一點在向量化的符號，以便循環是在低級別的實現？也許使用ifelse？

重現下面的例子：

v1<-c(1,NA,NA,NA,1,NA,NA,NA,NA,NA,1,NA,NA,1,NA,1,NA,NA,NA,NA,NA,NA,NA,NA,NA,1) 
v2<-c(10,10,10,9,10,9,9,9,9,9,10,10,10,11,8,12,12,12,12,12,12,12,12,12,12,13) 
# goal is to fill through v1 in such a way that whenever 
# v1[i] == NA and v1[i-1] == 1 and v2[i] == v2[i-1], then v1[i] == 1 
MM<-data.frame(v1,v2) 
for (i in 2:length(v1)){ 
    # conditions: v1[i-1] == 1; v1[i]==NA; v2[i]==v2[i-1] 
    if (!is.na(v1[i-1]) && is.na(v1[i]) && v2[i]==v2[i-1]){ 
     v1[i]<-1 
    } 
} 
MM$v1_altered<-v1 
MM 

Answer 1

一個向量化的解決辦法是這樣的：

v1[-1] <- ifelse(diff(v2), 0, v1[-length(v1)]) 

但上面不會有工作，我不認爲你能避免因爲外在的循環如果我理解正確，你想傳播新的值。那麼，怎麼樣：

cmp <- diff(v2) 
for (i in 2:length(v1)){ 
    v1[i] <- if(cmp[i-1]) 0 else v1[i-1] 
} 

Answer 2

它可能不是更快，但v1[i] <- v1[i-1] * (cmp[i-1] == 0)避免了所有明確的「如果」的電話。我現在無法測試它，但是您可以嘗試使用@James解決方案與循環遍歷此表單，例如1e4長度的矢量以查看哪個更快。

Answer 3

這可能是一個更快的解決方案，但這是我能在幾分鐘內完成的最好的解決方案。我的解決方案比小矢量的OP要慢，但對於更大的矢量來說，它的速度越來越快。

library(zoo) # for na.locf 
library(rbenchmark) 

v1<-c(1,NA,NA,NA,1,NA,NA,NA,NA,NA,1,NA,NA,1,NA,1,NA,NA,NA,NA,NA,NA,NA,NA,NA,1) 
v2<-c(10,10,10,9,10,9,9,9,9,9,10,10,10,11,8,12,12,12,12,12,12,12,12,12,12,13) 
V1 <- rep(v1, each=20000) # 520,000 observations 
V2 <- rep(v2, each=20000) # 520,000 observations 

fun1 <- function(v1,v2) { 
    for (i in 2:length(v1)){ 
    if (!is.na(v1[i-1]) && is.na(v1[i]) && v2[i]==v2[i-1]){ 
     v1[i]<-1 
    } 
    } 
    v1 
} 
fun2 <- function(v1,v2) { 
    # create groups in which we need to assess missing values 
    d <- cumsum(as.logical(c(0,diff(v2)))) 
    # for each group, carry the first obs forward 
    ave(v1, d, FUN=function(x) na.locf(x, na.rm=FALSE)) 
} 
all.equal(fun1(V1,V2), fun2(V1,V2)) 
# [1] TRUE 
benchmark(fun1(V1,V2), fun2(V1,V2)) 
#   test replications elapsed relative user.self sys.self 
# 1 fun1(V1, V2)   100 194.29 6.113593 192.72  0.17 
# 2 fun2(V1, V2)   100 31.78 1.000000  30.74  0.95 

Answer 4

函數fun1可以通過使用編譯器包顯着提高。 使用由約書亞提供的代碼，並與編譯包擴展它：

library(zoo) # for na.locf 
library(rbenchmark) 
library(compiler) 

v1 <- c(1,NA,NA,NA,1,NA,NA,NA,NA,NA,1,NA,NA,1,NA,1,NA,NA,NA,NA,NA,NA,NA,NA,NA,1) 
v2 <- c(10,10,10,9,10,9,9,9,9,9,10,10,10,11,8,12,12,12,12,12,12,12,12,12,12,13) 

fun1 <- function(v1,v2) { 
    for (i in 2:length(v1)){ 
     if (!is.na(v1[i-1]) && is.na(v1[i]) && v2[i]==v2[i-1]){ 
      v1[i]<-1 
     } 
    } 
    v1 
} 

fun2 <- function(v1,v2) { 
    # create groups in which we need to assess missing values 
    d <- cumsum(as.logical(c(0,diff(v2)))) 
    # for each group, carry the first obs forward 
    ave(v1, d, FUN=function(x) na.locf(x, na.rm=FALSE)) 
} 

fun3 <- cmpfun(fun1) 

fun1(v1,v2) 
fun2(v1,v2) 
all.equal(fun1(v1,v2), fun2(v1,v2)) 
all.equal(fun1(v1,v2), fun3(v1,v2)) 

Nrep <- 1000 

V1 <- rep(v1, each=Nrep) 
V2 <- rep(v2, each=Nrep) 
all.equal(fun1(V1,V2), fun2(V1,V2)) 
all.equal(fun1(V1,V2), fun3(V1,V2)) 

benchmark(fun1(V1,V2), fun2(V1,V2), fun3(V1,V2)) 

我們得到以下結果

benchmark(fun1(V1,V2), fun2(V1,V2), fun3(V1,V2)) 
      test replications elapsed relative user.self sys.self user.child 
1 fun1(V1, V2)   100 12.252 5.706567 12.190 0.045   0 
2 fun2(V1, V2)   100 2.147 1.000000  2.133 0.013   0 
3 fun3(V1, V2)   100 3.702 1.724266  3.644 0.023   0 

所以編譯FUN1是很多比原來FUN1快，但仍然比慢FUN2。