Vettorizzazione ciclo su elementi del vettore

Question

I trovare difficile trovare una soluzione veloce per il seguente problema:

Ho un vettore di osservazioni, che indica il tempo di osservazione di certi fenomeni.

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

Ora desidero eliminare zeri tra determinate osservazioni, dato che un certo fenomeno si presume continuerà finché si nota un'osservazione contraddittorio, cioè, se '' 1 '' stata osservata in terza osservazione, I vorrebbe avere solo '' 1 '' fino all'undicesimo elemento, quando viene osservato il primo '' -1 ''. Quindi il mio output desiderato assomiglia:

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 

La mia soluzione è zoppo

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

Io apprezzo di aiuto con accelerare questo.

Answer 1

Cercherò di essere quello di offrire una soluzione R pura:

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: può essere più veloce per calcolare mch sopra con

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

UPD2: mi piace la risposta @Roland. Può essere abbreviato in due righe:

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

Answer 2

Sono abbastanza sicuro che qualcuno si avvicinerà una soluzione migliore pura-R, ma il mio primo tentativo è quello di utilizzare solo 1 ciclo come segue:

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 

Il codice di cui sopra si traduce facilmente ad un efficace 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 

Alcuni parametri di riferimento:

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

ho il sospetto che il vostro 0 i valori sono in realtà valori NA. Qui li faccio NA e che utilizzano na.locf (Last Observation Carried Forward) dal pacchetto di 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