Question

我有一个系列如下 -

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函数，但没有任何结果。

帮助表示感谢。感谢。

Answer 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

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

检测滚动窗口

2 个答案: