Fill NA in einer Zeitreihe nur zu einer begrenzten Anzahl

Question

Gibt es eine Möglichkeit, NA s in einem zoo oder xts Objekt mit einer begrenzten Anzahl von s Forward füllen. Mit anderen Worten wie füllen NA s bis zu 3 aufeinanderfolgende NA s, und dann halten Sie die NA s vom 4. Wert bis eine gültige Zahl.

So etwas wie das.

library(zoo) 
x <- zoo(1:20, Sys.Date() + 1:20) 
x[c(2:4, 6:10, 13:18)] <- NA 
x 

2014-09-20 2014-09-21 2014-09-22 2014-09-23 2014-09-24 2014-09-25 2014-09-26 
     1   NA   NA   NA   5   NA   NA 
2014-09-27 2014-09-28 2014-09-29 2014-09-30 2014-10-01 2014-10-02 2014-10-03 
     NA   NA   NA   11   12   NA   NA 
2014-10-04 2014-10-05 2014-10-06 2014-10-07 2014-10-08 2014-10-09 
     NA   NA   NA   NA   19   20 

gewünschte Ausgabe, wird etwas mit variabel sein n = 3 ist

2014-09-20 2014-09-21 2014-09-22 2014-09-23 2014-09-24 2014-09-25 2014-09-26 
     1   1   1  1   5   5  5 
2014-09-27 2014-09-28 2014-09-29 2014-09-30 2014-10-01 2014-10-02 2014-10-03 
     5   NA   NA   11   12   12  12 
2014-10-04 2014-10-05 2014-10-06 2014-10-07 2014-10-08 2014-10-09 
     12   NA   NA   NA   19   20 

ich viele Kombination versucht haben, mit na.locf(x, maxgap = 3) etc ohne viel Erfolg. Ich kann eine Schleife erstellen, um die gewünschte Ausgabe zu erhalten, ich habe mich gefragt, ob es eine vektorisierte Möglichkeit gibt, dies zu erreichen.

fillInTheBlanks <- function(v, n=3) { 
    result <- v 
    counter0 <- 1 
    for(i in 2:length(v)) { 
    value <- v[i] 
    if (is.na(value)) { 
     if (counter0 > n) { 
     result[i] <- v[i] 
     } else { 
     result[i] <- result[i-1] 
     counter0 <- counter0 + 1 
     } } 
    else { 
     result[i] <- v[i] 
     counter0 <- 1 
    } 
    } 
    return(result) 
} 

Dank

Answer 1

Hier ist eine andere Art und Weise:

l <- cumsum(! is.na(x)) 
c(NA, x[! is.na(x)])[replace(l, ave(l, l, FUN=seq_along) > 4, 0) + 1] 
# [1] 1 1 1 1 5 5 5 5 NA NA 11 12 12 12 12 NA NA NA 19 20 

bearbeiten: meine Antwort erforderlich, dass x keine Duplikate haben. Die aktuelle Antwort nicht.

Benchmarks

x <- rep(x, length.out=1e4) 

plourde <- function(x) { 
    l <- cumsum(! is.na(x)) 
    c(NA, x[! is.na(x)])[replace(l, ave(l, l, FUN=seq_along) > 4, 0) + 1] 
} 

agstudy <- function(x) { 
    unlist(sapply(split(coredata(x),cumsum(!is.na(x))), 
      function(sx){ 
      if(length(sx)>3) 
       sx[2:4] <- rep(sx[1],3) 
      else sx <- rep(sx[1],length(sx)) 
      sx 
      })) 
} 

microbenchmark(plourde(x), agstudy(x)) 
# Unit: milliseconds 
#  expr min  lq median  uq max neval 
# plourde(x) 5.30 5.591 6.409 6.774 57.13 100 
# agstudy(x) 16.04 16.249 16.454 17.516 20.64 100 

Answer 2

Ohne na.locf zu verwenden, aber die Idee ist Ihre xts durch Gruppe der nicht fehlenden Werte zu teilen, dann für jede Gruppe (nach dem nicht misssing one) mit der nur die drei ersten Werte ersetzen erster Wert Es ist eine Schleife, aber da sie nur auf Gruppen angewendet wird, sollte sie schneller als eine einfache Schleife über alle Werte sein.

zz <- 
unlist(sapply(split(coredata(x),cumsum(!is.na(x))), 
     function(sx){ 
     if(length(sx)>3) 
      sx[2:4] <- rep(sx[1],3) 
     else sx <- rep(sx[1],length(sx)) 
     sx 
     })) 
## create the zoo object since , the latter algorithm is applied only to the values 
zoo(zz,index(x)) 

2014-09-20 2014-09-21 2014-09-22 2014-09-23 2014-09-24 2014-09-25 2014-09-26 2014-09-27 2014-09-28 2014-09-29 2014-09-30 2014-10-01 2014-10-02 
     1   1   1   1   5   5   5   5   NA   NA   11   12   12 
2014-10-03 2014-10-04 2014-10-05 2014-10-06 2014-10-07 2014-10-08 2014-10-09 
     12   12   NA   NA   NA   19   20 

Answer 3

Und eine andere Idee, dass, wenn ich etwas verpasst haben, gültig scheint: Szenarien

na_locf_until = function(x, n = 3) 
{ 
    wnn = which(!is.na(x)) 
    inds = sort(c(wnn, (wnn + n+1)[which((wnn + n+1) < c(wnn[-1], length(x)))])) 
    c(rep(NA, wnn[1] - 1), 
    as.vector(x)[rep(inds, c(diff(inds), length(x) - inds[length(inds)] + 1))]) 
} 
na_locf_until(x) 
#[1] 1 1 1 1 5 5 5 5 NA NA 11 12 12 12 12 NA NA NA 19 20