Machine Learning Insights on BIST 100’s Future

[This article was first published on DataGeeek, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

The BIST100 was rising before the Turkish Central Bank’s rate cuts; could that be an initial signal of a firm uptrend? The ML model tells us there is much more room to go up.

library(tidyverse)
library(tidymodels)
library(tidyquant)
library(timetk)
library(modeltime)

#BIST 100 (XU100.IS)
df_bist <- 
  tq_get("XU100.IS") %>% 
  mutate(date = as.Date(date),
         year_month = tsibble::yearmonth(date)) %>% 
  group_by(year_month) %>%                         
  filter(day(date) <= 5) %>%                      
  slice_max(date) %>% 
  ungroup() %>% 
  mutate(date = floor_date(date, "month")) %>% 
  select(date, bist = close) %>% 
  drop_na() %>% 
  filter(date >= as.Date("2020-08-01"))

df_bist <- 
  tq_get("XU100.IS") %>% 
  filter(date >= as.Date("2022-03-05")) %>% 
  select(date, bist = close) %>% 
  drop_na()



#Splitting tha data
df_split <- 
  df_bist %>% 
  time_series_split(assess = "6 months",
                    cumulative = TRUE)

df_train <- training(df_split)
df_test <- testing(df_split)

#Auto ARIMA
model_fit_arima_reg <- 
  arima_reg() %>%
  set_engine(engine = "auto_arima") %>%
  fit(bist ~ date, data = df_train)

#Boosted ARIMA
model_fit_arima_boosted <- 
  arima_boost(
    min_n = 2,
    learn_rate = 0.015
  ) %>%
  set_engine(engine = "auto_arima_xgboost") %>%
  fit(bist ~ date + as.numeric(date) + factor(week(date), ordered = F),
      data = df_train)

#Exponential Smoothing
model_fit_ets <- 
  exp_smoothing() %>%
  set_engine(engine = "ets") %>%
  fit(bist ~ date, data = df_train)

#Prophet
model_fit_prophet <- 
  prophet_reg() %>%
  set_engine(engine = "prophet") %>%
  fit(bist ~ date, data = df_train)

#Linear Regression
model_fit_lm <- 
  linear_reg() %>%
  set_engine("lm") %>%
  fit(bist ~ as.numeric(date) + factor(week(date), ordered = FALSE),
      data = df_train)


#MARS
model_spec_mars <- 
  mars(mode = "regression") %>%
  set_engine("earth") 

recipe_spec <- 
  recipe(bist ~ date, data = df_train) %>%
  step_date(date, features = "week", ordinal = FALSE) %>%
  step_mutate(date_num = as.numeric(date)) %>%
  step_normalize(date_num) %>%
  step_rm(date)

wflw_fit_mars <- 
  workflow() %>%
  add_recipe(recipe_spec) %>%
  add_model(model_spec_mars) %>%
  fit(df_train)

#Add fitted models to a Model Table
models_tbl <- 
  modeltime_table(
    model_fit_arima_reg,
    model_fit_arima_boosted,
    model_fit_ets,
    model_fit_prophet,
    model_fit_lm,
    wflw_fit_mars
  )

#Calibrate the model to a testing set
calibration_tbl <- 
  models_tbl %>%
  modeltime_calibrate(new_data = df_test)

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

#Calibrate the Linear Regression model to a testing set
calibration_lm <- 
  model_fit_lm %>%
  modeltime_calibrate(new_data = df_test)


#Predictive intervals (95% Confidence Interval)
calibration_lm %>%
  modeltime_forecast(actual_data = df_bist %>% 
                       filter(date >= last(date) - months(6)),
                     new_data = df_test) %>%
  plot_modeltime_forecast(.interactive = FALSE,
                          .legend_show = FALSE,
                          .line_size = 1.5,
                          .color_lab = "",
                          .title = "BIST 100") +
  geom_point(aes(color = .key)) +
  labs(subtitle = "<span style = 'color:turquoise;'>Monthly Index</span><br><span style = 'color:dimgrey;'>Predictive Intervals</span><br><span style = 'color:red;'>ML Model</span>") + 
  scale_x_date(breaks = seq(make_date(2024,9,1),
                            make_date(2025,3,1),
                            by = "month"),
               labels = scales::label_date(format = "%b'%y"),
               expand = expansion(mult = c(.1, .1))) +
  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 = 45, hjust = 1, vjust = 1),
        plot.subtitle = ggtext::element_markdown(face = "bold"))

To leave a comment for the author, please follow the link and comment on their blog: DataGeeek.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)