は、私は以下のように一連の持っているウィンドウ

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関数を見つけようとしましたが、何も出ませんでした。

ヘルプありがとうございます。ありがとう。 lapplyとカスタム機能を使用して

Answer 1

は、あなたも同様の機能

#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

ためrollapplyで見ることができる私は、問題を解決し、この小さな関数を書いた：

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)