優化軋製功能與基於時間的窗口

Question

有一些方法來rollapply使用（從zoo包或類似的東西）進行了優化函數（rollmean，rollmedian等）來計算與基於時間的窗口的滾動的功能，而不是一個基於一些觀察？我想要的很簡單：對於不規則時間序列中的每個元素，我想要計算具有N天窗口的滾動函數。也就是說，該窗口應包括在當前觀測之前N天的所有觀測值。時間序列也可能包含重複項。

下面是一個例子。考慮下面的時間序列：

 date value 
1/11/2011  5 
1/11/2011  4 
1/11/2011  2 
8/11/2011  1 
13/11/2011  0 
14/11/2011  0 
15/11/2011  0 
18/11/2011  1 
21/11/2011  4 
5/12/2011  3 

的滾動平均有5天的窗口，右對齊，應該產生以下計算：

> c(
    median(c(5)), 
    median(c(5,4)), 
    median(c(5,4,2)), 
    median(c(1)), 
    median(c(1,0)), 
    median(c(0,0)), 
    median(c(0,0,0)), 
    median(c(0,0,0,1)), 
    median(c(1,4)), 
    median(c(3)) 
    ) 

[1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0 

我已經找到了一些解決方案，在那裏，但他們通常很棘手，通常意味着緩慢。我設法實現了我自己的滾動函數計算。問題在於，對於很長的時間系列，中值（rollmedian）的優化版本會產生巨大的時間差，因爲它考慮到了窗口之間的重疊。我想避免重新實現它。我懷疑有一些關於rollapply參數的技巧可以使它工作，但我無法弄清楚。先謝謝您的幫助。

Answer 1

這是我的修補問題。如果能達到你想要的水平（我不知道它在速度方面是否令人滿意），我可以把它寫成更詳細的答案（儘管它基於@ rbatt的想法）。

library(zoo) 
library(dplyr) 

# create a long time series 
start <- as.Date("1800-01-01") 
end <- as.Date(Sys.Date()) 

df <- data.frame(V1 = seq.Date(start, end, by = "day")) 
df$V2 <- sample(1:10, nrow(df), replace = T) 

# make it an irregular time series by sampling 10000 rows 
# including allowing for duplicates (replace = T) 
df2 <- df %>% 
    sample_n(10000, replace = T) 

# create 'complete' time series & join the data & compute the rolling median 
df_rollmed <- data.frame(V1 = seq.Date(min(df$V1), max(df$V1), by = "day")) %>% 
    left_join(., df2) %>% 
    mutate(rollmed = rollapply(V2, 5, median, na.rm = T, align = "right", partial = T)) %>% 
    filter(!is.na(V2)) # throw out the NAs from the complete dataset 

Answer 2

有沒有檢查的速度，但如果沒有日期已超過max.dup OCCURENCES那麼它必須是最後一個5個* max.dup條目包含的最後5天，以便單行功能fn圖所示傳遞到rollapplyr將做到這一點：

k <- 5 

dates <- as.numeric(DF$date) 
values <- DF$value 

max.dup <- max(table(dates)) 

fn <- function(ix, d = dates[ix], v = values[ix], n = length(ix)) median(v[d >= d[n]-k]) 

rollapplyr(1:nrow(DF), max.dup * k, fn, partial = TRUE) 
## [1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0 

注：我們用它進行DF：

Lines <- " 
     date value 
1/11/2011  5 
1/11/2011  4 
1/11/2011  2 
8/11/2011  1 
13/11/2011  0 
14/11/2011  0 
15/11/2011  0 
18/11/2011  1 
21/11/2011  4 
5/12/2011  3 
" 
DF <- read.table(text = Lines, header = TRUE) 
DF$date <- as.Date(DF$date, format = "%d/%m/%Y") 

Answer 3

我們可以做到這一點只使用基本應用如下：

首先建立數據（通過基於筆記@ G-格羅騰迪克）

library(data.table) 
Lines <- " 
     date value 
1/11/2011  5 
1/11/2011  4 
1/11/2011  2 
8/11/2011  1 
13/11/2011  0 
14/11/2011  0 
15/11/2011  0 
18/11/2011  1 
21/11/2011  4 
5/12/2011  3 
" 
DT <- as.data.table(read.table(text = Lines, header = TRUE)) 
DT$date <- as.Date(DF$date, format = "%d/%m/%Y") 
DT$row <- 1:NROW(DF) 
setkey(DT, row, date) #mark columns as sorted, for speed 

注意，我添加了一個向量數據表包含行號，以便我們可以將行號傳遞給apply函數。我還使用數據表來簡化下一步的語法，並在應用於大型數組時加快函數的速度。現在，我們使用apply如下：

roll.median.DT <- function(x){ 
    this.date <- as.Date(x[1]) 
    this.row <- as.numeric(x[3]) 
    median(DT[row <= this.row & date >= (this.date-5)]$value) #NB DT is not defined within function, so it is found from parent scope 
} 
apply(DT, FUN=roll.median.DT, MARGIN = 1) 
[1] 5.0 4.5 4.0 1.0 0.5 0.0 0.0 0.0 2.5 3.0 

Answer 4

大多數答案建議插入NA以使時間序列正常。 但是，在長時間序列的情況下，這可能會很慢。此外，它不適用於NA無法使用的功能。

rollapply（動物園包）的寬度參數可以是一個列表（詳情請參閱rollapply的幫助）。基於此，我編寫了一個函數，它創建一個與rollapply一起使用的列表作爲width參數。如果移動窗口是時間而不是基於索引，則函數爲不規則動物園對象提取索引。因此動物園對象的索引應該是實際的時間。

# Create a zoo object where index represents time (e.g. in seconds) 

d <- zoo(c(1,1,1,1,1,2,2,2,2,2,16,25,27,27,27,27,27,31),  
     c(1:5,11:15,16,25:30,31)) 

# Create function 

createRollapplyWidth = function(zoodata, steps, window){ 

    mintime = min(time(zoodata))  

    maxtime = max(time(zoodata)) 

    spotstime = seq(from = mintime , to = maxtime, by = steps) 

    spotsindex = list() 

    for (i in 1:length(spotstime)){ 
    spotsindex[[i]] = as.numeric(which(spotstime[i] <= time(zoodata) & time(zoodata) < spotstime[i] + window))} 

    rollapplywidth = list() 
    for (i in 1:length(spotsindex)){ 
    if (!is.na(median(spotsindex[[i]]))){ 
     rollapplywidth[[round(median(spotsindex[[i]]))]] = spotsindex[[i]] - round(median(spotsindex[[i]]))} 
    } 
    return(rollapplywidth) 
    } 


# Create width parameter for rollapply using function 

rollwidth = createRollapplyWidth(zoodata = d, steps = 5, window = 5) 

# Use parameter in rollapply 

result = rollapply(d, width = rollwidth , FUN = sum, na.rm = T) 
result 

限制：不基於過時但以秒爲單位。參數「部分」rollapply不起作用。