上市公司尾部风险测度检验(基于Fama-French α 检验)部二

挑选出样本范围内市场月收益率处于尾部损失的时间

# 左右尾分布:
## 月收益率:
ys<-distinct(y5,Trdmnt,.keep_all = TRUE)%>%filter(Trdmnt>=199601&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]]}

wf1<-filter(wy,Trdmnt>=199601,Trdmnt<201901)%>%arrange(Trdmnt)

#投资组合收益率经过CAPM模型回归的截距项
for(o in 1:2){
  for(i in 1:5){
  m2[i+(o-1)*12]=as.matrix(lm(eMretwd~mkt,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[i]]),s,by="Trdmnt"))$coefficients)[1]}
  m2[i+(o-1)*12+1]=as.matrix(lm(eMretwd~mkt,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[1]]-lapply(paste0("a",0:4,"b",o),get)[[5]]),s,by="Trdmnt"))$coefficients)[1]
  
  for(i in 1:5){   
  m2[i+(o-1)*12+6]=as.matrix(summary(lm(eMretwd~mkt,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[i]]),s,by="Trdmnt")))$coefficients)[1,3]}
  m2[i+(o-1)*12+7]=as.matrix(summary(lm(eMretwd~mkt,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[1]]-lapply(paste0("a",0:4,"b",o),get)[[5]]),s,by="Trdmnt")))$coefficients)[1,3]}

#投资组合收益率经过FF3模型回归的截距项
for(o in 1:2){
  for(i in 1:5){
  m3[i+(o-1)*12]=as.matrix(lm(eMretwd~mkt+smb+hml,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[i]]),s,by="Trdmnt"))$coefficients)[1]}
  m3[i+(o-1)*12+1]=as.matrix(lm(eMretwd~mkt+smb+hml,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[1]]-lapply(paste0("a",0:4,"b",o),get)[[5]]),s,by="Trdmnt"))$coefficients)[1]
  
  for(i in 1:5){   
  m3[i+(o-1)*12+6]=as.matrix(summary(lm(eMretwd~mkt+smb+hml,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[i]]),s,by="Trdmnt")))$coefficients)[1,3]}
  m3[i+(o-1)*12+7]=as.matrix(summary(lm(eMretwd~mkt+smb+hml,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[1]]-lapply(paste0("a",0:4,"b",o),get)[[5]]),s,by="Trdmnt")))$coefficients)[1,3]}

#投资组合收益率经过FF5模型回归的截距项
for(o in 1:2){
  for(i in 1:5){
  m4[i+(o-1)*12]=as.matrix(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[i]]),s,by="Trdmnt"))$coefficients)[1]}
  m4[i+(o-1)*12+1]=as.matrix(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[1]]-lapply(paste0("a",0:4,"b",o),get)[[5]]),s,by="Trdmnt"))$coefficients)[1]
  
  for(i in 1:5){   
  m4[i+(o-1)*12+6]=as.matrix(summary(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[i]]),s,by="Trdmnt")))$coefficients)[1,3]}
  m4[i+(o-1)*12+7]=as.matrix(summary(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"b",o),get)[[1]]-lapply(paste0("a",0:4,"b",o),get)[[5]]),s,by="Trdmnt")))$coefficients)[1,3]}

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]=as.matrix(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"f",o),get)[[v]][[l]]),s,by="Trdmnt"))$coefficients)[1]}}
  for(l in 1:5){
  m5[l+(v-1)*5+(o-1)*60+5]=as.matrix(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"f",o),get)[[1]][[l]]-lapply(paste0("a",0:4,"f",o),get)[[5]][[l]]),s,by="Trdmnt"))$coefficients)[1]}
  
  for(v in 1:5){
    for(l in 1:5){
  m5[l+(v-1)*5+(o-1)*60+30]=as.matrix(summary(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"f",o),get)[[v]][[l]]),s,by="Trdmnt")))$coefficients)[1,3]}}
  for(l in 1:5){
  m5[l+(v-1)*5+(o-1)*60+35]=as.matrix(summary(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=lapply(paste0("a",0:4,"f",o),get)[[1]][[l]]-lapply(paste0("a",0:4,"f",o),get)[[5]][[l]]),s,by="Trdmnt")))$coefficients)[1,3]}}

# 平均
for(o in 1:2){
  for(v in 1:5){
  m6[v+(o-1)*12]=as.matrix(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=apply(do.call("cbind",lapply(paste0("a",0:4,"f",o),get)[[v]]),1,mean)),s,by="Trdmnt"))$coefficients)[1]}
  m6[v+(o-1)*12+1]=as.matrix(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,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"))$coefficients)[1]
  
  for(v in 1:5){   
  m6[v+(o-1)*12+6]=as.matrix(summary(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,eMretwd=apply(do.call("cbind",lapply(paste0("a",0:4,"f",o),get)[[v]]),1,mean)),s,by="Trdmnt")))$coefficients)[1,3]}
  m6[v+(o-1)*12+7]=as.matrix(summary(lm(eMretwd~mkt+smb+hml+rmw+cma,semi_join(data.frame(wf1,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")))$coefficients)[1,3]}
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)


  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值