tối ưu hóa các chức năng cán trên các chuỗi thời gian bất thường với cửa sổ dựa trên thời gian

Question

Có cách nào để sử dụng các chức năng được tối ưu hóa (zoo hoặc một cái gì đó tương tự) (rollmean, rollmedian vv) để tính toán các chức năng cán với cửa sổ dựa trên thời gian của một dựa trên một số quan sát? Những gì tôi muốn là đơn giản: đối với mỗi phần tử trong một chuỗi thời gian bất thường, tôi muốn tính toán một chức năng cán với một cửa sổ N-ngày. Đó là, cửa sổ nên bao gồm tất cả các quan sát lên đến N ngày trước khi quan sát hiện tại. Chuỗi thời gian cũng có thể chứa các bản sao.

Dưới đây là ví dụ. Với chuỗi thời gian sau:

 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 

Một trung bình cán với một cửa sổ 5 ngày, liên kết ở bên phải, nên kết quả trong việc tính toán sau:

> 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 

Tôi đã tìm thấy một số giải pháp lên đó, nhưng chúng thường phức tạp, thường có nghĩa là chậm. Tôi đã cố gắng thực hiện tính toán chức năng cán của riêng mình. Vấn đề là trong một chuỗi thời gian rất dài, phiên bản được tối ưu hóa của trung bình (rollmedian) có thể tạo ra sự khác biệt lớn về thời gian, vì nó có tính đến sự chồng chéo giữa các cửa sổ. Tôi muốn tránh thực hiện lại nó. Tôi nghi ngờ có một số trick với các thông số rollapply mà sẽ làm cho nó hoạt động, nhưng tôi không thể tìm ra nó. Xin được cảm ơn trước về sự giúp đỡ.

Answer 1

Đây là vấn đề của tôi. Nếu loại đó đạt được những gì bạn muốn (tôi không biết nếu nó đạt yêu cầu về tốc độ), tôi có thể viết nó như một câu trả lời chi tiết hơn (mặc dù nó dựa trên ý tưởng của @ 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

Chưa kiểm tra tốc độ nhưng nếu không có ngày có hơn max.dup lần xuất hiện sau đó nó phải được rằng 5 * mục max.dup cuối cùng chứa 5 ngày qua nên một dòng chức năng fn hiển thị dưới đây thông qua để rollapplyr sẽ làm điều đó:

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 

Lưu ý: Chúng tôi sử dụng này cho 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

Chúng ta có thể làm được điều này cơ bản chỉ sử dụng được áp dụng như sau:

Đầu tiên thiết lập dữ liệu (dựa trên phiếu bằng @ g-Grothendieck)

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 

Lưu ý rằng tôi đã thêm một vector vào bảng dữ liệu chứa số hàng, để chúng tôi có thể chuyển số hàng vào hàm áp dụng. Tôi cũng đã sử dụng bảng dữ liệu để đơn giản hóa cú pháp cho bước tiếp theo và tăng tốc độ chức năng nếu nó được áp dụng cho các mảng lớn. Bây giờ, chúng tôi sử dụng áp dụng như sau:

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

Hầu hết các câu trả lời đều đề xuất chèn NA để làm cho chuỗi thời gian đều đặn. Tuy nhiên, điều này có thể chậm trong trường hợp chuỗi thời gian dài. Ngoài ra, nó không hoạt động cho các chức năng không thể sử dụng với NA.

Đối số chiều rộng của rollapply (gói sở thú) có thể là danh sách (xem trợ giúp của rollapply để biết chi tiết). Dựa trên điều này, tôi đã viết một hàm tạo danh sách được sử dụng với tham số chiều rộng là rollapply. Hàm này trích xuất các chỉ mục cho các đối tượng sở thú bất thường nếu cửa sổ chuyển động là thời gian và không dựa trên chỉ mục. Do đó chỉ số của đối tượng sở thú phải là thời gian thực tế.

# 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 

Giới hạn: không dựa trên ngày nhưng theo thời gian tính bằng giây. Tham số "một phần" của rollapply không hoạt động.