Как создать индекс для пользовательской агрегации на объекте зоопарка

Question

Я изо всех сил пытаюсь найти способ агрегирования объекта зоопарка для еженедельных результатов с пробелами в еженедельных измерениях.Это должно использовать diff и другие функции (например, acf) для результатов.

library(zoo)
library(xts)

Я создаю объект зоопарка с небольшой частью моих данных:

time_data <- structure(list(day = structure(c(14246, 14247, 14248, 14249, 14250, 14277, 14278, 14279, 14280, 14281, 14305, 14306, 14307, 14308, 14309), class = "Date"), n_daily = c(10L, 15L, 2L, 15L, 6L, 4L, 6L, 8L, 6L, 1L, 20L, 5L, 8L, 9L, 4L)), row.names = c(NA, -15L), class = c("tbl_df", "tbl", "data.frame"))

z_td <- read.zoo(time_data)

Теперь я хочу агрегировать по неделям.Я мог бы использовать xts:

td_week_xts <- apply.weekly(z_td, sum)
td_week_xts
#> 2009-01-04 2009-01-06 2009-02-06 2009-03-06 
#>         27         21         25         46

Вызов diff как-то здесь не имеет смысла, так как в измерениях есть пробелы.Результаты должны включать «пустые недели».

diff(td_week_xts)
#> 2009-01-06 2009-02-06 2009-03-06 
#>         -6          4         21

Кроме того, apply.weekly не очень гибок, когда вы хотите определить начало недели (по крайней мере, я не вижу этой опции).И это обрывается на прошлой неделе.Поэтому я решил попытаться объединиться с моей собственной функцией weekly:

weekly <- function(x, week_end = 'sunday') {
  days.of.week <- tolower(weekdays(as.Date(3,"1970-01-01",tz="GMT") + 0:6))
  index = which(days.of.week == week_end)-1
  7 * ceiling(as.numeric(x - index + 4)/7) + zoo::as.Date(index - 4)
}

td_week <- as.zooreg(aggregate(z_td, by = weekly, sum), freq= 52)

td_week
#> 2009-01-04 2009-01-11 2009-02-08 2009-03-08 
#>         27         21         25         46

Конечно, пробелы все еще существуют, но теперь фактически содержат полные недели, и я также могу определить, с какого дня должна начинаться неделя.Теперь я могу создать «строго регулярный» объект зоопарка с помощью:

td_week_strictreg <- as.zooreg(merge(td_week, zoo(, seq(min(time(td_week)), max(time(td_week)), 7)), fill = 0))
td_week_strictreg
#> 2009-01-04 2009-01-11 2009-01-18 2009-01-25 2009-02-01 2009-02-08 
#>         27         21          0          0          0         25 
#> 2009-02-15 2009-02-22 2009-03-01 2009-03-08 
#>          0          0          0         46

diff(td_week) или diff(td_week_strictreg), чтобы получить тот же результат:

#> Data:
#> integer(0)
#> 
#> Index:
#> Date of length 0

Я предполагаю, что проблема заключается в том, какПараметр временного ряда задается в объектах zoo / xts, например, частота объекта xts равна 1:

frequency(td_week_xts)
#> [1] 1
frequency(td_week)
#> [1] 52

. Или он заключается в индексации: (здесь, например, при агрегировании по zoo::as.yearmon, что создает настоящий индекс, отличный от моей пользовательской функции ...

td_month <- as.zooreg(aggregate(z_td, by = as.yearmon, sum), freq= 12)
str(td_month)
#> 'zooreg' series from Jan 2009 to Mar 2009
#>   Data: int [1:3] 48 25 46
#>   Index:  'yearmon' num [1:3] Jan 2009 Feb 2009 Mar 2009
#>   Frequency: 12

str(td_week)
#> 'zooreg' series from 2009-01-04 to 2009-03-08
#>   Data: int [1:4] 27 21 25 46
#>   Index:  Date[1:4], format: "2009-01-04" "2009-01-11" "2009-02-08" "2009-03-08"
#>   Frequency: 52

^{Создано в 2019-04-02 пакетом Представить (v0.2.1)}

Извиняюсь за очень длинный вопрос, я знаю, что это не здорово, но я не знал, как быть более кратким.

---

Мне очень помогли моиподход и маленькая функция из этого невероятного ответа

Answer 1

Преобразуйте td_week в регулярно расположенные ряды, а затем используйте diff.xts:

m <- as.xts(merge(td_week, zoo(, seq(start(td_week), end(td_week), 7)), fill = 0))
diff(m)

дает:

             x
2009-01-04  NA
2009-01-11  -6
2009-01-18 -21
2009-01-25   0
2009-02-01   0
2009-02-08  25
2009-02-15 -25
2009-02-22   0
2009-03-01   0
2009-03-08  46

Answer 2

В принципе, способ, которым вы настроили td_week_strictreg, является правильным подходом (аналогично тому, что сделал @ G.Grothendieck для xts), но frequency = 52 неверен и все портит.

Сначала очень простые вещи: просто снимите frequency с as.zoo(), и тогда вы получите тот же результат, что и для xts - за исключением NA padding:

td_week_zoo <- as.zoo(td_week_strictreg)
class(td_week_zoo)
## [1] "zoo"
diff(td_week_zoo)
## 2009-01-11 2009-01-18 2009-01-25 2009-02-01 2009-02-08 2009-02-15 2009-02-22 
##         -6        -21          0          0         25        -25          0 
## 2009-03-01 2009-03-08 
##          0         46 

Нет ничего плохого в использовании zooreg вместо zoo, но вам нужно использовать правильный frequency, который соответствует базовому числовому индексу времени. Поскольку вы используете ежедневный (не годовой ) временной индекс, дельта составляет 7, а не 1/52! И частота обратная к дельте, то есть 1/7 здесь:

frequency(td_week_zoo) <- 1/7
class(td_week_zoo)
## [1] "zooreg" "zoo"   
diff(td_week_zoo)
## 2009-01-11 2009-01-18 2009-01-25 2009-02-01 2009-02-08 2009-02-15 2009-02-22 
##         -6        -21          0          0         25        -25          0 
## 2009-03-01 2009-03-08 
##          0         46 

Если вы хотите использовать индекс времени, когда шаг 1/52 переносит вас на следующую неделю, а шаг 1 - на следующий год, вам нужно сделать это:

td_week_zooreg2 <- zooreg(coredata(td_week_zoo), start = 2009, frequency = 52)
time(td_week_zooreg2)
##  [1] 2009.000 2009.019 2009.038 2009.058 2009.077 2009.096 2009.115 2009.135
##  [9] 2009.154 2009.173
diff(td_week_zooreg2)
##  2009(2)  2009(3)  2009(4)  2009(5)  2009(6)  2009(7)  2009(8)  2009(9) 
##       -6      -21        0        0       25      -25        0        0 
## 2009(10) 
##       46 

В принципе, было бы также возможно написать специальный класс yearweek, в котором вы могли бы связывать каждую неделю с определенным днем ​​недели (скажем, в воскресенье) и соответствующей датой. Я думаю, что причина того, что никто не написал такой класс (насколько мне известно), заключается в том, что вы не всегда будете получать ровно 52 воскресенья в году.

И причина того, что ваш td_week_strictreg не приводит к ошибке, заключается в том, что zooreg просто проверяет, возможна ли частота 52. И это: у вас может быть другое наблюдение каждые 1/52 дня (приблизительно 27,7 минуты). И затем, когда вы берете diff(), он хочет принять разницу между наблюдением и соответствующим наблюдением 27,7 минут раньше. Но поскольку последние не существуют, вы получаете только NA, которые отбрасываются, в результате чего получается пустой объект.

Answer 3

Я не уверен, что понял, что вы пытаетесь сделать, но, может быть, первое заполнение пропущенных дат нулями сработает?

time_all_possibilities = data.frame(
  day = seq(ymd("2009-01-02"), ymd("2009-03-06"), by = "days"))

time_data = merge(time_data, time_all_possibilities, by = "day", all = T)
time_data$n_daily[is.na(time_data$n_daily)] = 0