Điền NA trong một chuỗi thời gian chỉ với một số giới hạn

Question

Có cách nào chúng tôi có thể điền NA s trong đối tượng zoo hoặc xts với số lượng giới hạn NA giây về phía trước. Nói cách khác, hãy điền vào NA s tối đa 3 liên tiếp NA s và sau đó giữ NA s từ giá trị thứ 4 cho đến khi số hợp lệ.

Điều gì đó tương tự.

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 

đầu ra mong muốn, sẽ là một cái gì đó với biến n = 3 là

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 

Tôi đã thử rất nhiều sự kết hợp với na.locf(x, maxgap = 3) vv mà không có nhiều thành công. Tôi có thể tạo ra một vòng lặp để có được sản lượng mong muốn, tôi đã tự hỏi liệu có cách vectorized để đạt được điều này.

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

Cảm ơn

Answer 1

Dưới đây là một cách khác:

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 

chỉnh sửa: câu trả lời trước của tôi yêu cầu rằng x không có bản sao. Câu trả lời hiện tại thì không.

chuẩn

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

Nếu không sử dụng na.locf, nhưng ý tưởng là để chia XTS của bạn bằng cách nhóm các giá trị phi mất tích, sau đó cho từng nhóm thay thế chỉ có 3 giá trị đầu tiên (sau khi phi misssing một) với giá trị đầu tiên. Nó là một vòng lặp, nhưng vì nó chỉ được áp dụng trên nhóm, nên nó nhanh hơn một vòng lặp đơn giản trên tất cả các giá trị.

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

Và một ý kiến ​​cho rằng, trừ khi tôi đã bỏ lỡ một cái gì đó, có vẻ hợp lệ:

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