Detect последнего ненулевого значения в окне

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 дней до него.

Пробовал найти функцию runxxx из пакета TTR для этого, но ничего не получилось.

Помогите оценить. Благодарю.

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)