Read in Data
rm(list = ls())
source("~/OneDrive - INSEAD/SkewEllipt/Code_Update/Rfns.R")
library("data.table")
library("ggplot2")
library("psych")
library("lintools")
library("xtable")
path = "/Users/jinyuanzhang/OneDrive - INSEAD/SkewEllipt/Code_Update/CoVaR_forecast/"
folders= 1:100
load(paste(path,"s",as.character(1),"/COVAR.RDATA",sep=""))
DF = out$df
fit = out$fit
for(folder in folders){
load(paste(path,"s",as.character(folder),"/COVAR.RDATA",sep=""))
DF = rbind(DF, out$df)
fit = rbind(fit, out$fit)
}
DF = data.table(DF)
fit = data.table(fit)
fit[, c("alpha1", "alpha2", "rho", "nu", "sd1", "sd2"):= tstrsplit(V3,",",fixed = TRUE)]
fit[, alpha1:=substring(alpha1,3)]
fit[, sd2:=substring(sd2,1,nchar(sd2)-1)]
fit[,V3:=NULL]
fit[, 3:8 := lapply(.SD, as.numeric), .SDcols = 3:8]
#### Trim data at 0.5% tails
DF[, CoVaR_evt99 := winsor(CoVaR_evt99, 0.001)]
DF[, CoVaR_fp99 := winsor(CoVaR_fp99, 0.001)]
# DF[, VaR99 := winsor(VaR99, 0.001)]
DF = DF[!(CoVaR_evt99==max(CoVaR_evt99))]
DF = DF[!(CoVaR_fp99==max(CoVaR_fp99))]
# DF = DF[!(VaR99==max(VaR99))]
DF[, N := .N, by = .(firm)]
report.1 <- function(dat){
c(min(as.matrix(dat),na.rm=T),
quantile(as.matrix(dat), na.rm=T, c(0.05,0.25,0.50,0.75,0.95)), max(as.matrix(dat),na.rm=T))
}
#### Summary statistics for estiamted parameters
report = t(apply(fit[,3:8], 2, report.1))
colnames(report) = c("Min", "5%", "25%", "50%", "75%", "95%", "Max")
print(report)
## Min 5% 25% 50% 75% 95%
## alpha1 -0.26569755 -0.11795223 0.0675564 0.1376575 0.2009652 0.2881240
## alpha2 0.28196952 0.41668839 0.5096010 0.7251475 1.0016914 1.2439247
## rho -0.04047033 0.06050544 0.1055952 0.1393781 0.1778673 0.2680570
## nu 3.67727299 4.04734701 4.2779174 4.5011852 4.8556391 5.6812541
## sd1 0.72718438 0.80479892 0.8352061 0.8616396 0.8889533 0.9216741
## sd2 0.69280993 0.79009849 0.8329532 0.9190491 0.9761305 1.0312317
## Max
## alpha1 0.4111905
## alpha2 1.5995800
## rho 0.3585994
## nu 6.8656810
## sd1 0.9933988
## sd2 1.1133864
Comparison between EVT and FP mthods
Empirical estimator for VaR violation: Loss_stock > VaR_stock
hist(DF[, list(sum( (Loss_stock > VaR99)/N )), by = .(firm)]$V1)
# hist(DF[, list(sum( (Loss_stock > VaR95)/N )), by = .(firm)]$V1)
Empirical estimator for violatoin: Loss_Index > CoVaR_Index given Loss_stock > VaR_stock
DF_CoVaR = DF[, C99:= ifelse(Loss_stock > VaR99,1,0)]
DF_CoVaR[C99 == 1, CoVaR_N99 := .N, by = .(firm)]
### EVT method
hist(DF_CoVaR[C99==1, list(sum((Loss_Index > CoVaR_evt99)/CoVaR_N99)), by = .(firm)]$V1, main = "EVT")
### FP method
hist(DF_CoVaR[C99==1, list(sum((Loss_Index > CoVaR_fp99)/CoVaR_N99)), by = .(firm)]$V1, main = "FP")
LRuc
LRuc_pvalue = DF_CoVaR[C99 ==1, list(fp_LRuc = LRuc(0.01, Loss_Index > CoVaR_fp99)$pvalue, evt_LRuc = LRuc(0.01, Loss_Index > CoVaR_evt99)$pvalue), by = .(firm)]
LRuc_pvalue[, `:=`(p10_evt = evt_LRuc > 0.1, p05_evt = evt_LRuc > 0.05, p01_evt = evt_LRuc > 0.01, p10_fp = fp_LRuc > 0.1, p05_fp = fp_LRuc > 0.05, p01_fp = fp_LRuc > 0.01)]
print(LRuc_pvalue)
## firm fp_LRuc evt_LRuc p10_evt p05_evt p01_evt p10_fp p05_fp
## 1: T 0.0001268467 0.2164653 TRUE TRUE TRUE FALSE FALSE
## 2: IBM 0.0022534647 0.8998699 TRUE TRUE TRUE FALSE FALSE
## 3: CTR 0.0341019204 0.2494031 TRUE TRUE TRUE FALSE FALSE
## 4: HWP 0.0312639085 0.2567045 TRUE TRUE TRUE FALSE FALSE
## p01_fp
## 1: FALSE
## 2: FALSE
## 3: TRUE
## 4: TRUE
cct.onesided
pv.avg
fp_cct = DF_CoVaR[C99==1, (cct.1s.VaR(r = CoVaR_fp99, x = Loss_Index , lev=0.99, hac = FALSE)$pv.avg), by = .(firm)]
colnames(fp_cct)[2] = "fp_cct"
evt_cct = DF_CoVaR[C99==1, (cct.1s.VaR(r = CoVaR_evt99, x = Loss_Index , lev=0.99, hac = FALSE)$pv.avg), by = .(firm)]
colnames(evt_cct)[2] = "evt_cct"
cct_pvalue = merge(fp_cct, evt_cct, by = c("firm"))
cct_pvalue[, `:=`(p10_evt = evt_cct > 0.1, p05_evt = evt_cct > 0.05, p01_evt = evt_cct > 0.01, p10_fp = fp_cct > 0.1, p05_fp = fp_cct > 0.05, p01_fp = fp_cct > 0.01)]
cct_pvalue
## firm fp_cct evt_cct p10_evt p05_evt p01_evt p10_fp p05_fp p01_fp
## 1: CTR 0.08641188 1.0000000 TRUE TRUE TRUE FALSE TRUE TRUE
## 2: HWP 0.08458366 1.0000000 TRUE TRUE TRUE FALSE TRUE TRUE
## 3: IBM 0.03147410 0.4519732 TRUE TRUE TRUE FALSE FALSE TRUE
## 4: T 0.01540398 1.0000000 TRUE TRUE TRUE FALSE FALSE TRUE
pv.cond
fp_cct = DF_CoVaR[C99==1, (cct.1s.VaR(r = CoVaR_fp99, x = Loss_Index , lev=0.99, hac = FALSE)$pv.cond), by = .(firm)]
colnames(fp_cct)[2] = "fp_cct"
evt_cct = DF_CoVaR[C99==1, (cct.1s.VaR(r = CoVaR_evt99, x = Loss_Index , lev=0.99, hac = FALSE)$pv.cond), by = .(firm)]
colnames(evt_cct)[2] = "evt_cct"
cct_pvalue = merge(fp_cct, evt_cct, by = c("firm"))
cct_pvalue[, `:=`(p10_evt = evt_cct > 0.1, p05_evt = evt_cct > 0.05, p01_evt = evt_cct > 0.01, p10_fp = fp_cct > 0.1, p05_fp = fp_cct > 0.05, p01_fp = fp_cct > 0.01)]
cct_pvalue
## firm fp_cct evt_cct p10_evt p05_evt p01_evt p10_fp p05_fp p01_fp
## 1: CTR 0.15739934 1 TRUE TRUE TRUE TRUE TRUE TRUE
## 2: HWP 0.19058078 1 TRUE TRUE TRUE TRUE TRUE TRUE
## 3: IBM 0.08782837 1 TRUE TRUE TRUE FALSE TRUE TRUE
## 4: T 0.04621193 1 TRUE TRUE TRUE FALSE FALSE TRUE
Comparative backtesting
com1 = DF_CoVaR[C99==1, as.list(TLMfn.biv(r = CoVaR_evt99, rS = CoVaR_fp99, y= Loss_Index , lev=0.99, h = 1)), by = .(firm)]
com0 = DF_CoVaR[C99==1, as.list(TLMfn.biv(r = CoVaR_evt99, rS = CoVaR_fp99, y= Loss_Index , lev=0.99, h = 0)), by = .(firm)]
colnames(com0)[2:5] = c("TLM01_0", "TLM05_0", "TLM10_0", "Tn_0")
colnames(com1)[2:5] = c("TLM01_1", "TLM05_1", "TLM10_1", "Tn_1")
com = merge(com0, com1, by = c("firm"))
print(com)
## firm TLM01_0 TLM05_0 TLM10_0 Tn_0 TLM01_1 TLM05_1 TLM10_1
## 1: CTR 1 1 1 -0.9481109 1 1 1
## 2: HWP 1 1 2 -1.3820509 1 1 1
## 3: IBM 1 1 1 -1.1903287 1 1 1
## 4: T 1 1 2 -1.5222830 1 1 2
## Tn_1
## 1: -0.8805963
## 2: -1.1400320
## 3: -0.9781751
## 4: -1.3627847
#### All ###
red.count <- apply((com[,c(3:5, 7:9)]==0),2,"sum") #number of 0's in each column
yellow.count <- apply((com[,c(3:5, 7:9)]==1),2,"sum") #number of 1's in each column
green.count <- apply((com[,c(3:5, 7:9)]==2),2,"sum") #number of 2's in each column
xtable(round(cbind(red.count[4],yellow.count[4],green.count[4])), digits = 0) ## percentage in each category
## % latex table generated in R 3.4.0 by xtable 1.8-2 package
## % Thu Dec 14 00:13:59 2017
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrr}
## \hline
## & 1 & 2 & 3 \\
## \hline
## TLM05\_1 & 0 & 4 & 0 \\
## \hline
## \end{tabular}
## \end{table}
Compare scores
c(sum((com$Tn_0< 0)),sum((com$Tn_1< 0)))
## [1] 4 4