Global Modeling with XGBoost: Gold vs. Silver

The article “Global Modeling with XGBoost: Gold vs. Silver” was originally published on DataGeeek.

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.

Source code for Global Modeling with XGBoost: Gold vs. Silver:

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")

Visit DataGeeek for additional insights on this topic.