使用 tslm() 和 tidyverse 预测时间序列组

Question

我想将 tslm 模型拟合到每个时间序列组。 我正在关注here 的示例，但我不想拟合 ets 模型，而是想拟合 tslm。

我调整了代码，使其看起来像这样：

library(tidyverse)
library(timetk)
library(sweep)
library(forecast)

monthly_qty_by_cat2 <- 
  bike_sales %>%
  mutate(order.month = as_date(as.yearmon(order.date))) %>%
  group_by(category.secondary, order.month) %>%
  summarise(total.qty = sum(quantity)) %>% 
  mutate(trendx = row_number())

monthly_qty_by_cat2_nest <- 
  monthly_qty_by_cat2 %>%
  group_by(category.secondary) %>%
  nest() %>%
  mutate(data.ts = map(.x       = data, 
                       .f       = tk_ts, 
                       select   = -order.month, 
                       start    = 2011,
                       freq     = 12)) %>%
  mutate(fit.ts = map(data.ts, ~tslm(total.qty ~ season, data=.x))) %>%
  mutate(fcast.ts = map(fit.ts, forecast))

它可以工作，但是当我改变时

mutate(fit.ts = map(data.ts, ~tslm(total.qty ~ season, data=.x)))

到

mutate(fit.ts = map(data.ts, ~tslm(total.qty ~ trendx, data=.x)))

我收到一个错误：

错误：mutate() 输入 fcast.ts 有问题。 未找到 x 对象“trendx” 并且输入fcast.ts 是map(fit.ts, forecast)。

如何使用 tslm 模型中的自定义预测器预测这些数据？

编辑

为了使用 fable 包，我重写了代码：

monthly_qty_by_cat2 <- 
  bike_sales %>%
  mutate(order.month = as_date(as.yearmon(order.date))) %>%
  group_by(category.secondary, order.month) %>%
  summarise(total.qty = sum(quantity)) %>% 
  mutate(trendx = row_number())

monthly_qty_by_cat2_nest <- 
  monthly_qty_by_cat2 %>%
  group_by(category.secondary) %>% 
  as_tsibble(key = category.secondary)
  
monthly_qty_by_cat2_nest %>%
  model(tslm = TSLM(total.qty ~ trendx)) %>% 
  forecast()

并收到错误：

错误：mutate() 输入 tslm 有问题。 未找到 x 对象“trendx” 无法从提供的 new_data 计算所需的变量。 您的模型是否需要额外的变量来生成预测？

Answer 1

library(tidyverse)
library(tsibble)
library(fable)
library(lubridate)

monthly_qty_by_cat2 <- 
  sweep::bike_sales %>%
  mutate(order.month = yearmonth(order.date)) %>%
  group_by(category.secondary, order.month) %>%
  summarise(total.qty = sum(quantity)) %>% 
  as_tsibble(index=order.month, key=category.secondary) %>%
  mutate(x = rnorm(length(total.qty)))
#> `summarise()` regrouping output by 'category.secondary' (override with `.groups` argument)

future_x <- new_data(monthly_qty_by_cat2) %>%
  mutate(x = 2)

monthly_qty_by_cat2 %>%
  model(tslm = TSLM(total.qty ~ trend() + x)) %>%
  forecast(new_data=future_x)
#> # A fable: 9 x 6 [1M]
#> # Key:     category.secondary, .model [9]
#>   category.secondary .model order.month      total.qty  .mean     x
#>   <chr>              <chr>        <mth>         <dist>  <dbl> <dbl>
#> 1 Cross Country Race tslm      2016 Jan N(369, 187840) 369.       2
#> 2 Cyclocross         tslm      2016 Jan N(-2.5, 75604)  -2.50     2
#> 3 Elite Road         tslm      2016 Jan N(784, 322470) 784.       2
#> 4 Endurance Road     tslm      2016 Jan N(159, 117760) 159.       2
#> 5 Fat Bike           tslm      2016 Jan   N(95, 66320)  94.6      2
#> 6 Over Mountain      tslm      2016 Jan  N(194, 57732) 194.       2
#> 7 Sport              tslm      2016 Jan  N(120, 81568) 120.       2
#> 8 Trail              tslm      2016 Jan  N(214, 56269) 214.       2
#> 9 Triathalon         tslm      2016 Jan  N(102, 94449) 102.       2

^{由reprex package (v0.3.0) 于 2020 年 7 月 20 日创建}