比较我国金融机构：银行部门、证券部门、信托部门和保险部门的破产风险（根据中信行业分类）

比较不同金融机构间的系统性风险

# 利用指数收益率作为市场收益率 
library("readr")
library("readxl")
library("dplyr")
library(stringr)
library(PerformanceAnalytics)
library(gcookbook)
library(ggplot2)
library(reshape2)
library(ggpubr)
setwd("e:/R/tail risk/day/finance")
varp<-0.05
# 读取各个部门金融指数：
findex<-read_excel("findex.xlsx",sheet = 1)%>%select(2,3,12)%>%rename(Stkcd="简称",Clsdt="日期",Dretwd="涨跌幅(%)")%>%filter(Dretwd!="--")
findex1<-data.frame(findex[,c(1,2)],Dretwd=as.numeric(findex$Dretwd))
findex1<-(data.frame(findex1,Trdmnt=as.numeric(str_replace_all(findex1$Clsdt,"-","")))%>%select(-2))[,c(1,3,2)]
cs<-filter(findex1,Stkcd=="金融(风格.中信)")%>%rename(Cdretwdos=Dretwd)%>%select(-1)
cs1<-filter(findex1,Stkcd=="银行(中信)")
cs2<-filter(findex1,Stkcd=="证券Ⅱ(中信)")
cs3<-filter(findex1,Stkcd=="保险Ⅱ(中信)")
cs4<-filter(findex1,Stkcd=="信托(中信)")
## 读取无风险利率
wf<-read_excel("wf.xlsx",sheet = 1)%>%slice(-(1L:2L))%>%select(-1,-4)
wf1<-data.frame(Trdmnt=as.numeric(str_replace_all(wf$Clsdt,"-","")),Nrrdaydt=as.numeric(wf$Nrrdaydt))
# 计算出银行、证券、保险、信托四个市场系统性风险
## 求出银行系统性风险
rb1<-filter(cs1,Trdmnt>=20100920)%>%left_join(cs,by="Trdmnt")%>%left_join(wf1,by="Trdmnt")
d1=numeric();d11=numeric();d12=numeric()
for(i in 0:3){
  for(h in 0:3){
    if(i==3&h==2) break
    if(h<2){
    r1<-filter(rb1,Trdmnt>=(20100920+300*h+10000*i),Trdmnt<(20150920+300*h+10000*i))
    } else {r1<-filter(rb1,Trdmnt>=(20110320+300*(h-2)+10000*i),Trdmnt<(20160320+300*(h-2)+10000*i))}
    k<-round(nrow(r1)*varp)
    r2<-transmute(r1,rme=Cdretwdos/100-Nrrdaydt/100,rme=-rme)%>%arrange(rme)
    r3<-slice(r2,(nrow(r1)-k+1):n())
    r4<-transmute(r3,lrme=log(rme));a<-sum(r4)       
    α1<-1/k*a-log(as.numeric(slice(r2,nrow(r1)-k))) #得出 Hill estimator
    r5<-mutate(r1,rje=-(Dretwd/100-Nrrdaydt/100),rme=-(Cdretwdos/100-Nrrdaydt/100))
    b<-(arrange(r5,rme)%>%slice(n()-round(n()*varp)))[1,7] #市场VAR
    f<-(arrange(r5,rje)%>%slice(n()-round(n()*varp)))[1,6] #个股VAR
    c<-data.frame(r5,frje=f,frme=b)
    c1<-mutate(c,t=ifelse(rje>frje&rme>frme,1,0),tt=ifelse(rme>frme,1,0))
    τ<-sum(c1$t)/sum(c1$tt) 
    varm<-b
    varj<-f
    d1[[i*4+(h+1)]]<-(τ^α1)*varj/varm;d11[[i*4+(h+1)]]<-(τ^α1);d12[[i*4+(h+1)]]<-varj/varm
    }}

求出证券系统性风险

rb2<-filter(cs2,Trdmnt>=20100920)%>%left_join(cs,by="Trdmnt")%>%left_join(wf1,by="Trdmnt")
d2=numeric();d21=numeric();d22=numeric()
for(i in 0:3){
  for(h in 0:3){
    if(i==3&h==2) break
    if(h<2){
      r1<-filter(rb2,Trdmnt>=(20100920+300*h+10000*i),Trdmnt<(20150920+300*h+10000*i))
    } else {r1<-filter(rb2,Trdmnt>=(20110320+300*(h-2)+10000*i),Trdmnt<(20160320+300*(h-2)+10000*i))}
    k<-round(nrow(r1)*varp)
    r2<-transmute(r1,rme=Cdretwdos/100-Nrrdaydt/100,rme=-rme)%>%arrange(rme)
    r3<-slice(r2,(nrow(r1)-k+1):n())
    r4<-transmute(r3,lrme=log(rme));a<-sum(r4)       
    α1<-1/k*a-log(as.numeric(slice(r2,nrow(r1)-k))) #得出 Hill estimator
    r5<-mutate(r1,rje=-(Dretwd/100-Nrrdaydt/100),rme=-(Cdretwdos/100-Nrrdaydt/100))
    b<-(arrange(r5,rme)%>%slice(n()-round(n()*varp)))[1,7] #市场VAR
    f<-(arrange(r5,rje)%>%slice(n()-round(n()*varp)))[1,6] #个股VAR
    c<-data.frame(r5,frje=f,frme=b)
    c1<-mutate(c,t=ifelse(rje>frje&rme>frme,1,0),tt=ifelse(rme>frme,1,0))
    τ<-sum(c1$t)/sum(c1$tt) 
    varm<-b
    varj<-f
    d2[[i*4+(h+1)]]<-(τ^α1)*varj/varm;d21[[i*4+(h+1)]]<-(τ^α1);d22[[i*4+(h+1)]]<-varj/varm
  }}

求出保险系统性风险

rb3<-filter(cs3,Trdmnt>=20100920)%>%left_join(cs,by="Trdmnt")%>%left_join(wf1,by="Trdmnt")
d3=numeric();d31=numeric();d32=numeric()
for(i in 0:3){
  for(h in 0:3){
    if(i==3&h==2) break
    if(h<2){
      r1<-filter(rb3,Trdmnt>=(20100920+300*h+10000*i),Trdmnt<(20150920+300*h+10000*i))
    } else {r1<-filter(rb3,Trdmnt>=(20110320+300*(h-2)+10000*i),Trdmnt<(20160320+300*(h-2)+10000*i))}
    k<-round(nrow(r1)*varp)
    r2<-transmute(r1,rme=Cdretwdos/100-Nrrdaydt/100,rme=-rme)%>%arrange(rme)
    r3<-slice(r2,(nrow(r1)-k+1):n())
    r4<-transmute(r3,lrme=log(rme));a<-sum(r4)       
    α1<-1/k*a-log(as.numeric(slice(r2,nrow(r1)-k))) #得出 Hill estimator
    r5<-mutate(r1,rje=-(Dretwd/100-Nrrdaydt/100),rme=-(Cdretwdos/100-Nrrdaydt/100))
    b<-(arrange(r5,rme)%>%slice(n()-round(n()*varp)))[1,7] #市场VAR
    f<-(arrange(r5,rje)%>%slice(n()-round(n()*varp)))[1,6] #个股VAR
    c<-data.frame(r5,frje=f,frme=b)
    c1<-mutate(c,t=ifelse(rje>frje&rme>frme,1,0),tt=ifelse(rme>frme,1,0))
    τ<-sum(c1$t)/sum(c1$tt) 
    varm<-b
    varj<-f
    d3[[i*4+(h+1)]]<-(τ^α1)*varj/varm;d31[[i*4+(h+1)]]<-(τ^α1);d32[[i*4+(h+1)]]<-varj/varm
  }}

求出信托系统性风险

rb4<-filter(cs4,Trdmnt>=20100920)%>%left_join(cs,by="Trdmnt")%>%left_join(wf1,by="Trdmnt")
d4=numeric();d41=numeric();d42=numeric()
for(i in 0:3){
  for(h in 0:3){
    if(i==3&h==2) break
    if(h<2){
      r1<-filter(rb4,Trdmnt>=(20100920+300*h+10000*i),Trdmnt<(20150920+300*h+10000*i))
    } else {r1<-filter(rb4,Trdmnt>=(20110320+300*(h-2)+10000*i),Trdmnt<(20160320+300*(h-2)+10000*i))}
    k<-round(nrow(r1)*varp)
    r2<-transmute(r1,rme=Cdretwdos/100-Nrrdaydt/100,rme=-rme)%>%arrange(rme)
    r3<-slice(r2,(nrow(r1)-k+1):n())
    r4<-transmute(r3,lrme=log(rme));a<-sum(r4)       
    α1<-1/k*a-log(as.numeric(slice(r2,nrow(r1)-k))) #得出 Hill estimator
    r5<-mutate(r1,rje=-(Dretwd/100-Nrrdaydt/100),rme=-(Cdretwdos/100-Nrrdaydt/100))
    b<-(arrange(r5,rme)%>%slice(n()-round(n()*varp)))[1,7] #市场VAR
    f<-(arrange(r5,rje)%>%slice(n()-round(n()*varp)))[1,6] #个股VAR
    c<-data.frame(r5,frje=f,frme=b)
    c1<-mutate(c,t=ifelse(rje>frje&rme>frme,1,0),tt=ifelse(rme>frme,1,0))
    τ<-sum(c1$t)/sum(c1$tt) 
    varm<-b
    varj<-f
    d4[[i*4+(h+1)]]<-(τ^α1)*varj/varm;d41[[i*4+(h+1)]]<-(τ^α1);d42[[i*4+(h+1)]]<-varj/varm
  }}
#

通过图像表现各部门风险

## 系统性风险
p<-data.frame(Trdmnt=seq(as.Date("2015/9/20"),as.Date("2018/12/20"),"quarter"),"银行"=d1,"证券"=d2,"保险"=d3,"信托"=d4)
apply(select(p,-1),2,mean)
p<-melt(p,id.vars="Trdmnt")
p1<-ggplot(p,aes(x=Trdmnt,y=value))+geom_line(size=1,aes(color=variable))+labs(x="时间",y="系统性风险")
## 传染性风险
p<-data.frame(Trdmnt=seq(as.Date("2015/9/20"),as.Date("2018/12/20"),"quarter"),"银行"=d11,"证券"=d21,"保险"=d31,"信托"=d41)
apply(select(p,-1),2,mean)
p<-melt(p,id.vars="Trdmnt")
p2<-ggplot(p,aes(x=Trdmnt,y=value))+geom_line(size=1,aes(color=variable))+labs(x="时间",y="传染性风险")
## 个体风险
p<-data.frame(Trdmnt=seq(as.Date("2015/9/20"),as.Date("2018/12/20"),"quarter"),"银行"=d12,"证券"=d22,"保险"=d32,"信托"=d42)
apply(select(p,-1),2,mean)
p<-melt(p,id.vars="Trdmnt")
p3<-ggplot(p,aes(x=Trdmnt,y=value))+geom_line(size=1,aes(color=variable))+labs(x="时间",y="机构尾部风险")
# 合为一图
ggarrange(p1,ggarrange(p2,p3,ncol=2),nrow=2)

如下图：

简单利用plot画图

p<-data.frame(Trdmnt=seq(as.Date("2015/9/20"),as.Date("2018/12/20"),"quarter"),"银行"=d1,"证券"=d2,"保险"=d3,"信托"=d4)
apply(select(p,-1),2,mean)
x<-p[,1];y<-p[,2];z<-p[,3];w<-p[,4];e<-p[,5]

a<-plot(x,y,type="o",xlab="年份",ylab="",ylim=c(0.65,1.3),col="red",main="系统性风险",pch=c(15))
lines(x,z,type="o",col="blue",pch=c(16)) 
lines(x,w,type="o",col="green",pch=c(17)) 
lines(x,e,type="o",col="black",pch=c(18)) 
legend("topleft",c("银行","证券","保险","信托"),col=c("red","blue","green","black"),pch=15:18)

如下图：