// vectorized version void diffPDF_nu_tCopula_new_vec(double* u, double* v, int* n, double* par, double* par2, int* copula, double* out) { int nn = 1; double* ipars = (double *) malloc(2*sizeof(double)); for (int i = 0; i < (*n); ++i) { ipars[0] = par[i]; ipars[1] = par2[i]; diffPDF_nu_tCopula_new(&u[i], &v[i], &nn, ipars, &copula[i], &out[i]); }; free(ipars); }
void diff2PDF_nu_u_tCopula_new(double* u, double* v, int* n, double* param, int* copula, double* out) { double x1, x2; int j=0, k=1; double t1, t2, t3, t4, t6, t7, t8, t9, t10, t11, t12, t13, M, c=0, out1=0, out2=0, diffPDF=0, diff_dt=0, diff_dt2=0, diff_dt3=0, M_nu=0; double t14, t15, t16, t17; double rho = param[0]; double nu = param[1]; t1=nu+2.0; t3=(nu+1.0)/nu; t14=rho*rho; t4=1.0-t14; t17=nu*nu; for(j=0;j<*n;j++) { LL(copula, &k, &u[j], &v[j], &rho, &nu, &c); c=exp(c); x1=qt(u[j],nu,1,0); x2=qt(v[j],nu,1,0); t15=x1*x1; t16=x2*x2; M = ( nu*t4 + t15 + t16 - 2.0*rho*x1*x2 ); t2=dt(x1,nu,0); diffPDF_nu_tCopula_new(&u[j], &v[j], &k, param, copula, &diffPDF); diff_dt_nu(&x1, &nu, &diff_dt); diff_dt_u(&x1, &nu, &diff_dt2); diff_dt_x(&x1, &nu, &diff_dt3); diffX_nu_tCopula(&x1, param, &out1); diffX_nu_tCopula(&x2, param, &out2); t8=(x1*out2+out1*x2); M_nu=t4+2.0*x1*out1+2.0*x2*out2-2.0*rho*t8; t6=1.0+t15/nu; t7=x1-rho*x2; t9=-diffPDF/t2 + c/t2/t2*(diff_dt+diff_dt3*out1); t10=t1*t7/M + diff_dt2; t11=c/t2; t12=t7/M - t1*t7/M/M*M_nu + t1*(out1-rho*out2)/M; t13=-out1*t3/t6 + x1/(t17+nu*t15) + x1*t3/t6/t6 * (2.0*x1*out1/nu - t15/t17); out[j]=t9*t10 - t11*(t12+t13); } }
void diff2PDF_rho_nu_tCopula_new(double* u, double* v, int* n, double* param, int* copula, double* out) { double out1=0, out2=0, x1, x2; int j=0, k=1; double t3, t4, t5, t6, t7, t8, t9, t10, t11, M_rho, M_nu, M, c; double rho = param[0]; double nu = param[1]; t4=1.0-rho*rho; t3=rho/t4; t5=nu+2.0; for(j=0;j<*n;j++) { LL(copula, &k, &u[j], &v[j], &rho, &nu, &c); c=exp(c); x1=qt(u[j],nu,1,0); x2=qt(v[j],nu,1,0); diffX_nu_tCopula(&x1, param, &out1); diffX_nu_tCopula(&x2, param, &out2); t10=x1*x1; t11=x2*x2; M = ( nu*t4 + t10 + t11 - 2.0*rho*x1*x2 ); diffPDF_rho_tCopula(&u[j], &v[j], &k, param, copula, &t6); diffPDF_nu_tCopula_new(&u[j], &v[j], &k, param, copula, &t7); M_rho=-2.0*(nu*rho+x1*x2); t8=(x1*out2+out1*x2); M_nu=t4+2.0*x1*out1+2.0*x2*out2-2.0*rho*t8; t9=-t3+t5/M*(rho+t8+0.5*M_nu*M_rho/M)-0.5*M_rho/M; out[j]=c*t9+t6*t7/c; } }
void VineLogLikRvineDeriv(int* T, int* d, int* family, int* kk, int* ii, int* maxmat, int* matrix, int* condirect, int* conindirect, double* par, double* par2, double* data, double* out, double* ll, double* vv, double* vv2, int* calcupdate, double* tilde_vdirect, double* tilde_vindirect, double* tilde_value, int* tcop, int* margin) { int i, j, k, t, m, **fam, **calc; double sumloglik=0.0, **theta, **nu, ***tildevdirect, ***tildevindirect, *zr1, *zr2, *tildezr1, *tildezr2, *cop; double *handle1; double param[2]; zr1=(double*) Calloc(*T,double); zr2=(double*) Calloc(*T,double); handle1=(double*) Calloc(*T,double); tildezr1=(double*) Calloc(*T,double); tildezr2=(double*) Calloc(*T,double); cop=(double*) Calloc(*T,double); double ***tildevalue; tildevalue=create_3darray(*d,*d,*T); //Allocate memory tildevdirect = create_3darray(*d,*d,*T); tildevindirect = create_3darray(*d,*d,*T); theta=create_matrix(*d,*d); nu=create_matrix(*d,*d); fam=create_intmatrix(*d,*d); calc=create_intmatrix(*d,*d); //Initialize k=0; for(i=0;i<(*d);i++) { for(j=0;j<(*d);j++) { theta[i][j]=par[(i+1)+(*d)*j-1] ; nu[i][j]=par2[(i+1)+(*d)*j-1] ; fam[i][j]=family[(i+1)+(*d)*j-1] ; calc[i][j]=calcupdate[(i+1)+(*d)*j-1] ; } } for(i=0;i<(*d);i++) { for(j=0;j<(*d);j++) { for(t=0;t<*T;t++ ) { tildevdirect[i][j][t]=0; tildevindirect[i][j][t]=0; tildevalue[i][j][t]=0; } } } m=maxmat[*kk+(*d)*(*ii-1)-1]; for(t=0;t<*T;t++ ) { zr1[t]=vv[*kk+(*d)*(*ii-1)+(*d)*(*d)*t-1]; cop[t]=exp(ll[*kk+(*d)*(*ii-1)+(*d)*(*d)*t-1]); } if(m == matrix[*kk+*d*(*ii-1)-1]) { for(t=0;t<*T;t++ ) { zr2[t]=vv[*kk+(*d)*(*d-m)+(*d)*(*d)*t-1]; } } else { for(t=0;t<*T;t++) { zr2[t]=vv2[*kk+(*d)*(*d-m)+(*d)*(*d)*t-1]; } } param[0]=theta[*kk-1][*ii-1]; param[1]=nu[*kk-1][*ii-1]; if(*tcop==1) //For the t-copula (first parameter) { diffhfunc_rho_tCopula(zr1,zr2,T,param,&fam[*kk-1][*ii-1],tildevdirect[*kk-2][*ii-1]); diffhfunc_rho_tCopula(zr2,zr1,T,param,&fam[*kk-1][*ii-1],tildevindirect[*kk-2][*ii-1]); diffPDF_rho_tCopula(zr1,zr2,T,param,&fam[*kk-1][*ii-1],tildevalue[*kk-1][*ii-1]); for(t=0;t<*T;t++ ) { tildevalue[*kk-1][*ii-1][t]=tildevalue[*kk-1][*ii-1][t]/cop[t]; } } else if(*tcop==2) // for the t-copula (second parameter) { diffhfunc_nu_tCopula_new(zr1,zr2,T,param,&fam[*kk-1][*ii-1],tildevdirect[*kk-2][*ii-1]); diffhfunc_nu_tCopula_new(zr2,zr1,T,param,&fam[*kk-1][*ii-1],tildevindirect[*kk-2][*ii-1]); diffPDF_nu_tCopula_new(zr1,zr2,T,param,&fam[*kk-1][*ii-1],tildevalue[*kk-1][*ii-1]); for(t=0;t<*T;t++ ) { tildevalue[*kk-1][*ii-1][t]=tildevalue[*kk-1][*ii-1][t]/cop[t]; } } else { if( *margin == 0 ) //Das ist unser bisheriger Fall mit stetigen Variablen (ohne t-copula) { diffhfunc_mod(zr1,zr2,T,&theta[*kk-1][*ii-1],&fam[*kk-1][*ii-1],tildevdirect[*kk-2][*ii-1]); diffhfunc_mod2(zr2,zr1,T,&theta[*kk-1][*ii-1],&fam[*kk-1][*ii-1],tildevindirect[*kk-2][*ii-1]); diffPDF_mod(zr1,zr2,T,&theta[*kk-1][*ii-1],&fam[*kk-1][*ii-1],tildevalue[*kk-1][*ii-1]); for(t=0;t<*T;t++ ) { tildevalue[*kk-1][*ii-1][t]=tildevalue[*kk-1][*ii-1][t]/cop[t]; } } else if( *margin== 1) // Ableitung nach dem ersten Argument = margin1 { diffhfunc_v_mod2(zr2,zr1,T,&theta[*kk-1][*ii-1],&fam[*kk-1][*ii-1],tildevindirect[*kk-2][*ii-1]); diffPDF_u_mod(zr1,zr2,T,&theta[*kk-1][*ii-1],&fam[*kk-1][*ii-1],tildevalue[*kk-1][*ii-1]); // hier k?nnte difflPDF stehen for(t=0;t<*T;t++ ) { tildevdirect[*kk-2][*ii-1][t]=cop[t]; tildevalue[*kk-1][*ii-1][t]=tildevalue[*kk-1][*ii-1][t]/cop[t]; } } else // Ableitung nach dem zweiten Argument = margin2 { diffhfunc_v_mod(zr1,zr2,T,&theta[*kk-1][*ii-1],&fam[*kk-1][*ii-1],tildevdirect[*kk-2][*ii-1]); diffPDF_v_mod(zr1,zr2,T,&theta[*kk-1][*ii-1],&fam[*kk-1][*ii-1],tildevalue[*kk-1][*ii-1]); // hier k?nnte difflPDF stehen for(t=0;t<*T;t++ ) { tildevindirect[*kk-2][*ii-1][t]=cop[t]; tildevalue[*kk-1][*ii-1][t]=tildevalue[*kk-1][*ii-1][t]/cop[t]; } } } // add up for the final derivative for(t=0;t<*T;t++ ) { sumloglik+=tildevalue[*kk-1][*ii-1][t]; } for(i=*ii-1; i>-1; i--) { for(k=*kk-2;k>i;k--) { if(calc[k][i]==1) { m=maxmat[(k+1)+*d*i-1]; for(t=0;t<*T;t++ ) { zr1[t]=vv[(k+1)+(*d)*i+(*d)*(*d)*t-1]; tildezr1[t]=tildevdirect[k][i][t]; cop[t]=exp(ll[(k+1)+(*d)*i+(*d)*(*d)*t-1]); } if(m == matrix[(k+1)+*d*i-1]) { for(t=0;t<*T;t++ ) { zr2[t]=vv[(k+1)+(*d)*(*d-m)+(*d)*(*d)*t-1]; tildezr2[t]=tildevdirect[k][(*d-m)][t]; } } else { for(t=0;t<*T;t++ ) { zr2[t]=vv2[(k+1)+(*d)*(*d-m)+(*d)*(*d)*t-1]; tildezr2[t]=tildevindirect[k][(*d-m)][t]; } } for(t=0;t<*T;t++ ) { tildevdirect[k-1][i][t]=0; tildevindirect[k-1][i][t]=0; tildevalue[k][i][t]=0; } if(calc[k+1][i]==1) { param[0]=theta[k][i]; param[1]=nu[k][i]; if(fam[k][i]==2) //For the t-copula { diffPDF_u_tCopula_new(zr1,zr2,T,param,&fam[k][i],handle1); } else { diffPDF_u_mod(zr1,zr2,T,&theta[k][i],&fam[k][i],handle1); } for(t=0;t<*T;t++ ) { tildevalue[k][i][t]+=handle1[t]/cop[t]*tildezr1[t]; } if(condirect[k+(*d)*i-1]==1) { for(t=0;t<*T;t++ ) { tildevdirect[k-1][i][t]+=cop[t]*tildezr1[t]; } } if(conindirect[k+(*d)*i-1]==1) { param[0]=theta[k][i]; param[1]=nu[k][i]; if(fam[k][i]==2) //For the t-copula { diffhfunc_v_tCopula_new(zr2,zr1,T,param,&fam[k][i],handle1); } else { diffhfunc_v_mod2(zr2,zr1,T,&theta[k][i],&fam[k][i],handle1); } for(t=0;t<*T;t++ ) { tildevindirect[k-1][i][t]+=handle1[t]*tildezr1[t]; } } } if(calc[k+1][(*d-m)]==1) { param[0]=theta[k][i]; param[1]=nu[k][i]; if(fam[k][i]==2) //For the t-copula { diffPDF_u_tCopula_new(zr2,zr1,T,param,&fam[k][i],handle1); } else { diffPDF_v_mod(zr1,zr2,T,&theta[k][i],&fam[k][i],handle1); } for(t=0;t<*T;t++ ) { tildevalue[k][i][t]+=handle1[t]/cop[t]*tildezr2[t]; } if(condirect[k+(*d)*i-1]==1) { param[0]=theta[k][i]; param[1]=nu[k][i]; if(fam[k][i]==2) //For the t-copula { diffhfunc_v_tCopula_new(zr1,zr2,T,param,&fam[k][i],handle1); } else { diffhfunc_v_mod(zr1,zr2,T,&theta[k][i],&fam[k][i],handle1); } for(t=0;t<*T;t++ ) { tildevdirect[k-1][i][t]+=handle1[t]*tildezr2[t]; } } if(conindirect[k+(*d)*i-1]==1) { for(t=0;t<*T;t++ ) { tildevindirect[k-1][i][t]+=cop[t]*tildezr2[t]; } } } } for(t=0;t<*T;t++ ) { sumloglik += tildevalue[k][i][t]; } } }//for loops closed *out = sumloglik; for(i=0;i<(*d);i++) { for(j=0;j<(*d);j++) { for(t=0;t<*T;t++ ) { tilde_vdirect[(i+1)+(*d)*j+(*d)*(*d)*t-1]=tildevdirect[i][j][t]; tilde_vindirect[(i+1)+(*d)*j+(*d)*(*d)*t-1]=tildevindirect[i][j][t]; tilde_value[(i+1)+(*d)*j+(*d)*(*d)*t-1]=tildevalue[i][j][t]; } } } //Free memory: free_matrix(theta,*d); free_matrix(nu,*d); free_intmatrix(fam,*d); free_intmatrix(calc, *d); free_3darray(tildevindirect,*d,*d); free_3darray(tildevdirect,*d,*d); free_3darray(tildevalue,*d,*d); Free(zr1); Free(zr2); Free(tildezr1); Free(tildezr2); Free(handle1); Free(cop); }
void diff2PDF_nu_tCopula_new(double* u, double* v, int* n, double* param, int* copula, double* out) { double out1=0, out2=0, out3=0, out4=0, x1, x2, diff_nu=0; int j=0, k=1; double t1, t2, t3, t4, t5, t6, t8, t9, t10, t11, t12, t13, t14, t15, t16, t17, t18, t19, t20, t21, t22, t23, t24, t25, M_nu, M, M_nu_nu, c; double rho = param[0]; double nu = param[1]; t1=(nu+1.0)/2.0; t2=nu/2.0; t23=nu*nu; t3=1.0/t23; t4=1.0/(2.0*nu); t5=0.5*trigamma(t1); t6=(1.0-rho*rho); t9=0.5*trigamma(t2); t10=-t5+t9-t3-t4; for(j=0;j<*n;j++) { LL(copula, &k, &u[j], &v[j], &rho, &nu, &c); c=exp(c); x1=qt(u[j],nu,1,0); x2=qt(v[j],nu,1,0); diffX_nu_tCopula(&x1, param, &out1); diffX_nu_tCopula(&x2, param, &out2); M = ( nu*t6 + x1*x1 + x2*x2 - 2.0*rho*x1*x2 ); t8=(x1*out2+out1*x2); M_nu=t6+2.0*x1*out1+2.0*x2*out2-2.0*rho*t8; t24=x1*x1; t25=x2*x2; t11=1.0+2.0*x1*out1; t12=nu+t24; t13=t11/t12; t14=1.0+2.0*x2*out2; t15=nu+t25; t16=t14/t15; diff2_x_nu(&x1,&nu,&out3); diff2_x_nu(&x2,&nu,&out4); t17=2.0*out1*out1 + 2.0*x1*out3; t18=t17/t12; t19=2.0*out2*out2 + 2.0*x2*out4; t20=t19/t15; t21=t13*t13; t22=t16*t16; M_nu_nu=2.0*out1*out1 + 2.0*x1*out3 + 2.0*out2*out2 + 2.0*x2*out4 - 4.0*rho*out1*out2 - 2.0*rho*(x2*out3 + x1*out4); diffPDF_nu_tCopula_new(&u[j], &v[j], &k, param, copula, &diff_nu); out[j]=c*( t10+0.5*(t13+t16) + t1*(t18-t21+t20-t22) + 0.5*t13 + 0.5*t16 - M_nu/M - (nu/2.0+1.0)*(M_nu_nu/M-M_nu*M_nu/M/M )) + diff_nu*diff_nu/c; } }