DK
Добрый день! Подскажите, пожалуйста. Пытаюсь сделать прогноз на скользящем окне, на одну точку вперед. Как сделать циклом- придумал, но он работает очень медленно. Можно это как-то векторизовать?
slide.arima <- function(x, window=36) {
result <- rep(-999, length(x))
result[1:window] <- NA
for (i in (window+1):length(x)){
result[i] <- (x[(i-window):(i-1)] %>% ts(frequency = 12) %>% auto.arima() %>% forecast(h=1))$mean[1]
}
return(result)
}
x <- sin(1:100)
system.time(slide.arima(x))
пользователь система прошло
122.63 0.01 122.73
И второй вопрос: выражение ( %>% … %>%...)$mean[1] выглядит как-то неправильно. Можно ли вместо скобок и $mean[1] сделать что-то более читаемое или и так считается норм?
slide.arima <- function(x, window=36) {
result <- rep(-999, length(x))
result[1:window] <- NA
for (i in (window+1):length(x)){
result[i] <- (x[(i-window):(i-1)] %>% ts(frequency = 12) %>% auto.arima() %>% forecast(h=1))$mean[1]
}
return(result)
}
x <- sin(1:100)
system.time(slide.arima(x))
пользователь система прошло
122.63 0.01 122.73
И второй вопрос: выражение ( %>% … %>%...)$mean[1] выглядит как-то неправильно. Можно ли вместо скобок и $mean[1] сделать что-то более читаемое или и так считается норм?
arima - это по сути регрессия на лагах... хотя алгоритм простой, выявление лучшей модели требует перебора всех вариантов. По умолчанию, стоит параметр nmodels = 94. Это значит, что строится 94 модели и выбирается лучшая. Поэтому на циклах вы много не оптимизируете. Придется либо уменьшать количество перебираемых моделей, либо смотреть другие реализации arima, либо использовать параллельные вычисления. Для красивого выбора элемента используйте purrr::pluck(), далее код:
x <- sin(1:100)
#оригинальная функция с pluck() для читаемости
slide.arima <- function(x, window = 36) {
#x <- sin(1:100)
result <- rep(-999, length(x))
result[1:window] <- NA
for (i in (window + 1):length(x)){
result[i] <- x[(i-window):(i-1)] %>%
ts(frequency = 12) %>%
forecast::auto.arima() %>%
forecast::forecast(h=1) %>%
purrr::pluck("mean")
}
return(result)
}
system.time(res1 <- slide.arima(x))
# пользователь система прошло
# 98.916 9.435 112.950
#функция на векторизованными циклами и параллельными вычислениями
future::plan(future::multisession, workers = 2)
slide_arima <- function(x, window = 36){
window_begin <- 1:(length(x) - window)
window_end <- window:(length(x) - 1)
get_forecast <- function(vec){
ts(x[vec], frequency = 12) %>%
forecast::auto.arima() %>%
forecast::forecast(., h = 1) %>%
purrr::pluck("mean")
}
res <- map2(.x = window_begin, .y = window_end, ~.x:.y) %>%
furrr::future_map_dbl(~get_forecast(.))
rep(NA, window) %>% append(res)
}
system.time(res2 <- slide_arima(x))
# пользователь система прошло
# 0.406 0.053 59.573
res1 == res2
x <- sin(1:100)
#оригинальная функция с pluck() для читаемости
slide.arima <- function(x, window = 36) {
#x <- sin(1:100)
result <- rep(-999, length(x))
result[1:window] <- NA
for (i in (window + 1):length(x)){
result[i] <- x[(i-window):(i-1)] %>%
ts(frequency = 12) %>%
forecast::auto.arima() %>%
forecast::forecast(h=1) %>%
purrr::pluck("mean")
}
return(result)
}
system.time(res1 <- slide.arima(x))
# пользователь система прошло
# 98.916 9.435 112.950
#функция на векторизованными циклами и параллельными вычислениями
future::plan(future::multisession, workers = 2)
slide_arima <- function(x, window = 36){
window_begin <- 1:(length(x) - window)
window_end <- window:(length(x) - 1)
get_forecast <- function(vec){
ts(x[vec], frequency = 12) %>%
forecast::auto.arima() %>%
forecast::forecast(., h = 1) %>%
purrr::pluck("mean")
}
res <- map2(.x = window_begin, .y = window_end, ~.x:.y) %>%
furrr::future_map_dbl(~get_forecast(.))
rep(NA, window) %>% append(res)
}
system.time(res2 <- slide_arima(x))
# пользователь система прошло
# 0.406 0.053 59.573
res1 == res2
