Time Series Machine Learning: S&P 500
[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.
It does not seem to be a safe entry point for the S&P 500 market ahead of the FED rate cuts.

Source code:
library(tidyverse)
library(tidymodels)
library(timetk)
library(tidyquant)
library(modeltime)
library(ggthemes)
#FED Interest Rates
df_fedfunds <-
read_csv("https://raw.githubusercontent.com/mesdi/investingcom/main/fedfunds.csv") %>%
janitor::clean_names() %>%
select(date = release_date, fedfunds = actual) %>%
#Converts string to date object
mutate(date = case_when(
!is.na(parse_date(date, format = "%b %d, %Y")) ~ parse_date(date, format = "%b %d, %Y"),
!is.na(parse_date(date, format = "%d-%b-%y")) ~ parse_date(date, format = "%d-%b-%y")
)) %>%
mutate(date = floor_date(date, "month") %m+% months(1),
fedfunds = str_remove(fedfunds, "%") %>% as.numeric()) %>%
#makes regular time series by filling the time gaps
pad_by_time(date, .by = "month") %>%
fill(fedfunds, .direction = "down") %>%
#removes duplicated points
distinct(date, .keep_all = TRUE) %>%
drop_na()
#S&P 500 (^GSPC)
df_sp500 <-
tq_get("^GSPC", to = "2024-09-01") %>%
tq_transmute(select = close,
mutate_fun = to.monthly,
col_rename = "sp500") %>%
mutate(date = as.Date(date)) %>%
drop_na()
#Merging all the datasets
df_merged <-
df_sp500 %>%
left_join(df_fedfunds) %>%
drop_na()
#Splitting
split <-
df_merged %>%
time_series_split(assess = "1 year",
cumulative = TRUE)
df_train <- training(split)
df_test <- testing(split)
#Time series cross validation for tuning
df_folds <- time_series_cv(df_train,
initial = 80,
assess = 12)
#Preprocessing for Boosting ARIMA
rec_arima_boost <-
recipe(nvidia ~ ., data = df_train) %>%
step_date(date, features = c("year", "month")) %>%
step_dummy(date_month, one_hot = TRUE) %>%
step_normalize(all_numeric_predictors())
#Boosted ARIMA Regression Models
#(https://business-science.github.io/modeltime/reference/arima_boost.html)
mod_arima_boost <-
arima_boost(
min_n = tune(),
learn_rate = tune(),
trees = tune()
) %>%
set_engine(engine = "auto_arima_xgboost")
#Workflow set
wflow_arima_boost <-
workflow_set(
preproc = list(rec = rec_arima_boost),
models = list(mod = mod_arima_boost)
)
#Tuning and evaluating the model on all the samples
grid_ctrl <-
control_grid(
save_pred = TRUE,
parallel_over = "everything",
save_workflow = TRUE
)
grid_results <-
wflow_arima_boost %>%
workflow_map(
seed = 98765,
resamples = df_folds,
grid = 10,
control = grid_ctrl
)
#Accuracy of the grid results
grid_results %>%
rank_results(select_best = TRUE,
rank_metric = "rsq") %>%
select(Models = wflow_id, .metric, mean)
#Finalizing the model with the best parameters
best_param <-
grid_results %>%
extract_workflow_set_result("rec_mod") %>%
select_best(metric = "rsq")
wflw_fit <-
grid_results %>%
extract_workflow("rec_mod") %>%
finalize_workflow(best_param) %>%
fit(df_train)
#Calibrate the model to the testing set
calibration_boost <-
wflw_fit %>%
modeltime_calibrate(new_data = df_test)
#Accuracy of the finalized model
calibration_boost %>%
modeltime_accuracy(metric_set = metric_set(rmse,rsq)) %>%
select(.model_desc)
#Predictive intervals
calibration_boost %>%
modeltime_forecast(actual_data = df_merged %>%
filter(date >= last(date) - months(12)),
new_data = df_test) %>%
plot_modeltime_forecast(.interactive = FALSE,
.legend_show = FALSE,
.line_size = 1.5,
.color_lab = "",
.title = "Predictive Intervals for S&P 500 ") +
labs(subtitle = "Monthly Index<br><span style = 'color:red;'>Point Forecast Line</span>") +
scale_x_date(breaks = c(make_date(2023,8,1),
make_date(2024,1,1),
make_date(2024,8,1)),
labels = scales::label_date(format = "%Y %b"),
expand = expansion(mult = c(.1, .1))) +
theme_wsj(base_family = "Bricolage Grotesque",
color = "blue",
base_size = 12) +
theme(legend.position = "none",
plot.background = element_rect(fill = "khaki", color = "khaki"),
plot.title = element_text(size = 24),
axis.text = element_text(size = 16),
plot.subtitle = ggtext::element_markdown(size = 20, 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.