Licença

This work is licensed under the Creative Commons Attribution-ShareAlike 4.0 International License. To view a copy of this license, visit http://creativecommons.org/licenses/by-sa/4.0/ or send a letter to Creative Commons, PO Box 1866, Mountain View, CA 94042, USA.

License: CC BY-SA 4.0
License: CC BY-SA 4.0

As ideias aqui expressas são de responsabilidade exclusiva do autor, e não representam as opiniões da instituição a que pertence.

Citação

Sugestão para citação: FIGUEIREDO, Adriano Marcos Rodrigues. gluonts: Freddie Mac e variáveis que o afetam. Campo Grande-MS,Brasil: RStudio/Rpubs, 2025. Disponível em https://rpubs.com/amrofi/gluonts_freddiemac_fed/.

Introdução

Federal Home Loan Mortgage Corporation (Freddie Mac) (FMCC)

suppressMessages(suppressWarnings(
  {
    library(tidyverse)
    library(tidyquant)
  }))

# 
# Federal Home Loan Mortgage Corporation (Freddie Mac) (FMCC)
df_fmcc <- 
  tq_get("FMCC",
         from = "2000-01-01",
         to = "2025-08-01") %>% 
  tq_transmute(select = close,
               mutate_fun = to.monthly) %>% 
  mutate(date = as.Date(date)) %>% 
  rename(fmcc = close)

FED fund rates and Treasury Yield 10 Years (^TNX) vs Freddie Mac (FMCC)

#FED fund rates https://fred.stlouisfed.org/series/FEDFUNDS
df_fed <- 
  fedfunds <- read_csv("FEDFUNDS.csv", col_types = cols(observation_date = col_date(format = "%Y-%m-%d"))) # %>% 
  # mutate(DATE = parse_date(DATE, "%m/%d/%Y")) %>% 
  # janitor::clean_names()
  

#Treasury Yield 10 Years (^TNX) 10-year Treasury yield interest rate ( TNX ), 
df_tnx <- 
  tq_get("^TNX",
         from = "2000-01-01",
         to = "2025-09-01") %>% 
  tq_transmute(select = close,
               mutate_fun = to.monthly) %>% 
  mutate(date = as.Date(date)) %>% 
  rename(tnx = close)
## Warning in to.period(x, "months", indexAt = indexAt, name = name, ...): missing
## values removed from data
colnames(df_fed)<-c("date","fedfunds")
#Merging all the data into a data frame
df_merged <- 
  df_fmcc %>% 
  left_join(df_tnx,by = join_by(date)) %>% 
  left_join(df_fed,by = join_by(date))

Including Mortgage Crisis

library(dygraphs)

dygraph(df_merged) %>% 
  dySeries("fmcc", label = "FMCC") %>% 
  dySeries("tnx", label = "TNX") %>% 
  dySeries("fedfunds", label = "FED") %>% 
  dyOptions(stackedGraph = TRUE, drawGrid = FALSE) %>%
  dyShading(from = "2007-1-1", 
            to = "2009-1-1",
            color = "#FF7276") %>% 
  dyAnnotation("2008-1-1",
               text = "Mortgage Crisis",
               attachAtBottom = TRUE,
               tooltip = "",
               width = 100,
               height = 20)

After Mortgage Crisis

library(dygraphs)

  df_merged %>% 
  filter(year(date) > 2009) %>%
  dygraph() %>% 
  dySeries("fmcc", label = "FMCC") %>% 
  dySeries("tnx", label = "TNX") %>% 
  dySeries("fedfunds", label = "FED") %>%
  dyOptions(stackedGraph = TRUE, drawGrid = FALSE)

Forecasting the next 24 months with GluonTS DeepAR Algorithm

library(modeltime.gluonts)
## Carregando pacotes exigidos: modeltime
## 
## Anexando pacote: 'modeltime'
## O seguinte objeto é mascarado por 'package:TTR':
## 
##     growth
library(timetk)
## 
## Anexando pacote: 'timetk'
## O seguinte objeto é mascarado por 'package:tidyquant':
## 
##     FANG
library(tidymodels)
## ── Attaching packages ────────────────────────────────────── tidymodels 1.3.0 ──
## ✔ broom        1.0.8     ✔ rsample      1.3.1
## ✔ dials        1.4.0     ✔ tune         2.0.0
## ✔ infer        1.0.8     ✔ workflows    1.3.0
## ✔ modeldata    1.4.0     ✔ workflowsets 1.1.0
## ✔ parsnip      1.3.1     ✔ yardstick    1.3.2
## ✔ recipes      1.3.0
## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ scales::discard() masks purrr::discard()
## ✖ dplyr::filter()   masks stats::filter()
## ✖ xts::first()      masks dplyr::first()
## ✖ recipes::fixed()  masks stringr::fixed()
## ✖ dplyr::lag()      masks stats::lag()
## ✖ xts::last()       masks dplyr::last()
## ✖ dials::momentum() masks TTR::momentum()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step()   masks stats::step()
library(plotly)
## 
## Anexando pacote: 'plotly'
## O seguinte objeto é mascarado por 'package:ggplot2':
## 
##     last_plot
## O seguinte objeto é mascarado por 'package:stats':
## 
##     filter
## O seguinte objeto é mascarado por 'package:graphics':
## 
##     layout
library(ragg)


#Adding id column for deep_ar function
df_deepar <- 
  df_merged %>% 
  pivot_longer(-date, names_to = "vars") %>% 
  mutate(vars = toupper(vars))
  

#Making fitted a GluonTS DeepAR Model
model_fit <- deep_ar(
  id = "vars",
  freq = "M",
  prediction_length = 24,
  lookback_length = 48,
  epochs = 5
) %>%
    set_engine("gluonts_deepar") %>%
    fit(value ~ vars + date, df_deepar)


#Future dataset for 24 months ahead
df_future <- 
  df_deepar %>% 
  group_by(vars) %>% 
  future_frame(.length_out = 24) %>% 
  ungroup()
## .date_var is missing. Using: date
#Forecasting data frame
df_fc <- 
  modeltime_table(
    model_fit
) %>%
  modeltime_forecast(
    new_data    = df_future,
    actual_data = df_deepar %>% filter(year(date) > 2009),
    keep_data   = TRUE
  ) %>%
  group_by(vars) 

#Comparing forecasting plots
df_fc %>%
  plot_modeltime_forecast(
    .conf_interval_show = FALSE, 
    .facet_ncol = 1, 
    .facet_scales = "free_y",
    .interactive = TRUE,
    .legend_show = FALSE,
    .title = ""
  ) %>% 
  #customizing the hoverinfo texts of the traces(lines)
  style(text = glue::glue("FED FUNDS\n{.$x$data[[1]]$x}\n{round(.$x$data[[1]]$y, 2)}"), traces = 1) %>% 
  style(text = glue::glue("FED FUNDS\n{.$x$data[[4]]$x}\n{round(.$x$data[[4]]$y, 2)}"), traces = 4) %>% 
  style(text = glue::glue("FMCC\n{.$x$data[[2]]$x}\n{round(.$x$data[[2]]$y, 2)}"), traces = 2) %>% 
  style(text = glue::glue("FMCC\n{.$x$data[[5]]$x}\n{round(.$x$data[[5]]$y, 2)}"), traces = 5) %>% 
  style(text = glue::glue("TNX\n{.$x$data[[3]]$x}\n{round(.$x$data[[3]]$y, 2)}"), traces = 3) %>% 
  style(text = glue::glue("TNX\n{.$x$data[[6]]$x}\n{round(.$x$data[[6]]$y, 2)}"), traces = 6) %>% 
  #setting font family for tooltip label
  style(hoverlabel = list(
    font = list(
      family = "Baskerville Old Face", 
      size = 20))) %>% 
  #setting font family for the plot
  layout(font = list(family = "Baskerville Old Face",
                     size = 20),
         hoverlabel = list(align = "left")) %>% 
  #Remove plotly buttons from the mode bar
  config(displayModeBar = FALSE)