/* integrand for emvndrh */
double r_grh(double z)
{ double pnorms(double),phi(double),a,b;
extern int mm;
extern double *ww,*xx,rs,r1,r32;
int i,k;
double tem,sum,tem2,*t;
t=(double *) malloc(mm * sizeof(double));
for(i=0;i<mm;i++)
{ a=(ww[i]-rs*z)/r1; b=(xx[i]-rs*z)/r1;
t[i]=pnorms(b)-pnorms(a);
}
for(k=0,sum=0.;k<mm;k++)
{ for(i=0,tem=1.;i<mm;i++)
{ if(i!=k) { tem*=t[i]; }
else
{ a=(ww[i]-rs*z)/r1; b=(xx[i]-rs*z)/r1;
tem2=phi(b)*(xx[i]-z/rs)-phi(a)*(ww[i]-z/rs);
tem2*=.5/r32;
tem*=tem2;
}
}
sum+=tem;
}
tem=sum*phi(z);
free(t);
return(tem);
}
/* P(Z_j\in (a_j,b_j)): deriv wrt rho */
void r_emvndrh(int *m, double *w, double *x, double *rh, double *eps,
double *deriv)
{ double r_grh(double),der,tem,sum;
double romberg(double (*)(double), double, double, double);
double pnorms(double),phi(double);
int i,k;
double *t;
extern int mm;
extern double *ww,*xx,rs,r1,r32;
mm=*m; rs=sqrt(*rh); r1=sqrt(1.-(*rh)); r32=r1*(1.-(*rh));
xx=(double *) malloc(mm * sizeof(double));
ww=(double *) malloc(mm * sizeof(double));
t=(double *) malloc(mm * sizeof(double));
for(i=0;i<mm;i++) { ww[i]=w[i]; xx[i]=x[i]; }
if((*rh)>=0.) der=romberg(r_grh,-UB,UB,*eps);
else /* rho=0 */
{ for(i=0;i<mm;i++) t[i]=pnorms(x[i])-pnorms(w[i]);
for(k=0,sum=0.;k<mm;k++)
{ for(i=0,tem=1.;i<mm;i++)
{ if(i!=k) { tem*=t[i]; }
else tem*=(x[i]*phi(x[i])-w[i]*phi(w[i]));
// maybe check if x>10 or w<-10?
}
sum+=tem;
}
der=.5*sum;
}
free(xx); free(ww); free(t);
*deriv=der;
}
/* integrand for emvnd */
double r_gd(double z)
{ double pnorms(double),phi(double),a,b;
extern int mm,kk;
extern double *ww,*xx,rs,r1;
int i;
double tem;
for(i=0,tem=1.;i<mm;i++)
{ if(i!=kk)
{ a=(ww[i]-rs*z)/r1; b=(xx[i]-rs*z)/r1;
tem*=pnorms(b)-pnorms(a);
}
else if(ksign==-1)
{ a=(ww[i]-rs*z)/r1; tem*=phi(a)/r1; }
else
{ b=(xx[i]-rs*z)/r1; tem*=phi(b)/r1; }
}
tem*=phi(z);
return(tem);
}
/* inputs
d0 = d = dimension
n0 = n = simulation sample size
AR(1)-GARCH(1,1) parameters (mu,ar1,om,alp1,be1,nu) for each asset
gmu = d-vector of mu or location parameters
gar1 = d-vector of AR1 parameters
gom = d-vector of omega parameters
galp1 = d-vector of alpha parameters
gbe1 = d-vector of beta parameters
gnu = d-vector of nu parameters for Student t innovations
gsig0 = d-vector of starting conditional SD values (one for each asset)
cpar = parameter vector for 1-factor copula
(dimension d for copcode=1,3,-3,5; 2*d for copcode=9, d+1 fo copcode=2)
copcode = copula code (see the above #define)
outputs
lgret0 = vector of length n*d of logreturns based on copula GARCH model
with 1-factor copula,
lgret is a vector for linking to R
portfret = n-vector of portfolio returns (average of d assets)
*/
void rgarch1fact(int *d0, int *n0, double *gmu, double *gar1, double *gom,
double *galp1, double *gbe1, double *gnu, double *gsig0,
double *cpar, int *copcode, double *lgret0, double *portfret)
//double **lgret, double *portfret)
{ int d,n,i,j,j0;
double *tscale,*sigma2,*mu1,*z,*eps,*uvec,u,sportf,tem,prev,df;
double qt(double,double),sqr(double),urand();
double pt_(double*,double*),pnorms(double);
void sim1fact(int *d, double *cpar, int * copcode, double *uvec);
void sim1factmvt(int *d, double *cpar, int *copcode, double *uvec);
n=*n0; d=*d0;
//for(i=0;i<n;i++) lgret[i]=lgret0+i*d; // set memory addresses
df=1000.;
if(*copcode==BVT) df=cpar[d];
#ifdef MAIN1F
for(j=0;j<d;j++)
{ printf("%d : %f %f %f %f %f %f %f\n", j,
gmu[j],gar1[j],gom[j],galp1[j],gbe1[j],gnu[j],gsig0[j]);
}
printf("copcode=%d\n", *copcode);
if(*copcode==BB1)
{ for(j=0;j<2*d;j++) printf("%f ", cpar[j]); printf("\n"); }
else
{ for(j=0;j<d;j++) printf("%f ", cpar[j]); printf("\n"); }
if(*copcode==BVT) { printf("df=%f ", df); printf("\n"); }
#endif
tscale=(double *) malloc(d * sizeof(double));
mu1=(double *) malloc(d * sizeof(double));
sigma2=(double *) malloc(d * sizeof(double));
eps=(double *) malloc(d * sizeof(double));
uvec=(double *) malloc(d * sizeof(double));
z=(double *) malloc(d * sizeof(double));
// set up temporary variables and initialize first observation
for(j0=0,sportf=0.;j0<d;j0++)
{ tscale[j0]=sqrt(1.-2./gnu[j0]); // multiplier so that variance of z's is 1
mu1[j0]=gmu[j0]/(1-gar1[j0]);
//sigma2[j0]=(gom[j0]+galp1[j0]*sqr(mu1[j0]))/(1.-gbe1[j0]);
sigma2[j0]=sqr(gsig0[j0]);
if(*copcode==BVN || *copcode==BVT)
{ sim1factmvt(&d,cpar,copcode,uvec);
if(*copcode==BVN) { for(j=0;j<d;j++) uvec[j]=pnorms(uvec[j]); }
else { for(j=0;j<d;j++) uvec[j]=pt_(&uvec[j],&df); }
}
else { sim1fact(&d,cpar,copcode,uvec); }
z[j0]=qt(uvec[j0],gnu[j0])*tscale[j0];
eps[j0]=z[j0]*gsig0[j0];
u=urand();
#ifdef MAIN1F
printf("%d : %f %f %f\n", j0,tscale[j0],mu1[j0],sigma2[j0]);
#endif
//lgret[0][j0]=mu1[j0]+0.05*(u-0.5);
lgret0[j0]=mu1[j0]+0.05*(u-0.5);
sportf = sportf + lgret0[j0];
}
portfret[0]=sportf/d;
// generate remaining observations
for(i=1;i<n;i++)
{ //printf("i=%d\n", i);
if(*copcode==BVN || *copcode==BVT)
{ sim1factmvt(&d,cpar,copcode,uvec);
if(*copcode==BVN) { for(j=0;j<d;j++) uvec[j]=pnorms(uvec[j]); }
else { for(j=0;j<d;j++) uvec[j]=pt_(&uvec[j],&df); }
}
else { sim1fact(&d,cpar,copcode,uvec); }
//for(j=0;j<d;j++) printf("%f ", uvec[j]); printf("\n");
for(j=0,sportf=0.;j<d;j++)
{ //sigma2[j] = gom[j] + galp1[j] * sqr(lgret[i-1][j]) + gbe1[j] * sigma2[j];
prev=lgret0[(i-1)*d+j];
sigma2[j] = gom[j] + galp1[j] * sqr(eps[j]) + gbe1[j] * sigma2[j];
z[j]=qt(uvec[j],gnu[j])*tscale[j];
eps[j]=z[j]*sqrt(sigma2[j]);
//tem = gmu[j] + gar1[j]*lgret[i-1][j] + z[j]*sqrt(sigma2[j]);
tem = gmu[j] + gar1[j]*prev + eps[j];
//lgret[i][j] = tem;
lgret0[i*d+j] = tem;
sportf = sportf + tem;
}
portfret[i]=sportf/d;
}
//for(j=0;j<d;j++) printf("%f ", lgret0[0+j]); printf("\n");
//for(j=0;j<d;j++) printf("%f ", lgret0[d+j]); printf("\n");
//for(j=0;j<d;j++) printf("%f ", lgret0[2*d+j]); printf("\n");
#ifdef MAIN1F
for(i=0;i<n;i++) printf("%f ", portfret[i]); printf("\n");
#endif
free(mu1); free(tscale); free(sigma2); free(eps); free(uvec); free(z);
}
void mvn1(int m, double w[], double x[], double r[][M], int nsim, double eps,
double *pr, double *sd, int *ifail)
/* first order approximation for conditional probabilities */
/* ref. Joe (1993). Approximations to Multivariate Normal Rectangle
Probabilities Based on Conditional Expectations*/
/* INPUT
m = dimension of multivariate normal probability
w = vector of lower bounds
x = vector of upper bounds
r = correlation matrix (1's on the diagonal)
nsim = number of random permutations used
[ nsim=0 for enumerating all permutations, otherwise random perms
nsim=0 recommended for m<=6 ]
eps = error bound for 2-D bivariate probabilities (1.e-6 recommended)
OUTPUT
pr = probability of rectangle: P(w_i<X_i<z_i, i=1,...,n)
sd = measurement of accuracy (SD from the permuted conditional prob's)
ifail = code for whether prob was succesfully computed
(ifail =0 for success, ifail >0 for failure)
ROUTINES CALLED (directly or indirectly):
mulnor (Schervish's MVN prob)
bivnor (Donnelly's bivariate normal upper quadrant prob)
pnorms (univariate standard normal cdf)
approx1, cond1 (approx to conditional probs)
nexper (generate permutations systematically)
isamp (generate random permutations)
gepp (linear system solver, Gaussian elim with partial pivoting)
*/
/* w[0], x[0], r[0][], r[][0] not used here */
/* No checks are done on r, eg., positive definiteness not checked,
an error may or may not occur if r is not a corr. matrix (user-beware) */
/* for the positive equicorrelated case, use
the 1-dimensional integral given on page 193 of Tong's book
on the multivariate normal distribution */
{ double lb[8],ub[8],bound,eps1,s[22],tem;
double p[M],pp[M][M],sc,sc2,rect;
int i,ifault,inf[8],m1,j,ii,is,even,a[M],idet,isim,k,mm;
int typ[M];
void isamp(int *, int);
double pnorms(double);
void mulnor(double [], double [], double [], double, int,
int [], double *, double *, int *);
void nexper(int, int [], int *, int *);
void approx1(double [], double [], double [][M], int, int [],
double [], double [][M], double *, int *);
*ifail=0;
for(i=1;i<=m;i++) { if(w[i]>=x[i]) { *ifail=1; *pr=0.; *sd=0.; return;}}
if(m==1) { *pr=pnorms(x[1])-pnorms(w[1]); *sd=1.e-6; return;}
if(m==2)
{ inf[0]=2; inf[1]=2; eps1=1.e-6;
lb[0]=w[1]; lb[1]=w[2]; ub[0]=x[1]; ub[1]=x[2]; s[0]=r[1][2];
mulnor(ub,lb,s,eps1,m,inf,&rect,&bound,&ifault);
if(ifault!=0) printf("error in mulnor %d\n", ifault);
*pr=rect; *sd=bound; *ifail=ifault; return;
}
/* m>=3 */
/* some changes for x_i or w_i = oo, May 13, 1994 */
/* for(i=1;i<=m;i++)
{ p[i]=pnorms(x[i])-pnorms(w[i]);}
m1=2; inf[0]=2; inf[1]=2;*/
for(i=1;i<=m;i++)
{ if (w[i]<=-5.) { typ[i]=1; p[i]=pnorms(x[i]);}
else if(x[i]>=5.) {typ[i]=0; p[i]=1.-pnorms(w[i]);}
else { typ[i]=2; p[i]=pnorms(x[i])-pnorms(w[i]);}
}
m1=2;
for(i=1;i<=m;i++) pp[i][i]=p[i]*(1.-p[i]);
for(i=1;i<m;i++)
{ for(j=i+1;j<=m;j++)
{ lb[0]=w[i]; lb[1]=w[j]; ub[0]=x[i]; ub[1]=x[j];
s[0]=r[i][j];
inf[0]=typ[i]; inf[1]=typ[j];
mulnor(ub,lb,s,eps,m1,inf,&tem,&bound,&ifault);
if(ifault!=0)
{ printf("error in mulnor %d\n", ifault);
*pr=0.; *sd=bound; *ifail=ifault; return;
}
pp[i][j]=tem-p[j]*p[i];
pp[j][i]=pp[i][j];
}
}
if(nsim==0) { /*enumerate all permutations */
is=0; ii=0; sc=0.; sc2=0.;
for(i=2,mm=1;i<=m;i++) mm*=i;
for(k=1;k<=mm;k++)
/*do*/ { nexper(m,a,&is,&even);
if(a[1]<a[2])
{ approx1(w,x,r,m,a,p,pp,&rect,&idet);
if(idet==1) { ii++; sc+=rect; sc2+=rect*rect;
/*printf("%8.4f", rect);*/
}
// HJ check May 11, 2004
//printf("%d %8.4f\n", k,rect);
}
} /*while(is==1);*/
/*printf("\n");*/
}
else /* random permutations */
{ ii=0; sc=0.; sc2=0.;
for(isim=1;isim<=nsim;isim++)
{ isamp(a,m);
approx1(w,x,r,m,a,p,pp,&rect,&idet);
if(idet==1) { ii++; sc+=rect; sc2+=rect*rect;}
}
}
sc/=ii; sc2=(sc2-ii*sc*sc)/(ii-1.);
*pr=sc; if(sc2>0.) *sd=sqrt(sc2); else *sd=0.;
/* printf(" mean approx=%9.5f %9.5f %3d\n\n",sc,*sd,ii);*/
}
void mvn2(int m, double w[], double x[], double r[][M], int nsim, double eps,
double *pr, double *sd, int *ifail)
/* int igenz, double *pr, double *sd, int *ifail)
igenz = 1 if genz's method used for 4-dim MVN prob,
otherwise schervish's routine is used.
(code allowing igenz=1 has been commented out,
genz's method is slower for 4D)
*/
/* second order approximation for conditional probabilities */
/* ref. Joe (1993). Approximations to Multivariate Normal Rectangle
Probabilities Based on Conditional Expectations*/
/* INPUT
m = dimension of multivariate normal probability
w = vector of lower bounds
x = vector of upper bounds
r = correlation matrix (1's on the diagonal)
nsim = number of random permutations used
[ nsim=0 for enumerating all permutations, otherwise random perms
nsim=0 recommended for m<=6 ]
eps = error bound for 4-D bivariate probabilities (1.e-4 or 1.e-5
recommended depending on m)
OUTPUT
pr = probability of rectangle: P(w_i<X_i<z_i, i=1,...,n)
sd = measurement of accuracy (SD from the permuted conditional prob's)
ifail = code for whether prob was succesfully computed
(ifail =0 for success, ifail >0 for failure)
ROUTINES CALLED (directly or indirectly):
mulnor (Schervish's MVN prob)
bivnor (Donnelly's bivariate normal upper quadrant prob)
pnorms (univariate standard normal cdf)
approx2, cond2 (approx to conditional probs)
iorder (auxiliary routine)
nexper (generate permutations systematically)
isamp (generate random permutations)
gepp (linear system solver, Gaussian elim with partial pivoting)
*/
/* w[0], x[0], r[0][], r[][0] not used here */
/* No checks are done on r, eg., positive definiteness not checked,
an error may or may not occur if r is not a corr. matrix (user-beware) */
/* for the positive equicorrelated case, use
the 1-dimensional integral given on page 193 of Tong's book
on the multivariate normal distribution */
{ double rect;
double lb[8],ub[8],eps1,bound,s[22];
double p[M],pp[M][M],sc,sc2;
double p3[M][M][M],p4[M][M][M][M],q4[M][M][M][M],tem;
double rr[M][M];
int i,ifault,inf[8],m1,k,j,ii,is,even,a[M],idet,isim;
int m2,mm,l,i1,j1,k1,l1;
int typ[M];
void isamp(int *, int);
double pnorms(double);
void mulnor(double [], double [], double [], double, int,
int [], double *, double *, int *);
void iorder(int, int, int, int, int *, int *, int *, int *);
void nexper(int, int [], int *, int *);
void approx2(int, int [],
double [], double [][M], double [][M][M], double [][M][M][M],
double *, int *);
*ifail=0;
for(i=1;i<=m;i++) { if(w[i]>=x[i]) { *ifail=1; *pr=0.; *sd=0.; return;}}
if(m==1) { *pr=pnorms(x[1])-pnorms(w[1]); *sd=1.e-6; return;}
if(m==2)
{ inf[0]=2; inf[1]=2; eps1=1.e-6;
lb[0]=w[1]; lb[1]=w[2]; ub[0]=x[1]; ub[1]=x[2]; s[0]=r[1][2];
mulnor(ub,lb,s,eps1,m,inf,&rect,&bound,&ifault);
if(ifault!=0) printf("error in mulnor %d\n", ifault);
*pr=rect; *sd=bound; *ifail=ifault; return;
}
if(m==3 || m==4)
{ eps1=1.e-6; /* changed on Apr 21, 1994*/ eps1=1.e-5;
for(i=0;i<m;i++) {inf[i]=2; lb[i]=w[i+1]; ub[i]=x[i+1];}
for(i=2,k=0;i<=m;i++)
{ for(j=1;j<i;j++) { s[k]=r[i][j]; k++;}}
/* s[0]=r[1][2]; s[1]=r[1][3]; s[2]=r[2][3];*/
/* addition on Apr 24, 1994 */
for(i=0;i<m;i++)
{ if(ub[i]>=5.) inf[i]=0;
if(lb[i]<=-5.) inf[i]=1;
}
mulnor(ub,lb,s,eps1,m,inf,&rect,&bound,&ifault);
if(ifault!=0) printf("error in mulnor %d\n", ifault);
*pr=rect; *sd=bound; *ifail=ifault; return;
}
/* m>=5 */
eps1=1.e-6; m1=2;
for(i=1;i<=4;i++) rr[i][i]=1.;
for(i=1;i<=m;i++)
{ p[i]=pnorms(x[i])-pnorms(w[i]); pp[i][i]=p[i];}
for(i=0;i<4;i++) inf[i]=2;
for(i=1;i<m;i++)
{ for(j=i+1;j<=m;j++)
{ lb[0]=w[i]; lb[1]=w[j]; ub[0]=x[i]; ub[1]=x[j];
s[0]=r[i][j];
mulnor(ub,lb,s,eps1,m1,inf,&tem,&bound,&ifault);
if(ifault!=0) printf("error in mulnor %d\n", ifault);
pp[i][j]=tem;
pp[j][i]=pp[i][j];
}
}
/* 3 and 4 dimensional arrays (of moments) */
eps1=1.e-5; m1=3; m2=4;
/* addition on Apr 25, 1994 */
for(i=1;i<=m;i++)
{ if(x[i]>=5.) typ[i]=0;
else if(w[i]<=-5.) typ[i]=1;
else typ[i]=2;
}
for(i=1;i<=m;i++)
{ for(j=1;j<m;j++)
{ for(k=j+1;k<=m;k++)
{ if(i==j || i==k) { p3[i][j][k]=pp[j][k]; p3[i][k][j]=pp[j][k];}
else
{ ub[0]=x[i]; ub[1]=x[j]; ub[2]=x[k];
lb[0]=w[i]; lb[1]=w[j]; lb[2]=w[k];
/* addition on Apr 25, 1994 */
inf[0]=typ[i]; inf[1]=typ[j]; inf[2]=typ[k];
s[0]=r[i][j]; s[1]=r[i][k]; s[2]=r[j][k];
mulnor(ub,lb,s,eps1,m1,inf,&tem,&bound,&ifault);
if(ifault!=0) printf("error in mulnor %d\n", ifault);
p3[i][j][k]=tem; p3[i][k][j]=tem;
}
}
}
}
for(i=1;i<m;i++)
{ for(j=i+1;j<=m;j++)
{ for(k=1;k<m;k++)
{ for(l=k+1;l<=m;l++)
{ if(i==k && j==l) p4[i][j][k][l]=pp[i][j]*(1.-pp[i][j]);
else if (i==k) p4[i][j][k][l]=p3[l][i][j]-pp[i][j]*pp[k][l];
else if (j==l) p4[i][j][k][l]=p3[k][i][j]-pp[i][j]*pp[k][l];
else if (j==k) p4[i][j][k][l]=p3[l][i][j]-pp[i][j]*pp[k][l];
else if (i==l) p4[i][j][k][l]=p3[k][i][j]-pp[i][j]*pp[k][l];
/* else if (m==4) p4[i][j][k][l]=0.;*/
else if(i<j && j<k && k<l)
{ /* schervish's routine */
ub[0]=x[i]; ub[1]=x[j]; ub[2]=x[k]; ub[3]=x[l];
lb[0]=w[i]; lb[1]=w[j]; lb[2]=w[k]; lb[3]=w[l];
s[0]=r[i][j]; s[1]=r[i][k]; s[2]=r[j][k];
s[3]=r[i][l]; s[4]=r[j][l]; s[5]=r[k][l];
/* addition on Apr 25, 1994 */
inf[0]=typ[i]; inf[1]=typ[j]; inf[2]=typ[k]; inf[3]=typ[l];
mulnor(ub,lb,s,eps,m2,inf,&tem,&bound,&ifault);
if(ifault!=0) printf("error in mulnor %d\n", ifault);
q4[i][j][k][l]=tem;
p4[i][j][k][l]=tem-pp[i][j]*pp[k][l];
}
else
{ iorder(i,j,k,l,&i1,&j1,&k1,&l1);
p4[i][j][k][l]=q4[i1][j1][k1][l1]-pp[i][j]*pp[k][l];
}
p4[j][i][k][l]=p4[i][j][k][l];
p4[i][j][l][k]=p4[i][j][k][l];
p4[j][i][l][k]=p4[i][j][k][l];
}
}
}
}
for(i=1;i<=m;i++)
{ for(j=1;j<m;j++)
{ for(k=j+1;k<=m;k++)
{ p3[i][j][k]-=p[i]*pp[j][k]; p3[i][k][j]=p3[i][j][k];
}
}
}
if(nsim==0) { /*enumerate all permutations */
for(i=2,mm=1;i<=m;i++) mm*=i;
is=0; ii=0; sc=0.; sc2=0.;
for(k=1;k<=mm;k++)
{ nexper(m,a,&is,&even);
if(a[1]<a[2] && a[2]<a[3] && a[3]<a[4])
{ /*approx2(w,x,r,m,a,p,pp,p3,p4,&rect,&idet);*/
approx2(m,a,p,pp,p3,p4,&rect,&idet);
if(idet==1) { ii++; sc+=rect; sc2+=rect*rect;
/* printf("%8.4f", rect);*/
}
}
}/* while(is==1);*/
/*printf("\n");*/
}
else /* random permutations */
{ ii=0; sc=0.; sc2=0.;
for(isim=1;isim<=nsim;isim++)
{ isamp(a,m);
approx2(m,a,p,pp,p3,p4,&rect,&idet);
if(idet==1) { ii++; sc+=rect; sc2+=rect*rect;}
}
}
sc/=ii; sc2=(sc2-ii*sc*sc)/(ii-1.);
*pr=sc; if(sc2>0.) *sd=sqrt(sc2); else *sd=0.;
/* printf(" mean approx=%9.5f %9.5f %3d\n\n",sc,*sd,ii);*/
}
