過濾掉數據有限的滾動平均結果

Question

我正在嘗試計算時間序列的滾動平均值。 我對計算沒有任何問題，但是，查看結果，時間序列中的某些位置會根據一個或兩個被一長串缺失值包圍的值發生滾動平均值。 我希望滾動平均值僅在執行滾動平均值的時間范圍內大於 50% 的數據時出現。 如果只有不到 50% 的數據可用，則該索引的結果應為NaN 。

我寫了一些示例代碼來展示我想要完成的事情。

#Create example data
set.seed(12)
dat1=runif(20,min=0,max=10)
dat2=dat1
ind=which(dat2 %in% sample(dat2,5))
#in this case ind=c(4, 7, 8, 13, 16)
dat2[ind]=NA

dat3=dat1
ind2=which(dat3 %in% sample(dat3,12))
#in this case ind2=c(2, 5, 7, 8, 9, 10, 11, 12, 13, 14, 17, 18)
dat3[ind2]=NA

#create a time series
now <- Sys.time()
tseq <- seq(from = now, length.out = 20, by = "mins")

#data in zoo format
dat1=zoo(dat1,tseq)
dat2=zoo(dat2,tseq)
dat3=zoo(dat3,tseq)

#rolling mean using roll apply
dat1rollmean=rollapply(dat1,width=5,align='center',FUN=function(x) mean(x,na.rm=T))
dat2rollmean=rollapply(dat2,width=5,align='center',FUN=function(x) mean(x,na.rm=T))
dat3rollmean=rollapply(dat3,width=5,align='center',FUN=function(x) mean(x,na.rm=T))

#doesn't work
dat3newrollmean=rollmean(dat3,5)

#desired rolling mean result
dat2des=dat2rollmean
dat2des[4]=NaN

dat3des=dat3rollmean
dat3des[c(4:14)]=NaN

在這個例子中，dat1 是一個完整的數據集，我的 rollapply (width of 5) function 運行良好，dat2 和 dat3 有不同程度的缺失數據。 在這種情況下，我希望我的結果用NaN替換對少於 2 個數據點執行 rollapply 的任何點。 那將是dat3rollmean的索引 4 和dat2rollmean的索引 4-14。 我將如何編寫 function 來查找這些數據不足的實例並將生成的滾動平均結果替換為NaN ？

Answer 1

使用下面定義Mean ：

Mean <- function(x) if (sum(is.na(x)) < length(x) / 2) mean(x, na.rm = TRUE) else NaN

res1 <- rollapply(dat1, 5, Mean)
identical(res1, dat1rollmean)
## [1] TRUE

res2 <- rollapply(dat2, 5, Mean)
identical(res2, dat2des)
## [1] TRUE

res3 <- rollapply(dat3, 5, Mean)
identical(res3, dat3des)
## [1] TRUE