Exemple #1
0
void diff2PDF_rho_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,  M, c=0, out1=0, out2=0;

	double rho = param[0];
	double nu = param[1];
	
	t1=nu+2.0;
	t4=1.0-rho*rho;

	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);
		M = ( nu*t4 + x1*x1 + x2*x2 - 2.0*rho*x1*x2 );
		t2=nu*rho+x1*x2;
		t3=x1-rho*x2;
		diffPDF_rho_tCopula(&u[j], &v[j], &k, param, copula, &out1);
		diffPDF_u_tCopula_new(&u[j], &v[j], &k, param, copula, &out2);
		
		out[j]=c*(t1/M/dt(x1,nu,0) * (x2 - 2.0*t2/M*t3)) + out1/c*out2;
	}
}
Exemple #2
0
void diff2PDF_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, t4, t5, t6, t7, t8, t9, t11, t12, t13, M, c=0, diffPDF=0, diff_dt2=0;
	double t14, t15, t16;

	double rho = param[0];
	double nu = param[1];
	
	t1=nu+2.0;
	t14=rho*rho;
	t4=1.0-t14;

	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_u_tCopula_new(&u[j], &v[j], &k, param, copula, &diffPDF);
		diff_dt_u(&x1, &nu, &diff_dt2);
		
		t7=x1-rho*x2;
		
		t5=-diffPDF/t2 + diff_dt2/t2/t2*c;
		t6=t1*t7/M + diff_dt2;
		
		t11=c/t2;
		t8=1.0/t2;
		t9=t1/M - 2.0*t1*t7*t7/M/M;
		t13=1.0+t15/nu;
		
		t12=t8*( -(nu+1.0)/(nu+t15) + 2.0*t15* (nu+1.0)/nu/nu / t13/t13);
		
		out[j]=t5*t6 - t11*(t8*t9 + t12);
	}
}
Exemple #3
0
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);

}
Exemple #4
0
void diffPDF_u(double* u, double* v, int* n, double* param, int* copula, double* out)
{
	int j, k=1;
	double t1, t2, t3, t4, t5, t6, t7, t8, t9, t10, t11, t12, t13, t14, t15, t16, t18, t19, t20, t21, t22, t23, t24, t25, t27, t28, t29;
	double t30, t33, t36;

	double theta = param[0];
	//double delta = param[1];

	for(j=0;j<*n;j++)
	{
		if(*copula==0)
		{
			out[j]=0;
		}
		else if(*copula==1)
		{
			t1 = qnorm(u[j],0.0,1.0,1,0); 
			t2 = qnorm(v[j],0.0,1.0,1,0);
			t3 = theta*theta;
			t4 = 1.0-t3;
			t5 = sqrt(t4);
			t6 = pow(t1,2.0);
			t7 = pow(t2,2.0);
			t8 = t3*(t6+t7)-(2.0*theta*t1*t2);
			t9 = exp(-t8/t4/2.0);
			t10 = t9/t5;
			t11 = sqrt(2.0*pi);
			t12 = exp(-t6/2.0);
			t13 = t11/t12;
			out[j] = -t10*(theta*t13/t4)*(theta*t1-t2);
		}
		else if(*copula==2)
		{
			diffPDF_u_tCopula_new(&u[j], &v[j], &k, param, copula, &out[j]);	// special function for t-copula
		}
		else if(*copula==3)
		{
			t1 = 1.0+theta;
			t3 = pow(u[j]*v[j],-1.0*t1);
			t4 = t1*t3;
			t5 = 1/u[j];
			t7 = pow(u[j],-1.0*theta);
			t8 = pow(v[j],-1.0*theta);
			t9 = t7+t8-1.0;
			t11 = -2.0-1/theta;
			t12 = pow(t9,1.0*t11);
			out[j] = -t4*t1*t5*t12-t4*t12*t11*t7*theta*t5/t9;
		}
		else if(*copula==4)
		{
			t3 = log(u[j]);
			t4 = pow(-t3,1.0*theta);
			t5 = log(v[j]);
			t6 = pow(-t5,1.0*theta);
			t7 = t4+t6;
			t8 = 1/theta;
			t9 = pow(t7,1.0*t8);
			t11 = u[j]*u[j];
			t12 = 1/t11;
			t13 = 1/t3;
			t15 = 1/t7;
			t18 = exp(-t9);
			t19 = 1/v[j];
			t21 = -1.0+t8;
			t22 = pow(t7,2.0*t21);
			t24 = theta-1.0;
			t25 = pow(t3*t5,1.0*t24);
			t27 = pow(t7,-1.0*t8);
			t28 = t24*t27;
			t29 = 1.0+t28;
			t30 = t22*t25*t29;
			t33 = t18*t12;
			t36 = t19*t22;
			out[j] = -t9*t4*t12*t13*t15*t18*t19*t30-t33*t19*t30+2.0*t33*t36*t21*t4*theta
					*t13*t15*t25*t29+t33*t36*t25*t24*t13*t29-t33*t36*t25*t28*t4*t13*t15;
		}
		else if(*copula==5)
		{
			t1 = theta*theta;
			t2 = exp(theta);
			t3 = t2-1.0;
			t5 = theta*v[j];
			t6 = theta*u[j];
			t8 = exp(t5+t6+theta);
			t10 = exp(t5+t6);
			t12 = exp(t5+theta);
			t14 = exp(t6+theta);
			t15 = t10-t12-t14+t2;
			t16 = t15*t15;
			out[j] = t1*t3*t8/t16-2.0*theta*t3*t8/t16/t15*(theta*t10-theta*t14);
		}
		else if(*copula==6)
		{
			t1 = 1.0-u[j];
			t2 = pow(t1,1.0*theta);
			t3 = 1.0-v[j];
			t4 = pow(t3,1.0*theta);
			t5 = t2*t4;
			t6 = t2+t4-t5;
			t8 = 1/theta-2.0;
			t9 = pow(t6,1.0*t8);
			t11 = t2*theta;
			t12 = 1/t1;
			t16 = -t11*t12+t11*t12*t4;
			t19 = theta-1.0;
			t20 = pow(t1,1.0*t19);
			t22 = pow(t3,1.0*t19);
			t23 = theta-1.0+t2+t4-t5;
			t27 = t9*t20;
			out[j] = t9*t8*t16/t6*t20*t22*t23-t27*t19*t12*t22*t23+t27*t22*t16;
		}
	}

}