矢量循环在矢量元素

时间:2014-06-11 08:15:58

标签: r loops vector vectorization

我发现很难找到解决以下问题的快速解决方案:

我有一个观察矢量,它表示观察某些现象的时间。

example <- c(0,0,0,1,0,1,1,0,0,0,-1,0,0,-1,-1,0,0,1,0,0);

现在我想在特定观察之间消除零,因为假定某种现象持续到注意到一个矛盾的观察,即, 如果&#39; 1&#39;&#39;在第三次观察中观察到,我希望只有&#39; 1&#39;&#39;&#39;最多11个元素,当第一个&#39;&#39; -1&#39;&#39;观察到了。所以我想要的输出如下:

desired.output <- c(0,0,0,1,1,1,1,1,1,1,-1,-1,-1,-1,-1,-1,-1,1,1,1);

> print(cbind(example, desired.output))
      example desired.output
 [1,]       0              0
 [2,]       0              0
 [3,]       0              0
 [4,]       1              1
 [5,]       0              1
 [6,]       1              1
 [7,]       1              1
 [8,]       0              1
 [9,]       0              1
[10,]       0              1
[11,]      -1             -1
[12,]       0             -1
[13,]       0             -1
[14,]      -1             -1
[15,]      -1             -1
[16,]       0             -1
[17,]       0             -1
[18,]       1              1
[19,]       0              1
[20,]       0              1

我的蹩脚解决方案是

for (i in 1:length(example)){
     if (example[i] != 0){
       current <- example[i];
       while ((example[i] != -current) & (i <= length(example))){
         example[i] <- current;
         i <- i+1;
       }
    }
}

我将非常感谢您加快速度。

3 个答案:

答案 0 :(得分:10)

我会尝试成为提供纯R解决方案的人:

example <- c(0,0,0,1,0,1,1,0,0,0,-1,0,0,-1,-1,0,0,1,0,0);

cs = cumsum(example!=0);
mch = match(cs, cs);
desired.output = example[mch];

print(cbind(example,desired.output))

UPD:使用

计算mch以上可能会更快
mch = findInterval(cs-1,cs)+1

UPD2:我喜欢@Roland的回答。它可以缩短为两行:

NN = (example != 0);
desired.output = c(example[1], example[NN])[cumsum(NN) + 1L];

答案 1 :(得分:7)

我很确定有人会接近更好的纯R解决方案,但我的第一个尝试是只使用1个循环如下:

x <- c(0,0,0,1,0,1,1,0,0,0,-1,0,0,-1,-1,0,0,1,0,0)

last <- x[1]
for (i in seq_along(x)) {
   if (x[i] == 0) x[i] <- last
   else last <- x[i] 
}

x
## [1]  0  0  0  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1  1  1  1

以上容易转换为有效的C ++代码:

Rcpp::cppFunction('
NumericVector elimzeros(NumericVector x) {
   int n = x.size();
   NumericVector y(n);
   double last = x[0];
   for (int i=0; i<n; ++i) {
      if (x[i] == 0)
         y[i] = last;
      else
         y[i] = last = x[i];
   }
   return y;
}
')

elimzeros(x)
## [1]  0  0  0  1  1  1  1  1  1  1 -1 -1 -1 -1 -1 -1 -1  1  1  1

一些基准:

set.seed(123L)
x <- sample(c(-1,0,1), replace=TRUE, 100000)
# ...
microbenchmark::microbenchmark(
   gagolews(x),
   gagolews_Rcpp(x),
   Roland(x),
   AndreyShabalin_match(x),
   AndreyShabalin_findInterval(x),
   AndreyShabalin_cumsum(x),
   unit="relative"
)
## Unit: relative
##                            expr        min         lq     median         uq        max neval
##                     gagolews(x) 167.264538 163.172532 162.703810 171.186482 110.604258   100
##                gagolews_Rcpp(x)   1.000000   1.000000   1.000000   1.000000   1.000000   100
##                       Roland(x)  33.817744  34.374521  34.544877  35.633136  52.825091   100
##         AndreyShabalin_match(x)  45.217805  43.819050  44.105279  44.800612  58.375625   100
##  AndreyShabalin_findInterval(x)  45.191419  43.832256  44.283284  45.094304  23.819259   100
##        AndreyShabalin_cumsum(x)   8.701682   8.367212   8.413992   9.938748   5.676467   100

答案 2 :(得分:7)

我怀疑您的0值实际上是NA值。我在这里制作了NA,而不是使用包裹动物园中的na.locf(最后观察结果):

example <- c(0,0,0,1,0,1,1,0,0,0,-1,0,0,-1,-1,0,0,1,0,0)
res <- example
#res[res==0] <- NA
#the same but faster
res <- res/res*res
library(zoo)
res <- na.locf(res,  na.rm = FALSE)
res[is.na(res)] <- 0
cbind(example, res)
#       example res
#  [1,]       0   0
#  [2,]       0   0
#  [3,]       0   0
#  [4,]       1   1
#  [5,]       0   1
#  [6,]       1   1
#  [7,]       1   1
#  [8,]       0   1
#  [9,]       0   1
# [10,]       0   1
# [11,]      -1  -1
# [12,]       0  -1
# [13,]       0  -1
# [14,]      -1  -1
# [15,]      -1  -1
# [16,]       0  -1
# [17,]       0  -1
# [18,]       1   1
# [19,]       0   1
# [20,]       0   1