2016-09-15 56 views
2

我有一系列如下 -檢測最後非零值在滾動窗口

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函數,但沒有出現。

幫助讚賞。謝謝。

回答

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 
+0

你好,。謝謝回覆。有用。但我自己寫了一個函數,我也會在這裏發表,這更簡潔一點。 – prateek1592

+0

邏輯是一樣的,很高興你能解決它。在將來的簡單窗口操作中,請注意'rollapply' – OdeToMyFiddle

+0

是的。並且會做!謝謝 :-) – prateek1592

0

我寫了解決問題的這個小功能:

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)