Introduction to FARS

Gian Pietro Bellocca

Introduction

The FARS package provides a comprehensive framework for modeling and forecasting economic scenarios based on the Multilevel Dynamic Factor Model (MLDFM).

Installation

# Install FARS from CRAN
#install.packages("FARS")

# Install FARS from GitHub
#install.packages("devtools")
#devtools::install_github("GPEBellocca/FARS")

library(FARS)
## 
## Attaching package: 'FARS'
## The following object is masked from 'package:stats':
## 
##     density

Input data

library(zoo)
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
library(readxl)
# Input dep variable
data_input_path <- system.file("extdata", "Data_IMF.xlsx", package = "FARS")
data_input <- read_excel(data_input_path, sheet = "data")
data_ts <- ts(data_input[, -1], frequency = 4)
data_diff <- diff(log(data_ts)) * 400
dep_variable <- data_diff[, 'United States', drop = FALSE] 
dep_variable <- dep_variable[2:60]

# Input data
data_df_path <- system.file("extdata", "DataBase.xlsx", package = "FARS")
data_df <- openxlsx::read.xlsx(data_df_path, sheet = "fulldata", cols = 2:625)
data_df <- data_df[,1:519]
data <- as.matrix(data_df)
dimnames(data) <- NULL

# Generate dates
quarters <- as.yearqtr(seq(from = as.yearqtr("2005 Q2"), by = 0.25, length.out = 59))
dates <- as.Date(quarters)

MLDFM Model

This section demonstrates how to use the mldfm function to fit the Multilevel Dynamic Factor Model using the input data.

# MULTI-LEVEL DYNAMIC FACTOR MODEL
# 3 blocks
n_blocks <- 3 # 63 248 208
block_ind <- c(63,311,519)
r <- c(1,0,1,0,1,1,1)

mldfm_result <- mldfm(data, 
                      r=r, 
                      blocks = n_blocks, 
                      block_ind = block_ind , 
                      tol = 1e-6, 
                      max_iter = 1000,
                      method = 0) 
## Summary of Multilevel Dynamic Factor Model (MLDFM)
## ===================================================
## Number of observations:  59 
## Total number of factors:  5 
## Number of nodes:  5 
## Initialization method:  CCA 
## Number of iterations to converge:  46 
## 
## Factors per node:
##  - 1-2-3 :  1 factor(s)
##  - 1-3 :  1 factor(s)
##  - 1 :  1 factor(s)
##  - 2 :  1 factor(s)
##  - 3 :  1 factor(s)
## 
## Residual sum of squares (RSS):  15464.0395 
## Average RSS per observation:  262.1024
# Plot factors
# plot(mldfm_result, dates = dates) 

Subsampling

# Subsampling
n_samples <- 100
sample_size <- 0.9
mldfm_subsampling_result <- mldfm_subsampling(data, 
                                         r=r, 
                                         blocks = n_blocks, 
                                         block_ind = block_ind , 
                                         tol = 1e-6, 
                                         max_iter = 1000, 
                                         method = 0,
                                         n_samples = n_samples,
                                         sample_size = sample_size,
                                         seed = 123) 
## Generating 100 subsamples...
## 
## Subsampling completed.
## Number of subsamples generated: 100

Creating stressed scenarios

# Create stressed scenario
scenario <- create_scenario(model = mldfm_result,
                                  subsample = mldfm_subsampling_result,
                                  data = data, 
                                  block_ind = block_ind, 
                                  alpha=0.95)
## Constructing scenario using 100 subsamples and alpha = 0.95...
## Scenario construction completed.

FARS computation

# Compute Quantiles
fars_result <- compute_fars(dep_variable, 
                              mldfm_result$Factors, 
                              scenario = scenario, 
                              h = 1,   
                              edge = 0.05, 
                              min = TRUE) 
## Running Factor-Augmented Quantile Regressions (FARS)...
## Factor-Augmented Quantile Regressions (FARS)
## ===========================================
## Forecasted quantiles:
##  - Time periods:  59 
##  - Quantile levels:  0.05 0.25 0.50 0.75 0.95 
## 
## Stressed scenario quantiles: YES
# Plot quantiles
plot(fars_result,dates=dates)

Density Estimation

# Density 
density <- nl_density(fars_result$Quantiles,  
                             levels = fars_result$Levels,  
                             est_points = 512, 
                             random_samples = 100000,
                             seed = 123)
## Estimating skew-t densities from forecasted quantiles...
## FARS Density
## ====================
## Time observations  : 59 
## Estimation points  : 512 
## Random samples     : 100000 
## Range of x values  : [ -30 , 10 ]
# Plot density
# plot(density, time_index = dates)

Growth-at-Risk (GaR)

#GaR
GaR0.05 <- quantile_risk(density, QTAU = 0.05)
GaR0.50 <- quantile_risk(density, QTAU = 0.50)
GaR0.95 <- quantile_risk(density, QTAU = 0.95)

Scenario Density Estimation

# Scenario Density 
scenario_density <- nl_density(fars_result$Scenario_Quantiles,  
                             levels = fars_result$Levels,  
                             est_points = 512, 
                             random_samples = 100000,
                             seed = 123)
## Estimating skew-t densities from forecasted quantiles...
## FARS Density
## ====================
## Time observations  : 59 
## Estimation points  : 512 
## Random samples     : 100000 
## Range of x values  : [ -30 , 10 ]

Growth-in-Stress (GiS)

#GiS
GiS0.05 <- quantile_risk(scenario_density, QTAU = 0.05)
GiS0.25 <- quantile_risk(scenario_density, QTAU = 0.25)
GiS0.50 <- quantile_risk(scenario_density, QTAU = 0.50)
GiS0.75 <- quantile_risk(scenario_density, QTAU = 0.75)
GiS0.95 <- quantile_risk(scenario_density, QTAU = 0.95)

Final GaR and GiS Plot

# Final GaR and GiS plot
library(ggplot2)

time <- dates[-1]

MLGaRGiS <- data.frame(
  time = time,
  dep_variable = as.vector(dep_variable[2:59]),
  GaR.05 = as.vector(GaR0.05[1:58]),
  GaR.95 = as.vector(GaR0.95[1:58]),
  GiS.05 = as.vector(GiS0.05[1:58]), 
  GiS.25 = as.vector(GiS0.25[1:58]),
  GiS.75 = as.vector(GiS0.75[1:58]),
  GiS.95 = as.vector(GiS0.95[1:58])
)


p <- ggplot(MLGaRGiS,aes(x=time,y=dep_variable)) + 
  geom_line() + theme_bw()+
  geom_ribbon(aes(ymin=GiS.05,ymax=GiS.95), alpha=0.1, fill="red") +
  geom_ribbon(aes(ymin=GiS.25,ymax=GiS.75), alpha=0.1, fill="grey10") +
  geom_line(aes(x=time, GaR.05), linewidth=0.1, colour="black", linetype="dashed") +
  geom_line(aes(x=time, GaR.95), linewidth=0.1, colour="black", linetype="dashed") +
  scale_y_continuous("Growth") +
  scale_x_date(date_labels = "%Y", date_breaks = "2 years") +
  theme(axis.text.x = element_text(angle = 90))
fig <- plotly::ggplotly(p)
fig