Ansambluri de modele | R-BLOGGERS

Indicele tehnologiei Bist pare să fi ajuns la trupa superioară, în ciuda crizei politice în curs de desfășurare în Turcia. Dar ar putea fi continuat?

Cod sursă:

library(tidymodels)
library(tidyverse)
library(modeltime)
library(modeltime.ensemble)
library(timetk)

#BIST Technology Index
df_bist <- 
  read_csv("data/bist_tech.csv") %>% 
  janitor::clean_names() %>% 
  mutate(date = parse_date(date, "%m/%d/%Y")) %>% 
  select(date, value = price) %>% 
  slice_min(date, n = -1)



#Splitting
splits <- 
  time_series_split(df_bist, 
                    assess = "3 months", 
                    cumulative = TRUE)


#Recipe
recipe_spec <- 
  recipe(value ~ date, training(splits)) %>%
  step_timeseries_signature(date) %>%
  step_rm(matches("(.iso$)|(.xts$)")) %>%
  step_normalize(matches("(index.num$)|(_year$)")) %>%
  step_dummy(all_nominal()) %>%
  step_fourier(date, K = 1, period = 365)


#Model 1 - Auto ARIMA
model_spec_arima <- 
  arima_reg() %>%
  set_engine("auto_arima")

wflw_fit_arima <- 
  workflow() %>%
  add_model(model_spec_arima) %>%
  add_recipe(recipe_spec %>% step_rm(all_predictors(), -date)) %>%
  fit(training(splits))

#Model 2 - Prophet
model_spec_prophet <- 
  prophet_reg() %>%
  set_engine("prophet")

wflw_fit_prophet <- 
  workflow() %>%
  add_model(model_spec_prophet) %>%
  add_recipe(recipe_spec %>% step_rm(all_predictors(), -date)) %>%
  fit(training(splits))

#Model 3 - Elastic Net
model_spec_glmnet <- 
  linear_reg(
    mixture = 0.9,
    penalty = 4.36e-6
  ) %>%
  set_engine("glmnet")

wflw_fit_glmnet <- 
  workflow() %>%
  add_model(model_spec_glmnet) %>%
  add_recipe(recipe_spec %>% step_rm(date)) %>%
  fit(training(splits))

#Modeltime Workflow for Ensemble Forecasting
df_models <- 
  modeltime_table(
    wflw_fit_arima,
    wflw_fit_prophet,
    wflw_fit_glmnet
  )


#Make an Ensemble
ensemble_fit <- 
  df_models %>%
  ensemble_average(type = "mean")

#Calibration
calibration_tbl <- 
  modeltime_table(
    ensemble_fit
  ) %>%
  modeltime_calibrate(testing(splits))


#Accuracy
calibration_tbl %>%
  modeltime_accuracy() %>%
  table_modeltime_accuracy(
    .interactive = FALSE
  )


#Predictive intervals (95% Confidence Interval)
calibration_tbl %>%
  modeltime_forecast(actual_data = df_bist %>% 
                       filter(date >= last(date) - months(3)),
                     new_data = testing(splits)) %>%
  plot_modeltime_forecast(.interactive = FALSE,
                          .legend_show = FALSE,
                          .line_size = 1.5,
                          .color_lab = "",
                          .title = "BIST Technology Index") +
  labs(subtitle = "Predictive Intervals
Ensemble Model") + 
  scale_y_continuous(labels = scales::label_currency(prefix = "",suffix = "₺")) +
  theme_minimal(base_family = "Roboto Slab", base_size = 20) +
  theme(legend.position = "none",
        plot.background = element_rect(fill = "azure", 
                                       color = "azure"),
        plot.title = element_text(face = "bold"),
        axis.text = element_text(face = "bold"),
        #axis.text.x = element_text(angle = 60, hjust = 1, vjust = 1),
        plot.subtitle = ggtext::element_markdown(face = "bold", size = 20))