[Vinecopula-commits] r93 - pkg/src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mo Apr 6 12:09:15 CEST 2015
Author: ulf
Date: 2015-04-06 12:09:15 +0200 (Mon, 06 Apr 2015)
New Revision: 93
Modified:
pkg/src/incompleteBeta.c
pkg/src/logderiv.c
pkg/src/pit.c
pkg/src/rvinederiv.c
Log:
Some more comments of my C-code
Modified: pkg/src/incompleteBeta.c
===================================================================
--- pkg/src/incompleteBeta.c 2015-03-31 12:15:11 UTC (rev 92)
+++ pkg/src/incompleteBeta.c 2015-04-06 10:09:15 UTC (rev 93)
@@ -1,6 +1,15 @@
// Implementierung der incomplete beta Funktion und ihrer Ableitungen nach p
+// The incomplete beta function is needed for the derivative of the Student's t-copula
+// Also Its derivative with respect to the parameter p is needed
+// For reference see: Boik and Robinson-Cox (1998).
+
+// Boik, R. J. and J. F. Robinson-Cox (1998).
+// Derivatives of the incomplete beta function.
+// Journal of Statistical Software 3(1).
+// The implementation follows directly their algorithm and is closely related to their published code
+
#include "include/vine.h"
#include "include/incompleteBeta.h"
Modified: pkg/src/logderiv.c
===================================================================
--- pkg/src/logderiv.c 2015-03-31 12:15:11 UTC (rev 92)
+++ pkg/src/logderiv.c 2015-04-06 10:09:15 UTC (rev 93)
@@ -7,10 +7,32 @@
#include "include/incompleteBeta.h"
#include "include/logderiv.h"
+//////////////////////////////////
+// we calculated the derivatives of the copula density in deriv.c and deriv2.c
+// Further, the derivatives of the Student's t-copula were derived in separate files due to their complexity
+// here some derivatives of log(c) are calculated, since sometime it is numerical advantageous to use the log(c) instead of c,
+// in particular for the t-copula.
+//
+// In most cases the calculation is almost the same as for the derivatives of c
+//////////////////////////////////
+
// Ableitung von log(c) nach rho
+/////////////////////////////////////////
+// Derivative of log(c) wrt to the first parameter rho of the Student's t-copula
+//
+// Input:
+// u, v copula arguments (vectors)
+// n length of u and v
+// param two-dimensional parameter vector
+// copula copula family (not needed here)
+//
+// Output:
+// out derivative
+///////////////////////////////////////////
+
void difflPDF_rho_tCopula(double* u, double* v, int* n, double* param, int* copula, double* out)
{
int j;
Modified: pkg/src/pit.c
===================================================================
--- pkg/src/pit.c 2015-03-31 12:15:11 UTC (rev 92)
+++ pkg/src/pit.c 2015-04-06 10:09:15 UTC (rev 93)
@@ -17,15 +17,17 @@
#define XEPS 1e-4
//////////////////////////////////////////////////////////////
-// Function to transform a pair-copula construction (vine)
+// Probability integral transform for the C- and D-vine
// Input:
// n sample size
// d dimension (>= 2)
// type vine type (1=Canonical vine, 2=D-vine)
-// family copula family (1=gaussian, 2=student, 3=clayton, 4=gumbel, 5=frank, 6=joe, 7=BB1)
+// family copula family
// par parameter values (at least d*(d-1)/2 parameters)
////////////////////////////////////////////////////////////////
+// The algorithm is based on the pseudo algorithm of Aas et al. (2009)
+
void pit(int* T, int* d, int* family, int* type, double* par, double* nu, double* data, double* out)
{
int i, j, in=1, k, **fam, tt;
@@ -128,6 +130,27 @@
+//////////////////////////////////////////////////////////////
+// Probability integral transform for the R-vine
+//
+// Input:
+// T, d dimensions of the data
+// family,... RVM objects
+// data data
+// vv, vv2 h-functions derived bei the likelihood function
+// calcupdate which h-functions, inverse h-functions have to be derived
+//
+// Output:
+// out PIT
+//////////////////////////////////////////////////////////////
+
+// Reference: Schepsmeier (2015)
+
+// Ulf Schepsmeier, Efficient information based goodness-of-fit tests for vine copula models with fixed margins: A comprehensive review,
+// Journal of Multivariate Analysis, Available online 14 January 2015, ISSN 0047-259X, http://dx.doi.org/10.1016/j.jmva.2015.01.001.
+// (http://www.sciencedirect.com/science/article/pii/S0047259X15000068)
+
+
void RvinePIT(int* T, int* d, int* family, int* maxmat, int* matrix, int* condirect, int* conindirect, double* par, double* par2, double* data,
double* out, double* vv, double* vv2, int* calcupdate)
{
@@ -154,6 +177,7 @@
}
}
+ // From vector to array
k=0;
for(i=0;i<(*d);i++)
{
@@ -178,6 +202,7 @@
}
}
+ // First column is easy; it's the data
for(t=0;t<*T;t++)
{
z[0][t]=x[0][t];
Modified: pkg/src/rvinederiv.c
===================================================================
--- pkg/src/rvinederiv.c 2015-03-31 12:15:11 UTC (rev 92)
+++ pkg/src/rvinederiv.c 2015-04-06 10:09:15 UTC (rev 93)
@@ -11,27 +11,38 @@
// Code from Jakob Stoeber and Ulf Schepsmeier for R-vine log-likelihood derivative calculation
//////////////////////////////////////////////////////////////
-// Function to compute the derivative of log-likelihood for the pair-copula construction (Rvine)
+// Function to compute the derivative of log-likelihood for the pair-copula construction (Rvine) (one-element of the gradient)
// (by J.S.)
// Input:
-// T sample size
-// d dimension (>=2)
-// family copula families: only student // (1=gaussian, 2=student, 3=clayton, 4=gumbel, 5=frank, 6=joe)
-// kk row number of the parameter wrt to which we want to calculate the derivative
-// ii column number of the parameter wrt to which we want to calculate the derivative
-// par parameter values (at least d*(d-1)/2 parameters
-// par2 second set of parameter values (f.e. for student copulas)
-// data data set for which to compute the derivative of the log-likelihood
-// matrix an RVineMatrix in vector form
-// condirect, conindirect Matrizes which tell us where we find the right values
-// calcupdate matrix which tells which terns we need to consider for the calculation of the derivative
+// T sample size
+// d dimension (>=2)
+// family copula families: only student // (1=gaussian, 2=student, 3=clayton, 4=gumbel, 5=frank, 6=joe)
+// kk row number of the parameter wrt to which we want to calculate the derivative
+// ii column number of the parameter wrt to which we want to calculate the derivative
+// par parameter values (at least d*(d-1)/2 parameters
+// par2 second set of parameter values (f.e. for student copulas)
+// data data set for which to compute the derivative of the log-likelihood
+// matrix an RVineMatrix in vector form
+// condirect, conindirect Matrices which tell us where we find the right values
+// calcupdate matrix which tells which terns we need to consider for the calculation of the derivative
+// ll array with the contribution to the derivative (for each copula)
+// vv,vv2 array of the h-functions (given as by-product of the log-likelihood calculation)
+// tcop a special marker for the Student's t-copula (1=first parameter, 2=second parameter)
+// margin derivative wrt to the margins as well? (TRUE/FALSE) (needed by Jakob for some of his calculations)
+//
// Output:
-// out Loglikelihood
-// ll array with the contribution to the derivative (for each copula)
-// vv,vv2 array for the derivatives of the h-functions
+// out Log-likelihood derivative
+// tilde_value array of separated derivatives in the R-vine construction
+// tilde_vdirect array of separated derivatives of the h-functions needed
+// tilde_vindirect array of separated derivatives of the h-functions needed
/////////////////////////////////////////////////////////////
+// Reference:
+// Stöber, J. and U. Schepsmeier (2013)
+// Estimating standard errors in regular vine copula models
+// Computational Statistics, 28 (6), 2679-2707
+
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)
{
@@ -158,7 +169,7 @@
param[0]=theta[*kk-1][*ii-1];
param[1]=nu[*kk-1][*ii-1];
- if(*tcop==1) //Für die t-copula
+ 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]);
@@ -168,7 +179,7 @@
tildevalue[*kk-1][*ii-1][t]=tildevalue[*kk-1][*ii-1][t]/cop[t];
}
}
- else if(*tcop==2)
+ 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]);
@@ -216,6 +227,7 @@
//Rprintf("%f \n",tildevalue[*kk-1][*ii-1][1]);
+ // add up for the final derivative
for(t=0;t<*T;t++ )
{
sumloglik+=tildevalue[*kk-1][*ii-1][t];
@@ -267,7 +279,7 @@
{
param[0]=theta[k][i];
param[1]=nu[k][i];
- if(fam[k][i]==2) //Für die t-copula
+ if(fam[k][i]==2) //For the t-copula
{
diffPDF_u_tCopula_new(zr1,zr2,T,param,&fam[k][i],handle1);
}
@@ -293,7 +305,7 @@
{
param[0]=theta[k][i];
param[1]=nu[k][i];
- if(fam[k][i]==2) //Für die t-copula
+ if(fam[k][i]==2) //For the t-copula
{
diffhfunc_v_tCopula_new(zr2,zr1,T,param,&fam[k][i],handle1);
}
@@ -312,7 +324,7 @@
{
param[0]=theta[k][i];
param[1]=nu[k][i];
- if(fam[k][i]==2) //Für die t-copula
+ if(fam[k][i]==2) //For the t-copula
{
diffPDF_u_tCopula_new(zr2,zr1,T,param,&fam[k][i],handle1);
}
@@ -330,7 +342,7 @@
{
param[0]=theta[k][i];
param[1]=nu[k][i];
- if(fam[k][i]==2) //Für die t-copula
+ if(fam[k][i]==2) //For the t-copula
{
diffhfunc_v_tCopula_new(zr1,zr2,T,param,&fam[k][i],handle1);
}
@@ -398,7 +410,18 @@
}
+/////////////////////////////////////////////////
+// Calculate the gradient
+// (uses the function VineLogLikRvineDeriv)
+//
+// Input:
+// see above
+//
+// Output:
+// out gradient vector
+///////////////////////////////////////////////////
+
void VineLogLikRvineGradient(int* T, int* d, int* family, int* maxmat, int* matrix, int* condirect, int* conindirect, double* par, double* par2, double* data,
double* out, double* ll, double* vv, double* vv2, int* posParams)
//double* tilde_vdirect_array, double* tilde_vindirect_array, double* tilde_value_array)
@@ -448,12 +471,12 @@
// tilde_value[t] = tilde_value_array[(*d)*(*d)*(*d)*(*T)*(ii-1)+(*d)*(*d)*(*T)*(kk-1)+t];
//}
//Rprintf("\n");
- if(fam[kk-1][ii-1]==2)
+ if(fam[kk-1][ii-1]==2) // for the t-copula
{
- tcop=1;
+ tcop=1; // first parameter
VineLogLikRvineDeriv(T, d, family, &kk, &ii, maxmat, matrix, condirect, conindirect, par, par2, data, &out[tt], ll, vv, vv2, calc, tilde_vdirect, tilde_vindirect, tilde_value, &tcop, &margin);
- tcop=2;
- VineLogLikRvineDeriv(T, d, family, &kk, &ii, maxmat, matrix, condirect, conindirect, par, par2, data, &out[aa-1+dd], ll, vv, vv2, calc, tilde_vdirect, tilde_vindirect, tilde_value, &tcop, &margin);
+ tcop=2; // second parameter
+ VineLogLikRvineDeriv(T, d, family, &kk, &ii, maxmat, matrix, condirect, conindirect, par, par2, data, &out[aa-1+dd], ll, vv, vv2, calc, tilde_vdirect, tilde_vindirect, tilde_value, &tcop, &margin); // important: position in the gradient out[aa-1+dd]
dd++;
}
else
Mehr Informationen über die Mailingliste Vinecopula-commits