rm(list = ls())
source("~/OneDrive - INSEAD/SkewEllipt/Code_Update/Rfns.R")
library("data.table")
library("ggplot2")
library("psych")
##
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
library("lintools")
library("xtable")
source("~/OneDrive - INSEAD/SkewEllipt/Code_Update/Rfns.R")
path = "/Users/jinyuanzhang/OneDrive - INSEAD/SkewEllipt/Code_Update/CoVaR/"
DF = fread( paste(path,"/CoVaR_output.csv",sep=""))
fit = fread( paste(path,"/fit_output.csv",sep=""))
DF[, N := .N, by = .(firm)]
DF = DF[!(CoVaR_fp99 < 0 )]
key <- fread("~/OneDrive - INSEAD/SkewEllipt/Code_Update/Risk Contagion/key.csv")
colnames(key)[1] <- "firm"
DF = merge(DF, key, by = "firm")
fit = merge(fit, key, by = "firm")
report.1 <- function(dat){
c(length(dat),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[,2:7], 2, report.1))
colnames(report) = c("Count","Min", "5%", "25%", "50%", "75%", "95%", "Max")
xtable(report)
## % latex table generated in R 3.4.0 by xtable 1.8-2 package
## % Thu Dec 14 23:34:54 2017
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrrrrrrr}
## \hline
## & Count & Min & 5\% & 25\% & 50\% & 75\% & 95\% & Max \\
## \hline
## alpha1 & 98.00 & -0.58 & -0.12 & 0.04 & 0.13 & 0.20 & 0.32 & 0.38 \\
## alpha2 & 98.00 & -0.04 & 0.08 & 0.18 & 0.25 & 0.30 & 0.41 & 0.44 \\
## rho & 98.00 & -0.01 & 0.01 & 0.04 & 0.07 & 0.10 & 0.14 & 0.45 \\
## nu & 98.00 & 3.38 & 3.91 & 4.42 & 4.71 & 4.95 & 5.42 & 5.78 \\
## sd1 & 98.00 & 0.67 & 0.76 & 0.78 & 0.80 & 0.82 & 0.84 & 0.86 \\
## sd2 & 98.00 & 0.64 & 0.71 & 0.74 & 0.76 & 0.79 & 0.82 & 0.85 \\
## \hline
## \end{tabular}
## \end{table}
#### Comparison between EVT and FP mthods
##### Empirical estimator for violation: Loss_stock > VaR_stock
hist(DF[, list(sum( (Loss_stock > VaR99)/N )), by = .(firm)]$V1)
##### Empirical estimator for violatoin: Loss_Index > CoVaR_Index given Loss_stock > VaR_stock
DF_CoVaR = DF[Loss_stock > VaR99]
ID_keep = DF_CoVaR[ (Loss_Index > CoVaR_fp99) | (Loss_Index > CoVaR_evt99) ]$firm
# DF_CoVaR = DF_CoVaR[firm %in% ID_keep]
DF_CoVaR[, CoVaR_N := .N, by = .(firm)]
# DF_CoVaR = DF_CoVaR[!(firm %in% c(10562,66157,86868))] #10562 66157 86868
DF_CoVaR = DF_CoVaR[CoVaR_N >= 10]
print(length(unique(DF_CoVaR$firm)))
## [1] 94
### EVT method
mean(DF_CoVaR[, list(sum((Loss_Index > CoVaR_evt99)/CoVaR_N)), by = .(firm)]$V1)
## [1] 0.01247579
### FP method
mean(DF_CoVaR[, list(sum((Loss_Index > CoVaR_fp99)/CoVaR_N)), by = .(firm)]$V1)
## [1] 0.007691471
#### LRuc #########
LRuc_pvalue = DF_CoVaR[, list(fp_LRuc = LRuc(0.01, Loss_Index > CoVaR_fp99)$pvalue, evt_LRuc = LRuc(0.01, Loss_Index > CoVaR_evt99)$pvalue), by = .(firm, Group)]
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)]
out = apply(LRuc_pvalue[, 5:10],2, sum) #cases with pvalue > 0.1, 0.05, 0.01
out = rbind(out, apply(LRuc_pvalue[Group == "depository", 5:10],2, sum))
out = rbind(out, apply(LRuc_pvalue[Group == "other", 5:10],2, sum))
out = rbind(out, apply(LRuc_pvalue[Group == "insurance", 5:10],2, sum))
out = rbind(out, apply(LRuc_pvalue[Group == "broker", 5:10],2, sum))
rownames(out) = c("All", "Depositories", "Others", "Insurance", "Broker-dealers")
count = c(nrow(LRuc_pvalue), nrow(LRuc_pvalue[Group == "depository"]), nrow(LRuc_pvalue[Group == "other"]), nrow(LRuc_pvalue[Group == "insurance"]), nrow(LRuc_pvalue[Group == "broker"]) )
ave_p_fp = c(mean(LRuc_pvalue$fp_LRuc), mean(LRuc_pvalue[Group == "depository"]$fp_LRuc), mean(LRuc_pvalue[Group == "other"]$fp_LRuc), mean(LRuc_pvalue[Group == "insurance"]$fp_LRuc), mean(LRuc_pvalue[Group == "broker"]$fp_LRuc) )
ave_p_evt = c(mean(LRuc_pvalue$evt_LRuc), mean(LRuc_pvalue[Group == "depository"]$evt_LRuc), mean(LRuc_pvalue[Group == "other"]$evt_LRuc), mean(LRuc_pvalue[Group == "insurance"]$evt_LRuc), mean(LRuc_pvalue[Group == "broker"]$evt_LRuc) )
cbind(count, out[,1:3], out[,4:6])
## count p10_evt p05_evt p01_evt p10_fp p05_fp p01_fp
## All 94 82 86 91 86 92 94
## Depositories 29 24 24 26 26 29 29
## Others 26 24 25 26 25 26 26
## Insurance 30 27 29 30 29 29 30
## Broker-dealers 9 7 8 9 6 8 9
#### cct.twosided ####
#### pv.avg
fp_cct = DF_CoVaR[, (cct.2s.VaR(r = CoVaR_fp99, x = Loss_Index , lev=0.99, hac = FALSE)$pv.avg), by = .(firm, Group)]
colnames(fp_cct)[3] = "fp_cct"
evt_cct = DF_CoVaR[, (cct.2s.VaR(r = CoVaR_evt99, x = Loss_Index , lev=0.99, hac = FALSE)$pv.avg), by = .(firm, Group)]
colnames(evt_cct)[3] = "evt_cct"
cct_pvalue = merge(fp_cct, evt_cct, by = c("firm","Group"))
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)]
out = apply(cct_pvalue[, 5:10],2, sum) #cases with pvalue > 0.1, 0.05, 0.01
out = rbind(out, apply(cct_pvalue[Group == "depository", 5:10],2, sum))
out = rbind(out, apply(cct_pvalue[Group == "other", 5:10],2, sum))
out = rbind(out, apply(cct_pvalue[Group == "insurance", 5:10],2, sum))
out = rbind(out, apply(cct_pvalue[Group == "broker", 5:10],2, sum))
rownames(out) = c("All", "Depositories", "Others", "Insurance", "Broker-dealers")
count = c(nrow(cct_pvalue), nrow(cct_pvalue[Group == "depository"]), nrow(cct_pvalue[Group == "other"]), nrow(cct_pvalue[Group == "insurance"]), nrow(cct_pvalue[Group == "broker"]) )
cbind(count, out)
## count p10_evt p05_evt p01_evt p10_fp p05_fp p01_fp
## All 94 22 22 22 16 16 16
## Depositories 29 7 7 7 7 7 7
## Others 26 4 4 4 1 1 1
## Insurance 30 7 7 7 5 5 5
## Broker-dealers 9 4 4 4 3 3 3
ave_p_fp = c(mean(cct_pvalue$fp_cct), mean(cct_pvalue[Group == "depository"]$fp_cct), mean(cct_pvalue[Group == "other"]$fp_cct), mean(cct_pvalue[Group == "insurance"]$fp_cct), mean(cct_pvalue[Group == "broker"]$fp_cct) )
ave_p_evt = c(mean(cct_pvalue$evt_cct), mean(cct_pvalue[Group == "depository"]$evt_cct), mean(cct_pvalue[Group == "other"]$evt_cct), mean(cct_pvalue[Group == "insurance"]$evt_cct), mean(cct_pvalue[Group == "broker"]$evt_cct) )
xtable(cbind(count, out[,3], out[,6]))
## % latex table generated in R 3.4.0 by xtable 1.8-2 package
## % Thu Dec 14 23:34:55 2017
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrr}
## \hline
## & count & V2 & V3 \\
## \hline
## All & 94 & 22 & 16 \\
## Depositories & 29 & 7 & 7 \\
## Others & 26 & 4 & 1 \\
## Insurance & 30 & 7 & 5 \\
## Broker-dealers & 9 & 4 & 3 \\
## \hline
## \end{tabular}
## \end{table}
#### pv.cond
fp_cct = DF_CoVaR[, (cct.2s.VaR(r = CoVaR_fp99, x = Loss_Index , lev=0.99, hac = FALSE)$pv.cond), by = .(firm, Group)]
colnames(fp_cct)[3] = "fp_cct"
evt_cct = DF_CoVaR[, (cct.2s.VaR(r = CoVaR_evt99, x = Loss_Index , lev=0.99, hac = FALSE)$pv.cond), by = .(firm, Group)]
colnames(evt_cct)[3] = "evt_cct"
cct_pvalue = merge(fp_cct, evt_cct, by = c("firm","Group"))
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)]
out = apply(cct_pvalue[, 5:10],2, sum) #cases with pvalue > 0.1, 0.05, 0.01
out = rbind(out, apply(cct_pvalue[Group == "depository", 5:10],2, sum))
out = rbind(out, apply(cct_pvalue[Group == "other", 5:10],2, sum))
out = rbind(out, apply(cct_pvalue[Group == "insurance", 5:10],2, sum))
out = rbind(out, apply(cct_pvalue[Group == "broker", 5:10],2, sum))
rownames(out) = c("All", "Depositories", "Others", "Insurance", "Broker-dealers")
count = c(nrow(cct_pvalue), nrow(cct_pvalue[Group == "depository"]), nrow(cct_pvalue[Group == "other"]), nrow(cct_pvalue[Group == "insurance"]), nrow(cct_pvalue[Group == "broker"]) )
ave_p_fp = c(mean(cct_pvalue$fp_cct), mean(cct_pvalue[Group == "depository"]$fp_cct), mean(cct_pvalue[Group == "other"]$fp_cct), mean(cct_pvalue[Group == "insurance"]$fp_cct), mean(cct_pvalue[Group == "broker"]$fp_cct) )
ave_p_evt = c(mean(cct_pvalue$evt_cct), mean(cct_pvalue[Group == "depository"]$evt_cct), mean(cct_pvalue[Group == "other"]$evt_cct), mean(cct_pvalue[Group == "insurance"]$evt_cct), mean(cct_pvalue[Group == "broker"]$evt_cct) )
xtable(cbind(count, out[,3], out[,6]))
## % latex table generated in R 3.4.0 by xtable 1.8-2 package
## % Thu Dec 14 23:34:55 2017
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrr}
## \hline
## & count & V2 & V3 \\
## \hline
## All & 94 & 25 & 19 \\
## Depositories & 29 & 8 & 8 \\
## Others & 26 & 5 & 2 \\
## Insurance & 30 & 7 & 5 \\
## Broker-dealers & 9 & 5 & 4 \\
## \hline
## \end{tabular}
## \end{table}
## Comparative backtesting
ID_pick = cct_pvalue[p01_evt == TRUE]$firm
com1 = DF_CoVaR[firm %in% ID_pick, as.list(TLMfn.biv(r = CoVaR_evt99, rS = CoVaR_fp99, y= Loss_Index , lev=0.99, h = 1)), by = .(firm, Group)]
com0 = DF_CoVaR[firm %in% ID_pick, as.list(TLMfn.biv(r = CoVaR_evt99, rS = CoVaR_fp99, y= Loss_Index , lev=0.99, h = 0)), by = .(firm, Group)]
colnames(com0)[3:6] = c("TLM01_0", "TLM05_0", "TLM10_0", "Tn_0")
colnames(com1)[3:6] = c("TLM01_1", "TLM05_1", "TLM10_1", "Tn_1")
com = merge(com0, com1, by = c("firm", "Group"))
#### 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 23:34:55 2017
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrr}
## \hline
## & 1 & 2 & 3 \\
## \hline
## TLM01\_1 & 1 & 22 & 2 \\
## \hline
## \end{tabular}
## \end{table}
#### depository ###
red.count <- apply((com[Group == "depository",c(3:5, 7:9)]==0),2,"sum") #number of 0's in each column
yellow.count <- apply((com[Group == "depository",c(3:5, 7:9)]==1),2,"sum") #number of 1's in each column
green.count <- apply((com[Group == "depository",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 23:34:55 2017
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrr}
## \hline
## & 1 & 2 & 3 \\
## \hline
## TLM01\_1 & 1 & 7 & 0 \\
## \hline
## \end{tabular}
## \end{table}
#### other ###
red.count <- apply((com[Group == "other",c(3:5, 7:9)]==0),2,"sum") #number of 0's in each column
yellow.count <- apply((com[Group == "other",c(3:5, 7:9)]==1),2,"sum") #number of 1's in each column
green.count <- apply((com[Group == "other",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 23:34:55 2017
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrr}
## \hline
## & 1 & 2 & 3 \\
## \hline
## TLM01\_1 & 0 & 4 & 1 \\
## \hline
## \end{tabular}
## \end{table}
#### insurance ###
red.count <- apply((com[Group == "insurance",c(3:5, 7:9)]==0),2,"sum") #number of 0's in each column
yellow.count <- apply((com[Group == "insurance",c(3:5, 7:9)]==1),2,"sum") #number of 1's in each column
green.count <- apply((com[Group == "insurance",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 23:34:55 2017
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrr}
## \hline
## & 1 & 2 & 3 \\
## \hline
## TLM01\_1 & 0 & 7 & 0 \\
## \hline
## \end{tabular}
## \end{table}
#### broker ###
red.count <- apply((com[Group == "broker",c(3:5, 7:9)]==0),2,"sum") #number of 0's in each column
yellow.count <- apply((com[Group == "broker",c(3:5, 7:9)]==1),2,"sum") #number of 1's in each column
green.count <- apply((com[Group == "broker",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 23:34:55 2017
## \begin{table}[ht]
## \centering
## \begin{tabular}{rrrr}
## \hline
## & 1 & 2 & 3 \\
## \hline
## TLM01\_1 & 0 & 4 & 1 \\
## \hline
## \end{tabular}
## \end{table}