Wektoryzacja pętli nad elementów wektorów

Question

trudno mi wymyślić szybkiego rozwiązania następującego problemu:

Mam wektor obserwacji, który wskazuje czas obserwacji pewnych zjawisk.

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

Teraz chciałbym wyeliminować zer pomiędzy poszczególnymi obserwacji, biorąc pod uwagę, że zakłada się pewien fenomen, aby kontynuować aż do sprzecznych obserwacji zauważyć, tzn jeśli „” 1 „” zaobserwowano w trzeciej obserwacji, ja chciałby mieć tylko "1" do 11 elementu, gdy pierwszy "-1" jest obserwowany. Więc moja pożądane wyjście wygląda następująco:

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 

My lame rozwiązaniem jest

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; 
     } 
    } 
} 

Będę wdzięczni za każdą pomoc w przyspieszeniu tego.

Answer 1

Postaram się być jednym zaoferować czystego roztworu 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: może być szybciej obliczyć mch powyżej

mch = findInterval(cs-1,cs)+1 

UPD2: Lubię odpowiedź przez @Roland. Można go skrócić do dwóch linii:

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

Answer 2

Jestem pewien, że ktoś podejdzie rozwiązanie lepsze czystego-R, ale moja pierwsza próba jest wykorzystanie tylko 1 pętlę w następujący sposób:

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 

Powyższy łatwo przekłada się na skuteczne kodu 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 

Niektóre punkty odniesienia:

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 

Answer 3

podejrzewam, że 0 wartości są w rzeczywistości wartościami NA. Tu ich NA i nie używać na.locf (Last Observation Carried Forward) z pakietu zoo:

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