Запущенная дисперсия, когда временное окно не является постоянным

Question

Я пытаюсь вычислить скользящую дисперсию с окном, скажем, 4 года, для каждого из namesA, B а также C, Данные еженедельно:

> head(data1, 17)
         date name       value
1  1985-01-01    A -0.44008233
2  1985-01-01    B          NA #Observe that there are some NA's
3  1985-01-01    C  0.38682496
4  1985-01-08    A  0.41806540
5  1985-01-08    B -0.05460831
6  1985-01-08    C -0.52051435
7  1985-01-15    A  1.25769395
8  1985-01-15    B  0.80272053
9  1985-01-15    C -0.34501742
10 1985-01-22    A -0.43401839
11 1985-01-22    B  0.91113966
12 1985-01-22    C  1.07131717
13 1985-01-29    A -1.55395857
14 1985-01-29    B -0.43281709
15 1985-01-29    C  0.98034779
16 1985-02-05    A  1.70557396
17 1985-02-05    B  0.44688788

Мой подход до сих пор заключается в dcast данные, а затем запустить rollapply() (zoo) столбец с подвижным окном 192 = 4*12*4:

v <- dcast(data1, date ~ name, value.var = "value")
var <- rollapply(v[-1], width=4*12*4, var, fill=NA, by.column = T)
var <- cbind(v$date, var)
var[,1] <- as.Date(var[,1])

Однако я понял, что в течение нескольких месяцев у меня есть четыре наблюдения (например, 7, 14, 21, 28 февраля), а для некоторых у меня есть пять еженедельных наблюдений (например, 1, 8, 15, 22 и 29 января), поэтому с помощью окно 4 years * 12 months * 4 weeks наблюдения не верны. Я думал добавить эти дополнительные наблюдения в окно времени (width), но я не уверен, как (или если это вообще возможно), поскольку они меняются в зависимости от того, сколько 5-недельных наблюдений и сколько 4-недельных наблюдений происходит во временном окне.

Кроме того, я хотел бы иметь NA когда есть NA Наблюдения в движущемся временном окне (это обрабатывается автоматически var() во всяком случае, я думаю), а также я хотел бы игнорировать нулевые наблюдения. Для этого я подумал, что мог бы удалить нули перед запуском работающей дисперсионной функции, а затем каким-то образом вернуть их обратно. Таким образом, вы можете игнорировать эту часть, если, конечно, у вас нет хорошей идеи сделать это за один шаг.

Пример данных:

set.seed(486)
date <- rep(seq(as.Date("1985-01-01"), as.Date("2010-01-1"), by="weeks"), each=3)
N <- length(date)
name <- c("A","B","C")
value <- rnorm(N)
i<-which(value %in% sample(value, 25)) ;i
j<-which(value %in% sample(value, 150)) ;j
value[i] <- NA
value[j] <- 0
data1 <- data.frame(date, name, value)

Answer 1

4 года имеют 208 недель плюс 5 дней, поэтому они не делятся на недели. Если мы используем 209 недель, то мы пропустим только 2 дня за 4 года, так что давайте попробуем.

Первый конвертировать data1 в "zoo" Класс разбивает данные на отдельные столбцы в соответствии со значением 2-го столбца. z будет иметь один столбец для каждого из A, B а также C, Затем определите функцию дисперсии, которая исключает нули, и используйте ее с rollapplyr

library(zoo)
z <- read.zoo(data1, split = 2) # 1305 x 3 
var0 <- function(x) var(x[x != 0])
r <- rollapplyr(z, 209, var0)

Оставить его в качестве объекта зоопарка может быть достаточно, но это преобразовало бы его в 4-колоночный фрейм данных со столбцами Index, A, B а также C:

fortify.zoo(r)

Answer 2

Я не думаю, что ваше скользящее окно должно совпадать с количеством недель в ваших данных. Это просто окно данных, чтобы сгладить его. Одна идея состоит в том, чтобы сделать что-то с 2 окнами и взять среднее значение:

library(data.table)
library(zoo)
setDT(data1)[,var := {
           v1 <- rollapplyr(value,width=4*12*4, var, fill=N)
           v2 <- rollapplyr(value,width=4*12*5, var, fill=N)
           (v1+v2)/2},  name]

PS: здесь я использую data.table, потому что он подходит для операций разделения (на группу) и повторного связывания.

редактировать

Вы также можете преобразовать свои еженедельные данные в ежедневные, после чего вы сможете рассчитать более точный результат на этой основе. Идея состоит в том, чтобы создать ежедневный индекс и объединить его с исходными данными. Это создаст новый data.table с пропущенными значениями. Вы заменяете пропущенные значения первыми не пропущенными значениями, используя na.locf,

library(data.table)
library(zoo)
ID <- 
data.table(
  date = seq(as.Date("1985-01-01"), as.Date("2010-01-1"), by="days"))
setkey(ID,date)

setDT(data1)[,date:=as.Date(date)][, 
        {
          merge(ID,.SD,all.x=TRUE)[,value := na.locf(value)]
        },

        name]