Global Modeling with XGBoost: Gold vs. Silver

China aims to increase its influence in the global bullion market by directing friendly countries to store their gold reserves within its borders. This move is part of Beijing’s efforts to reduce its reliance on the dollar and promote the global use of the yuan.

Goldman Sachs predicts that if just 1% of corporate bonds shift to gold, prices could rise to $5,000. However, according to the XGBoost model, both gold and silver near the upper bands suggest that it’s not a good time to buy at those levels.

Source code:

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

#Gold Futures (GC=F)
df_gold <- 
  tq_get("GC=F") %>% 
  select(date,  gold = close)

#Silver Futures (SI=F)
df_silver <- 
  tq_get("SI=F") %>% 
  select(date,  silver = close)


#Creating the survey data
df_survey <- 
  df_gold %>% 
  left_join(df_silver) %>% 
  pivot_longer(-date,
               names_to = "id",
               values_to = "value") %>% 
  mutate(id = toupper(id)) %>% 
  filter(date >= last(date) - months(36)) %>% 
  drop_na()

#Train/Test Splitting
splits <- 
  df_survey %>% 
  time_series_split(assess     = "15 days", 
                    cumulative = TRUE)


#Recipe

#The step_normalize() function is breaking the decision splits.
#Reducing the model's accuracy led to its removal.

rec_spec <- 
  recipe(value ~ ., training(splits)) %>%
  step_string2factor("id") %>% 
  step_mutate_at(id, fn = droplevels) %>%
  step_timeseries_signature(date) %>%
  step_rm(date) %>%
  step_dummy(all_nominal_predictors(), one_hot = TRUE) %>% 
  step_zv(all_predictors()) %>%
  step_corr(all_predictors())


#Preprocessed data variables
rec_spec %>% 
  prep() %>% 
  bake(new_data = NULL) %>% 
  glimpse()
 

#Workflow fit
wflw_fit <- 
  workflow() %>%
  add_model(
    boost_tree("regression") %>% 
      set_engine("xgboost")
  ) %>%
  add_recipe(rec_spec) %>%
  fit(training(splits))

#Create a Modeltime Table
model_tbl <- 
  modeltime_table(wflw_fit)


#Calibrating by ID
calib_tbl <- 
  model_tbl %>%
  modeltime_calibrate(
    new_data = testing(splits), 
    id       = "id"
  )

#Measuring Test Accuracy

#Global Accuracy
calib_tbl %>% 
  modeltime_accuracy(acc_by_id = FALSE) %>% 
  table_modeltime_accuracy(.interactive = FALSE)

#Local Accuracy
calib_tbl %>% 
  modeltime_accuracy(acc_by_id = TRUE) %>% 
  table_modeltime_accuracy(.interactive = TRUE)


#Prediction intervals were used similarly to the Relative Strength Index (RSI).
calib_tbl %>%
  modeltime_forecast(
    new_data    = testing(splits),
    actual_data = testing(splits),
    conf_by_id  = TRUE) %>%
  group_by(id) %>%
  plot_modeltime_forecast(
    .facet_ncol  = 1,
    .interactive = FALSE,
    .line_size = 1.5
  )  +
  labs(title = "Global Modeling with XGBoost", 
       subtitle = "<span style = 'color:dimgrey;'>Predictive Intervals</span> of <span style = 'color:red;'>XGBoost</span>", 
       y = "", x = "") + 
  scale_y_continuous(labels = scales::label_currency()) +
  scale_x_date(labels = scales::label_date("%b %d"),
               date_breaks = "4 days") +
  theme_tq(base_family = "Roboto Slab", base_size = 16) +
  theme(plot.subtitle = ggtext::element_markdown(face = "bold"),
        plot.title = element_text(face = "bold"),
        plot.background = element_rect(fill = "snow"),
        strip.text = element_text(face = "bold", color = "black"),
        strip.background = element_rect(fill =  "azure"),
        axis.text= element_text(face = "bold"),
        legend.position = "none")

Related