检测滚动窗口中的最后一个非零值答案

【问题标题】：Detect last non-zero value in rolling window检测滚动窗口中的最后一个非零值
【发布时间】：2016-09-15 19:36:43
【问题描述】：

我有一个系列如下-

set.seed(107)

test <- as.xts(rep(0,1000),Sys.Date()-1:1000)
test[sample(1000,50)] <- abs(100 * (1+rnorm(50)))

我想做的是滚动输出这个系列中最新的非零值。

例如，将滚动周期设为 20 天。因此，对于每个日期，我希望输出为之前过去 20 天的最后一个非零值。

为此尝试从 TTR 包中找到一个 runxxx 函数，但没有任何结果。

帮助表示赞赏。谢谢。

【问题讨论】：

标签： r xts

【解决方案1】：

使用lapply 和自定义函数，您还可以查看rollapply 以获得类似的功能

#input
set.seed(107)

test <- as.xts(rep(0,1000),Sys.Date()-1:1000)
test[sample(1000,50)] <- abs(100 * (1+rnorm(50)))

#rolling calculations
lookbackPeriod = 20

rollNonZeroTS =
    do.call(rbind,lapply(1:nrow(test),function(x) { 
    #for rows < lookbackPeriod, return NA
    if(x < lookbackPeriod) {
    windowTS=xts(NA,as.Date(index(test[x]))) 
    return(windowTS)
    }else{
    #for each date create a rolling window of length equal to lookbackPeriod, here = 20
    windowTS=test[(x-lookbackPeriod):x];
    # subset for non zero values and choose last value
    windowTS=tail(windowTS[windowTS!=0],1); 
    #if all values are zero in rolling window, output NA else last value
    windowTS=xts(ifelse(length(windowTS)==0,NA,windowTS),as.Date(index(test[x])))
    return(windowTS)    
    }                                         
    } ))

输出

head(test,30)
                 # [,1]
# 2013-12-20 101.651499
# 2013-12-21   0.000000
# 2013-12-22   0.000000
# 2013-12-23   0.000000
# 2013-12-24   0.000000
# 2013-12-25   0.000000
# 2013-12-26   0.000000
# 2013-12-27   0.000000
# 2013-12-28   0.000000
# 2013-12-29 101.108912
# 2013-12-30   0.000000
# 2013-12-31   0.000000
# 2014-01-01   0.000000
# 2014-01-02   0.000000
# 2014-01-03   0.000000
# 2014-01-04   0.000000
# 2014-01-05   0.000000
# 2014-01-06   0.000000
# 2014-01-07   0.000000
# 2014-01-08   0.000000
# 2014-01-09   0.000000
# 2014-01-10   0.000000
# 2014-01-11   0.000000
# 2014-01-12   2.025981
# 2014-01-13   0.000000
# 2014-01-14   0.000000
# 2014-01-15   0.000000
# 2014-01-16   0.000000
# 2014-01-17  50.922346
# 2014-01-18   0.000000


head(rollNonZeroTS,30)
                # [,1]
# 2013-12-20         NA
# 2013-12-21         NA
# 2013-12-22         NA
# 2013-12-23         NA
# 2013-12-24         NA
# 2013-12-25         NA
# 2013-12-26         NA
# 2013-12-27         NA
# 2013-12-28         NA
# 2013-12-29         NA
# 2013-12-30         NA
# 2013-12-31         NA
# 2014-01-01         NA
# 2014-01-02         NA
# 2014-01-03         NA
# 2014-01-04         NA
# 2014-01-05         NA
# 2014-01-06         NA
# 2014-01-07         NA
# 2014-01-08 101.108912
# 2014-01-09 101.108912
# 2014-01-10 101.108912
# 2014-01-11 101.108912
# 2014-01-12   2.025981
# 2014-01-13   2.025981
# 2014-01-14   2.025981
# 2014-01-15   2.025981
# 2014-01-16   2.025981
# 2014-01-17  50.922346
# 2014-01-18  50.922346

【讨论】：

嗨，。谢谢回复。有用。不过我自己写了一个函数，这里也贴一下，简洁一点。
逻辑是一样的，很高兴你解决了。以后要注意rollapply 进行简单的窗口操作
是的。并且应该做！谢谢:-)

【解决方案2】：

我写了这个小函数来解决这个问题：

runLevel <- function(x,lagperiod){

  temp <- stats::lag(x,0:lagperiod)
  out <- x
  out[] <- apply(temp,1,function(x) {
    len <- length(x[x!=0])
    if (len>0) {
      head(x[x!=0],1)
    } else {NA}
  })

  return(out)

}

使用输入：

set.seed(107)

test <- as.xts(rep(0,1000),Sys.Date()-1:1000)
test[sample(1000,50)] <- abs(100 * (1+rnorm(50)))

runLevel(test,20)

【讨论】：