#===========================================================
# R CODE FOR SIMULATION STUDY AND EXAMPLE IN
#   "COPULA-BASED MEASURES OF ASYMMETRY BETWEEN
#    THE LOWER AND UPPER TAIL PROBABILITIES"
#
#    BY SHOGO KATO, TOSHINAO YOSHIBA AND SHINTO EGUCHI  
#===========================================================

library(parallel)
library(MASS)
source("Functions.R")



#===========================================================
# Simulation study in Section 5.5
#===========================================================

set.seed(10)

# random variate generation 
n=1000  # number of sample
theta=20  # parameter for Clayton copula
clay=claytonCopula(theta,dim=2)
u=rCopula(n,clay)
x=u
x[,1]=qcauchy(u[,1]) 
x[,2]=qcauchy(u[,2]) 


### alpha^hat and its asymptotic confidence intervals

# set of indices defined by {u in [u_{min},0.5); alpha(u_i)!=alpha(u_{i+1}) } 
u_min=0.03
ten_ulevel=find_ulevel_mod2(u,u_min)
ulevel_set=ten_ulevel

# alpha^hat and its asymptotic confidence intervals
p=0.1  # value to construct 100*(1-p)% confidence interval
xvals_hat=ulevel_set
yvals_hat_bounds=matrix(1,length(xvals_hat),2)
yvals_hat=NULL
for(j in 1:length(xvals_hat)){
  yvals_hat[j]=alpha_hat(u,xvals_hat[j])
  yvals_hat_bounds[j,]=alpha_hat_ci(u,xvals_hat[j],p)
}


### alpha^* and its bootstrap confidence intervals

# copula sample transformed from original data
u_star=mkPseudoDat(x)$u

# set of indices defined by {u in [u^*_{min},0.5); alpha^*(u_i)!=alpha^*(u_{i+1}) } 
u_star_min=u_min # ten_ulevel_star[[1]]
ten_ulevel_star=find_ulevel_mod2(u_star,u_star_min)
ulevel_star_sub=ten_ulevel_star

# values of alpha^*
xvals_star=ulevel_star_sub
yvals_star=NULL
for(j in 1:length(xvals_star)) yvals_star[j]=alpha_hat(u_star,xvals_star[j])

# bootstrap confidence intervals of alpha^*
ex.df=data.frame(xvals_star)

ncores=10  # number of cores used for parallel computing
clus=makeCluster(ncores)

clusterExport(clus,"alpha_star")
clusterExport(clus,"mkPseudoDat")
clusterExport(clus,"u_star")
clusterExport(clus,"alpha_star_ci")
clusterExport(clus,"boot")
clusterExport(clus,"boot.ci")
clusterExport(clus,"p")

format(Sys.time(), "%Y/%m/%d %H:%M:%OS")

boot_result=parRapply(clus,ex.df,function(x) alpha_star_ci(x,u_star,p))

stopCluster(clus)

format(Sys.time(), "%Y/%m/%d %H:%M:%OS")

yvals_star_bounds=matrix(1,length(xvals_star),2)
for(j in 1:length(xvals_star)){
  yvals_star_bounds[j,1]=boot_result[2*j-1]
  yvals_star_bounds[j,2]=boot_result[2*j]
}


### Plot for paper: Figure 3

# theoretical values of alpha^hat and alpha^*
theo_alpha_hat=alpha_clay(xvals_hat,theta)
theo_alpha_star=alpha_clay(xvals_star,theta)

# range of plot
u_min=max(u_min,u_star_min)
u_min # value of u_min
min_yvals=min(yvals_hat_bounds[,1]-theo_alpha_hat,yvals_star_bounds[,1]-theo_alpha_star)
max_yvals=max(yvals_hat_bounds[,2]-theo_alpha_hat,yvals_star_bounds[,2]-theo_alpha_star)

# plot for paper: Figure 3
plot(xvals_hat,yvals_hat-theo_alpha_hat,type="l",xlab="u",ylab="diff",xlim=c(u_min,0.5),ylim=c(min_yvals,max_yvals),col="red",lwd=1)
par(new=T)
plot(xvals_star,yvals_star-theo_alpha_star,type="l",xlab="",ylab="",xlim=c(u_min,0.5),ylim=c(min_yvals,max_yvals),col="purple",lwd=1,lty=2,axes=FALSE)
par(new=T)
plot(xvals_hat,yvals_hat_bounds[,1]-theo_alpha_hat,type="l",xlab="",ylab="",xlim=c(u_min,0.5),ylim=c(min_yvals,max_yvals),col="black",lwd=1,lty=4,axes=FALSE)
axis(4)
par(new=T)
plot(xvals_hat,yvals_hat_bounds[,2]-theo_alpha_hat,type="l",xlab="",ylab="",xlim=c(u_min,0.5),ylim=c(min_yvals,max_yvals),col="black",lwd=1,lty=4,axes=FALSE)
par(new=T)
plot(xvals_star,yvals_star_bounds[,1]-theo_alpha_star,type="l",xlab="",ylab="",xlim=c(u_min,0.5),ylim=c(min_yvals,max_yvals),col="blue",lwd=1,lty=3,axes=FALSE)
par(new=T)
plot(xvals_star,yvals_star_bounds[,2]-theo_alpha_star,type="l",xlab="",ylab="",xlim=c(u_min,0.5),ylim=c(min_yvals,max_yvals),col="blue",lwd=1,lty=3,axes=FALSE) # W604*H431




### Coverage probability that the asymptotic confidence intervals include the true alpha(u)

# asymptotic confidence intervals
n_vec=c(100,250,1000,5000)  # number of sample
theta=1  # parameter for Clayton copula: theta=20 for (a) and theta=1 for (b)
clay=claytonCopula(theta,dim=2)
ulevel_set=(1:50)/100 # values of u
p=0.1 # value to construct 100*(1-p)% confidence interval

format(Sys.time(), "%Y/%m/%d %H:%M:%OS")

coverage_prob=coverage_alpha(n_vec,ulevel_set,theta,p)

format(Sys.time(), "%Y/%m/%d %H:%M:%OS")


# plot for paper: Figure 4
plot_rangex=c(0,0.2)
plot_rangey=c(0.85,1)
prob_bound=qnorm(p/2)*sqrt(p*(1-p)/1000) # r=1000
plot(ulevel_set,coverage_prob[4,],type="l",xlab="u",ylab="coverage probability",xlim=plot_rangex,ylim=plot_rangey,lty=1,lwd=1,col="black")
segments(-1,1-p,1,1-p,col="gray",lwd=1,lty=1)
segments(-1,1-p+prob_bound,1,1-p+prob_bound,col="gray",lwd=1,lty=2)
segments(-1,1-p-prob_bound,1,1-p-prob_bound,col="gray",lwd=1,lty=2)
par(new=T)
plot(ulevel_set,coverage_prob[4,],type="l",xlab="",ylab="",xlim=plot_rangex,ylim=plot_rangey,lty=1,lwd=1,col="black")
par(new=T)
plot(ulevel_set,coverage_prob[3,],type="l",xlab="",ylab="",xlim=plot_rangex,ylim=plot_rangey,lty=2,lwd=1,col="red")
par(new=T)
plot(ulevel_set,coverage_prob[2,],type="l",xlab="",ylab="",xlim=plot_rangex,ylim=plot_rangey,lty=3,lwd=1,col="blue")
par(new=T)
plot(ulevel_set,coverage_prob[1,],type="l",xlab="",ylab="",xlim=plot_rangex,ylim=plot_rangey,lty=4,lwd=1,col="purple") # W410*H400


# Minimum of the expected values of observations in the lower and those in the upper tail. 

n=5000
u=0.03
theta=1
min((2*u-1+clayton(1-u,1-u,theta)),clayton(u,u,theta))*n



#===========================================================
# Example in Section 6
#===========================================================

### Dataset used for analysis

# Before implementing the code below, please do the following three steps to prepare for the data used in Section 6.
#
# [Step 1] Please download daily stock prices of S&P500 and Nikkei225 from Yahoo Finance at https://finance.yahoo.com/quote/%5EGSPC/history/ and https://finance.yahoo.com/quote/%5EN225/history/ , respectively. The settings used in our paper are: "Time Period: March 31, 2008--April 1, 2013", "Show: Historical Prices", and "Frequency: Daily".
#
# [Step 2] Please produce a .csv file named "StockPrice.csv" in which the first column is the date (Date), the second column is the closing price (Close) of S&P500, and the third column is the closing price (Close) of Nikkei225.
#
# [Step 3] Please place the .csv file produced in Step 2 in the same folder as the R codes. 

filename="StockPrice.csv"  # name of the file providing data
obsPeriod <- "2008-04-01::2013-03-31"  # period of observations
spec <- ugarchspec(mean.model=list(armaOrder=c(1,0)),distribution.model="std")  # AR(1)-GARCH(1,1) with student t marginals
res=stdResStocks(filename,obsPeriod,spec,c(1,2))  # residuals of AR(1)-GARCH(1,1) fitted to daily returns of S&P500 and Nikkei225

### alpha^hat and its asymptotic confidence intervals

# transformation into copula sample
x=u=res$x
para_x1=fitdistr(x[,1],densfun="t")$estimate
u[,1]=pt((x[,1]-para_x1[1])/para_x1[2],df=para_x1[3])
para_x2=fitdistr(x[,2],densfun="t")$estimate
u[,2]=pt((x[,2]-para_x2[1])/para_x2[2],df=para_x2[3])

# set of indices defined by {u in [u_{min},0.5); alpha(u_i)!=alpha(u_{i+1}) } 
ten_ulevel=find_ulevel(u)
u_min=ten_ulevel[[1]]
u_min # value of u_min
ulevel_set=ten_ulevel[[2]]

# alpha^hat and its asymptotic confidence intervals
p=0.1  # value to construct 100*(1-p)% confidence intervals 
xvals_hat=ulevel_set
yvals_hat_bounds=matrix(1,length(xvals_hat),2)
yvals_hat=NULL
for(j in 1:length(xvals_hat)){
  yvals_hat[j]=alpha_hat(u,xvals_hat[j])
  yvals_hat_bounds[j,]=alpha_hat_ci(u,xvals_hat[j],p)
}

# plot of alpha^hat and its confidence intervals: Figure 5(d)
min_yvals_hat=min(yvals_hat_bounds[,1])
max_yvals_hat=max(yvals_hat_bounds[,2])

plot(xvals_hat,yvals_hat,type="l",xlab="u",ylab="alpha^hat",xlim=c(u_min,0.5),ylim=c(min_yvals_hat,max_yvals_hat),col="black",lwd=1)
polygon(c(xvals_hat,rev(xvals_hat)),c(yvals_hat_bounds[,1],rev(yvals_hat_bounds[,2])),col=gray(0.8),border=NA)
segments(-2,0,2,0,col=gray(0.3),lwd=1,lty=1)
par(new=T)
plot(xvals_hat,yvals_hat,type="l",xlab="",ylab="",xlim=c(u_min,0.5),ylim=c(min_yvals_hat,max_yvals_hat),col="black",lwd=1)

# test based on the test statistic in Theorem 5
u_vec=u_min+(0:4)*(0.15-u_min)/4
alpha0=function(x) 0
a_test(u,u_vec,alpha0) # c(value of test statistic, p-value)

###  Measure of Rosco and Joe (2013) 

# calculation of the measure using parallel computing
N=nrow(u)
xx=yy=1:(N^2)

for (jj in 1:N){
  for (kk in 1:N){
    current=N*(jj-1)+kk
    xx[current]=u[jj,1]
    yy[current]=u[kk,2]
  }}

ex.df=data.frame(xx,yy)

ncores=10  # number of cores used for parallel computing
clus=makeCluster(ncores)
clusterExport(clus,"rosco_joe_ele")
clusterExport(clus,"u")

format(Sys.time(), "%Y/%m/%d %H:%M:%OS")

rj_result=parRapply(clus,ex.df,function(x) rosco_joe_ele(u,x[1],x[2]))

stopCluster(clus)

format(Sys.time(), "%Y/%m/%d %H:%M:%OS")

max_rj=max(rj_result)
which_rj=which(rj_result==max_rj)
num_u1=((which_rj-1)%/%N)+1
num_u2=((which_rj-1)%%N)+1
num_u_len=length(num_u1)
max_rj_value=1:num_u_len
max_rj_arg=matrix(1,num_u_len,2)
for(j in 1:num_u_len){
  max_rj_value[j]=rosco_joe_ele(u,u[num_u1[[j]],1],u[num_u2[[j]],2])
  max_rj_arg[j,]=c(u[num_u1[[j]],1],u[num_u2[[j]],2])
}

# results
max_rj_value  # value of the measure of Rosco and Joe (2013)
max_rj_arg  # set of the vectors {(u1,u2)} which maximize the measure


### A modified version of the measure of Krupskii (2017)

# weighting functions
a1=function(x) x
a2=function(x) x^2
a3=function(x) x^4

# set of indices defined by {u in [u_{min},0.5); alpha(u_i)!=alpha(u_{i+1}) } (for comparison with the proposed measure)
ten_ulevel_kr=find_ulevel(u)
u_min_kr=ten_ulevel_kr[[1]]
u_min_kr # minimum value of u for Figure 5(c)
ulevel_set_kr=ten_ulevel_kr[[2]]

# calculation of the measure
xvals_kr=ulevel_set_kr
kr_rho1=kr_rho2=kr_rho3=NULL

for(j in 1:length(xvals_kr)){
  kr_rho1[j]=krup_rho(u,xvals_kr[j],a1)
  kr_rho2[j]=krup_rho(u,xvals_kr[j],a2)
  kr_rho3[j]=krup_rho(u,xvals_kr[j],a3)
}

# plot of the measure: Figure 5(c)
max_kr=max(kr_rho1,kr_rho2,kr_rho3)
min_kr=min(kr_rho1,kr_rho2,kr_rho3)

plot(xvals_kr,kr_rho1,type="l",xlab="u",ylab="measure",xlim=c(u_min_kr,0.5),ylim=c(min_kr,max_kr),col="black",lwd=1)
segments(-2,0,2,0,col="black",lwd=1,lty=1)
par(new=T)
plot(xvals_kr,kr_rho2,type="l",xlab="",ylab="",xlim=c(u_min_kr,0.5),ylim=c(min_kr,max_kr),col="blue",lwd=1,lty=2)
par(new=T)
plot(xvals_kr,kr_rho3,type="l",xlab="",ylab="",xlim=c(u_min_kr,0.5),ylim=c(min_kr,max_kr),col="red",lwd=1,lty=3)


### alpha^* and its bootstrap confidence intervals

# copula sample transformed via empirical distribution function
u_star=res$u


# plot of sample which the residuals are transformed into via the cdf of Student t-distribution: Figure 5(a)
plot_rangex=range(qnorm(u[,1]),qnorm(u_star[,1]))
plot_rangey=range(qnorm(u[,2]),qnorm(u_star[,2]))
plot(qnorm(u[,1]),qnorm(u[,2]),xlab="S&P500",ylab="Nikkei225",col="black",xlim=plot_rangex,ylim=plot_rangey,cex=0.2,pch=20)

# plot of sample which the residuals are transformed into via the empirical cdf: Figure 5(b)
# a=0.035
plot(qnorm(u_star[,1]),qnorm(u_star[,2]),xlab="S&P500",ylab="Nikkei225",col="black",xlim=plot_rangex,ylim=plot_rangey,cex=0.2,pch=20) 

# set of indices defined by {u in [u^*_{min},0.5); alpha^*(u_i)!=alpha^*(u_{i+1}) }
ten_ulevel_star=find_ulevel(u_star)
u_star_min=ten_ulevel_star[[1]]
u_star_min  # value of u^*_min
ulevel_star_sub=ten_ulevel_star[[2]]

# values of alpha^*
xvals_star=ulevel_star_sub
yvals_star=NULL
for(j in 1:length(xvals_star)) yvals_star[j]=alpha_hat(u_star,xvals_star[j])

# bootstrap confidence intervals of alpha^*
x=res$x

ex.df=data.frame(xvals_star)

ncores=10  # number of cores used for parallel computing
clus=makeCluster(ncores)
clusterExport(clus,"alpha_star")
clusterExport(clus,"mkPseudoDat")
clusterExport(clus,"xvals_star")
clusterExport(clus,"ulevel_star_sub")
clusterExport(clus,"x")
clusterExport(clus,"alpha_star_ci")
clusterExport(clus,"boot")
clusterExport(clus,"boot.ci")
clusterExport(clus,"p")

format(Sys.time(), "%Y/%m/%d %H:%M:%OS")

boot_result_star=parRapply(clus,ex.df,function(y) alpha_star_ci(y,x,p))

stopCluster(clus)

format(Sys.time(), "%Y/%m/%d %H:%M:%OS")

yvals_star_bounds=matrix(1,length(xvals_star),2)
for(j in 1:length(xvals_star)){
  yvals_star_bounds[j,1]=boot_result_star[2*j-1]
  yvals_star_bounds[j,2]=boot_result_star[2*j]
}

# plot for paper: Figure 5(e)
min_yvals=min(yvals_star_bounds[,1])
max_yvals=max(yvals_star_bounds[,2])

plot(xvals_star,yvals_star,type="l",xlab="u",ylab="alpha^star",xlim=c(u_star_min,0.5),ylim=c(min_yvals,max_yvals),col="black",lwd=1)
polygon(c(xvals_star,rev(xvals_star)),c(yvals_star_bounds[,1],rev(yvals_star_bounds[,2])),col=gray(0.8),border=NA)
segments(-2,0,2,0,col=gray(0.3),lwd=1)
par(new=T)
plot(xvals_star,yvals_star,type="l",xlab="",ylab="",xlim=c(u_star_min,0.5),ylim=c(min_yvals,max_yvals),col="black",lwd=1)