[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.
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.
