2016-09-15 2 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 일 동안의 마지막 0이 아닌 값으로 출력됩니다.

TTR 패키지에서 runxxx 함수를 찾으려고했지만 아무 것도 나왔습니다.

감사합니다. 감사. lapply 및 사용자 정의 기능을 사용

답변

1

, 당신은 또한 유사한 기능을 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) 
관련 문제