Wypełnij NA ​​w szeregu czasowym tylko do ograniczonej liczby

Question

Czy istnieje sposób na wypełnienie NA s w obiekcie zoo lub xts z ograniczoną liczbą następujących po sobie NA s. Innymi słowy, np. Wypełnij NA s aż do 3 kolejnych NA s, a następnie zachowaj NA s od czwartej wartości, aż do poprawnej liczby.

Coś takiego.

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 

pożądany wynik, będzie coś ze zmienną n = 3 jest

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 

Próbowałem wiele kombinacji z na.locf(x, maxgap = 3) etc bez większego sukcesu. Potrafię stworzyć pętlę, aby uzyskać pożądany wynik, zastanawiałem się, czy istnieje wektoryzowany sposób osiągnięcia tego.

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

Dzięki

Answer 1

Oto kolejny sposób:

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 

edit: wymagana moja poprzednia odpowiedź, że x nie mają duplikaty. Obecna odpowiedź nie.

benchmarki

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

bez użycia na.locf, ale idea jest podzielić XTS przez grupę non wartościami brakującymi, a następnie dla każdej grupy zastępując tylko 3 pierwsze wartości (po braku misssing jeden) z pierwsza wartość. Jest to pętla, ale ponieważ jest ona stosowana tylko w grupie, powinna być szybsza niż prosta pętla nad wszystkimi wartościami.

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

a inny pomysł, że jeśli Tęskniłam coś, wydaje się ważne:

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