上市公司尾部风险测度检验（基于风险调整收益率）部三

进一步挑选出市场月收益率处于尾部损失时间范围

# 左右尾分布：
## 1月：
ys<-distinct(y5,Trdmnt,.keep_all = TRUE)%>%filter(Trdmnt>=199801&Trdmnt<=201812)%>%arrange(ecm)

##季度化月收益：
ys1<-distinct(y5,Trdmnt,.keep_all = TRUE)%>%filter(Trdmnt>=200001&Trdmnt<=201812)%>%select(1,2,7)%>%mutate(re=Cmretwdos+1)%>%arrange(Trdmnt)
ys2<-slice(ys1,-(1:2))%>%tbl_df()%>%select(-1,-3)
ys3<-slice(ys1,-1)%>%slice(-n())%>%tbl_df()%>%select(-1,-3)
ys4<-slice(ys1,-((n()-1):n()))%>%tbl_df()%>%select(-1,-3)
ys5<-bind_cols(ys2,ys3,ys4)%>%mutate(Mretwd=re*re1*re2-1)%>%select(1,7) 
wf1<-read_excel("wf.xlsx",sheet = 1)%>%slice(-(1:2))
wf2<-(data.frame(wf1,Trdmnt=as.numeric(str_sub(str_replace_all(wf1$Clsdt,"-",""),start=1L,end=6L)))%>%select(3,7))[,c(2,1)]
wf<-distinct(wf2,Trdmnt,.keep_all = TRUE)%>%arrange(Trdmnt)%>%mutate(Nrrdata=as.numeric(Nrrdata)/100)
wf<-mutate(wf,nr3=(Nrrdata+1)^(1/4)-1)# 年度无风险收益率季度化
ys6<-inner_join(ys5,wf,by="Trdmnt")%>%mutate(eMretwd=(Mretwd-nr3+1)^(1/3)-1)%>%arrange(Trdmnt) # 季度超额收益率月度化（匹配3月的无风险收益率）
ys<-data.frame(select(filter(ys1,Trdmnt<201811),2),ecm=ys6$eMretwd)%>%arrange(ecm)

##半年化月收益: 
ys1<-distinct(y5,Trdmnt,.keep_all = TRUE)%>%filter(Trdmnt>=200001&Trdmnt<=201812)%>%select(1,2,7)%>%mutate(re=Cmretwdos+1)%>%arrange(Trdmnt)
ys2<-slice(ys1,-(1:5))%>%tbl_df()%>%select(-1,-3)
ys3<-slice(ys1,-(1:4))%>%slice(-n())%>%tbl_df()%>%select(-1,-3)
ys4<-slice(ys1,-(1:3))%>%slice(-((n()-1):n()))%>%tbl_df()%>%select(-1,-3)
ys5<-slice(ys1,-(1:2))%>%slice(-((n()-2):n()))%>%tbl_df()%>%select(-1,-3)
ys6<-slice(ys1,-1)%>%slice(-((n()-3):n()))%>%tbl_df()%>%select(-1,-3)
ys7<-slice(ys1,-((n()-4):n()))%>%tbl_df()%>%select(-1,-3)
ys8<-bind_cols(ys2,ys3,ys4,ys5,ys6,ys7)%>%mutate(Mretwd=re*re1*re2*re3*re4*re5-1)%>%select(1,13)
wf1<-read_excel("wf.xlsx",sheet = 1)%>%slice(-(1:2))
wf2<-(data.frame(wf1,Trdmnt=as.numeric(str_sub(str_replace_all(wf1$Clsdt,"-",""),start=1L,end=6L)))%>%select(3,7))[,c(2,1)]
wf<-distinct(wf2,Trdmnt,.keep_all = TRUE)%>%arrange(Trdmnt)%>%mutate(Nrrdata=as.numeric(Nrrdata)/100)
wf<-mutate(wf,nr6=(Nrrdata+1)^(1/2)-1)# 年度无风险收益率半年度化
ys9<-inner_join(ys8,wf,by="Trdmnt")%>%mutate(eMretwd=(Mretwd-nr6+1)^(1/6)-1)%>%arrange(Trdmnt) # 半年度超额收益率月度化
ys<-data.frame(select(filter(ys1,Trdmnt<201808),2),ecm=ys9$eMretwd)%>%arrange(ecm)

#左尾
s<-slice(ys,1:(0.05*n()))
#右尾
s<-slice(ys,(n()-0.05*n()+1):n())
# 计算分位数值:  slice(ys,0.5*n())$ecm;slice(ys,n()-0.5*n()+1)$ecm
# 1月：-12.5%,15.8%;-8.5%,12%;-5.4%,6.5%;-3.3%,4%;0.9%,0.9%
# 3月：
# 6月：

# 直接生成表格
##根据尾部贝塔值分组
m1=numeric();m2=numeric();m3=numeric();m4=numeric();m5=numeric();m6=numeric()
# 投资组合收益率
for(o in 1:2){
  for(i in 1:5){
    m1[i+(o-1)*12]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"b",o),get)[[i]]),s,by="Trdmnt")$zsy)}
  m1[i+(o-1)*12+1]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"b",o),get)[[1]]),s,by="Trdmnt")$zsy
                        -semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"b",o),get)[[5]]),s,by="Trdmnt")$zsy)
  
  for(i in 1:5){
    m1[i+(o-1)*12+6]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"b",o),get)[[i]]),s,by="Trdmnt")$zsy)$statistic[[1]]}
  m1[i+(o-1)*12+7]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"b",o),get)[[1]]),s,by="Trdmnt")$zsy
                          -semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"b",o),get)[[5]]),s,by="Trdmnt")$zsy)$statistic[[1]]}

#投资组合收益率经过CAPM模型回归的截距项
for(o in 1:2){
  for(i in 1:5){
    m2[i+(o-1)*12]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"d",o),get)[[i]]),s,by="Trdmnt")$zsy)}
  m2[i+(o-1)*12+1]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"d",o),get)[[1]]),s,by="Trdmnt")$zsy
                        -semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"d",o),get)[[5]]),s,by="Trdmnt")$zsy)
  
  for(i in 1:5){
    m2[i+(o-1)*12+6]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"d",o),get)[[i]]),s,by="Trdmnt")$zsy)$statistic[[1]]}
  m2[i+(o-1)*12+7]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"d",o),get)[[1]]),s,by="Trdmnt")$zsy
                          -semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"d",o),get)[[5]]),s,by="Trdmnt")$zsy)$statistic[[1]]}

#投资组合收益率经过FF3模型回归的截距项
for(o in 1:2){
  for(i in 1:5){
    m3[i+(o-1)*12]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"e",o),get)[[i]]),s,by="Trdmnt")$zsy)}
  m3[i+(o-1)*12+1]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"e",o),get)[[1]]),s,by="Trdmnt")$zsy
                        -semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"e",o),get)[[5]]),s,by="Trdmnt")$zsy)
  
  for(i in 1:5){
    m3[i+(o-1)*12+6]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"e",o),get)[[i]]),s,by="Trdmnt")$zsy)$statistic[[1]]}
  m3[i+(o-1)*12+7]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"e",o),get)[[1]]),s,by="Trdmnt")$zsy
                          -semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"e",o),get)[[5]]),s,by="Trdmnt")$zsy)$statistic[[1]]}

#投资组合收益率经过FF5模型回归的截距项
for(o in 1:2){
  for(i in 1:5){
    m4[i+(o-1)*12]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"g",o),get)[[i]]),s,by="Trdmnt")$zsy)}
  m4[i+(o-1)*12+1]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"g",o),get)[[1]]),s,by="Trdmnt")$zsy
                        -semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"g",o),get)[[5]]),s,by="Trdmnt")$zsy)
  
  for(i in 1:5){
    m4[i+(o-1)*12+6]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"g",o),get)[[i]]),s,by="Trdmnt")$zsy)$statistic[[1]]}
  m4[i+(o-1)*12+7]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"g",o),get)[[1]]),s,by="Trdmnt")$zsy
                          -semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,zsy=lapply(paste0("a",0:4,"g",o),get)[[5]]),s,by="Trdmnt")$zsy)$statistic[[1]]}

mm1<-matrix(c(m1,m2,m3,m4),16,6,byrow=TRUE)
#经过规模细分的投资组合收益率经过FF5模型回归的截距项
for(o in 1:2){
  for(v in 1:5){
    for(l in 1:5){
      m5[l+(v-1)*5+(o-1)*60]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,eMretwd=lapply(paste0("a",0:4,"f",o),get)[[v]][[l]]),s,by="Trdmnt")$eMretwd)}}
  for(l in 1:5){
    m5[l+(v-1)*5+(o-1)*60+5]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,eMretwd=lapply(paste0("a",0:4,"f",o),get)[[1]][[l]]-lapply(paste0("a",0:4,"f",o),get)[[5]][[l]]),s,by="Trdmnt")$eMretwd)}
  
  for(v in 1:5){
    for(l in 1:5){
      m5[l+(v-1)*5+(o-1)*60+30]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,eMretwd=lapply(paste0("a",0:4,"f",o),get)[[v]][[l]]),s,by="Trdmnt")$eMretwd)$statistic[[1]]}}
  for(l in 1:5){
    m5[l+(v-1)*5+(o-1)*60+35]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,eMretwd=lapply(paste0("a",0:4,"f",o),get)[[1]][[l]]-lapply(paste0("a",0:4,"f",o),get)[[5]][[l]]),s,by="Trdmnt")$eMretwd)$statistic[[1]]}}

# 平均
for(o in 1:2){
  for(v in 1:5){
    m6[v+(o-1)*12]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,eMretwd=apply(do.call("cbind",lapply(paste0("a",0:4,"f",o),get)[[v]]),1,mean)),s,by="Trdmnt")$eMretwd)}
  m6[v+(o-1)*12+1]=mean(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,eMretwd=apply(do.call("cbind",lapply(paste0("a",0:4,"f",o),get)[[1]]),1,mean)-apply(do.call("cbind",lapply(paste0("a",0:4,"f",o),get)[[5]]),1,mean)),s,by="Trdmnt")$eMretwd)
  
  for(v in 1:5){   
    m6[v+(o-1)*12+6]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,eMretwd=apply(do.call("cbind",lapply(paste0("a",0:4,"f",o),get)[[v]]),1,mean)),s,by="Trdmnt")$eMretwd)$statistic[[1]]}
  m6[v+(o-1)*12+7]=t.test(semi_join(data.frame(Trdmnt=arrange(ys,Trdmnt)$Trdmnt,eMretwd=apply(do.call("cbind",lapply(paste0("a",0:4,"f",o),get)[[1]]),1,mean)-apply(do.call("cbind",lapply(paste0("a",0:4,"f",o),get)[[5]]),1,mean)),s,by="Trdmnt")$eMretwd)$statistic[[1]]}
mm2<-matrix(m6,4,6,byrow = TRUE)
mm3<-rbind(mm1,matrix(m5[1:30],5,6),mm2[1,],matrix(m5[31:60],5,6),mm2[2,],matrix(m5[61:90],5,6),mm2[3,],matrix(m5[91:120],5,6),mm2[4,])
write.csv(mm3,"E:/R/tail risk/table/mm.csv",row.names = FALSE)