Поиск сетки на модели ARIMA в R - PullRequest
Новая
       124

Поиск сетки на модели ARIMA в R

0 голосов
/ 14 июля 2020

Я пытаюсь заставить поиск по сетке для моей модели ARIMA работать, и мне нужна дополнительная помощь с этим. У меня есть следующие данные: 

head(train)

  Date       Count
  <date>     <int>
1 2016-06-15    21
2 2016-06-16    21
3 2016-06-17    12
4 2016-06-18    20
5 2016-06-19    29
6 2016-06-20    30

Данные поезда Диапазон значений переменной даты от 2016-06-15 до 2019-06-30 с 1111 наблюдениями в целом Данные поезда Диапазон значений переменной от min = 3 до max = 154 со средним значением = 23,83 и sd = 13,84.

Мне удалось определить гиперпараметры и создать 36 моделей ARIMA со следующим кодом: 

#Create ts data
ts_train = xts(train[, -1], order.by = as.POSIXct(train$Date), frequency = 365)

#ARIMA model tune
#tibble helper function
to_tibble <- function(forecast_object){
  point_estimate <- forecast_object$mean %>%
    as_tsibble() %>%
    rename(point_estimate = value,
           date = index)
  
  upper <- forecast_object$upper %>%
    as_tsibble() %>%
    spread(key, value) %>%
    rename(date = index,
           upper80 = `80%`,
           upper95 = `95%`)
  
  lower <- forecast_object$lower %>%
    as_tsibble() %>%
    spread(key, value) %>%
    rename(date = index,
           lower80 = `80%`,
           lower95 = `95%`)
  
  reduce(list(point_estimate, upper, lower), full_join)
}

#Trend hyper parameters
order_list <- list("p" = seq(0, 2),
                   "d" = seq(0, 1),
                   "q" = seq(0, 2)) %>%
  cross() %>%
  map(lift(c))

#Seasonal hyper parameteres
season_list <- list("P" = seq(0, 2),
                    "D" = seq(0, 1),
                    "Q" = seq(0, 2),
                    "period" = 365)  %>%
  cross() %>%
  map(lift(c))

#Coerce vectors to tibbles
orderdf <- tibble("order" = order_list)
seasondf <- tibble("season" = season_list)

#Create grid of hyper-parameters
hyper_parameters_df <- crossing(orderdf, seasondf)

#Run grid search of ARIMA models
tic <- Sys.time()
models_df <- hyper_parameters_df %>%
  mutate(models = map2(.x = order,
                              .y = season,
                              ~possibly(arima, otherwise = NULL)(x = ts_train,
                                                                 order = .x, seasonal = .y)))
running_time <- Sys.time() - tic
running_time

#Drop models which couldn't compute ARIMA
final_models = models_df %>% drop_na()
nrows <- nrow(final_models)

И затем я получаю сообщение об ошибке, когда пытаюсь для вычисления RMSE по моим тестовым данным с помощью следующего кода: 

final_models <- final_models %>%
  mutate(forecast = map(models, ~possibly(forecast, otherwise = NULL)(., h = 183))) %>%
  mutate(point_forecast = map(forecast, ~.$`mean`)) %>%
  mutate(true_value = rerun(nrows, test)) %>%
  mutate(rmse = map2_dbl(point_forecast, true_value,
                         ~sqrt(mean((.x - .y) ** 2))))

Я получаю одну ошибку и одно предупреждение: 

Error in .x - .y : non-numeric argument to binary operator
In addition: Warning message:
In mean((.x - .y)^2) :
  Incompatible methods ("Ops.ts", "Ops.data.frame") for "-"

Может кто-нибудь мне помочь с этим?

Вот мои тестовые данные, если они нужны для создания фиктивных данных: 

head(test)
  Date       Count
  <date>     <int>
1 2019-07-02    20
2 2019-07-03    28
3 2019-07-04    35
4 2019-07-05    34
5 2019-07-06    60
6 2019-07-07    63

Тестовые данные Диапазон дат варьируется от 2019-07-01 до 2019-12-31, всего 184 наблюдения. диапазон переменных от min = 6 до max = 63 со средним значением = 21,06 и sd = 9,89.

...