R有效地填充向量

R有效地填充向量,r,loops,R,Loops,我有一个相当大的向量(>500000长度)。它包含一组NA和1,并且始终保证以1开头 基于对另一个向量v2(与v1长度相同)的相邻索引的比较操作,我想将v1中的一些NA替换为1 有没有一种有效的方法在矢量化表示法中实现这一点,以便在低级别实现中完成循环?可能使用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,

我有一个相当大的向量(>500000长度)。它包含一组
NA
1
,并且始终保证以
1
开头

基于对另一个向量
v2
(与
v1
长度相同)的相邻索引的比较操作,我想将
v1
中的一些
NA
替换为
1

有没有一种有效的方法在矢量化表示法中实现这一点,以便在低级别实现中完成循环?可能使用
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

v1矢量化解决方案如下所示:

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

v1[-1]可能不会更快,但可能有更快的解决方案,但这是我在几分钟内能想到的最好的解决方案。对于小矢量,我的解决方案比OPs慢,但对于大矢量,我的解决方案会越来越快

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
library(zoo)#为na.locf
图书馆(rbenchmark)

v1使用编译器包可以大大加快fun1函数的速度。 使用Joshua提供的代码,并使用编译器包对其进行扩展:

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))

因此,编译后的fun1比原来的fun1快得多,但仍然比fun2慢。

你能提供一个v2的例子吗?例如…@JoshuaUlrich我用一个可复制的例子编辑了我的原始帖子。复制粘贴应该有效,谢谢。您的可复制示例与您在
v1
v2
上运行的初始不可复制示例不同。哪一个包含您想要的输出?@JoshuaUlrich可复制的示例是正在考虑的问题,很抱歉造成混淆——初始不可复制包含了问题的本质,但不是精确的规格可能重复的
fun3
fun2
的编译版本,而不是
fun1
。在我的示例中,
fun1
的编译版本仍然比
fun2
@Joshua慢约2倍。愚蠢的错误。fun1的编译版本的速度几乎是fun2的两倍,比原来的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