// First order derivative of the Student-t distribution
// with respect to the degree of freedom:
double ddf_pt(double x, double df)
{
double epsabs=0.0, epsrel=0.0, integ=0.0, tinteg=0.0;
double abserr=0.0, origin=0.0, q=0.0, res=0.0, *work;
int inf=0.0, neval=0.0, ier=0.0, limit=0.0, lenw=0.0;
int last=0.0, *iwork;
// Initialize the parameters and variable for the integrate fun:
inf=-1;
epsabs=1e-5;
epsrel=1e-5;
limit=100;
lenw=4*limit;
iwork=(int *) R_alloc(limit,sizeof(int));
work=(double *) R_alloc(lenw,sizeof(double));
// Checks the sign of the argument:
if(x <= 0)
Rdqagi(integr_pt,(void*)&df,&x,&inf,&epsabs,&epsrel,
&integ,&abserr,&neval,&ier,&limit,&lenw,&last,iwork,work);
else
{
q=-x;
Rdqagi(integr_pt,(void*)&df,&origin,&inf,&epsabs,&epsrel,
&tinteg,&abserr,&neval,&ier,&limit,&lenw,&last,iwork,work);
Rdqagi(integr_pt,(void*)&df,&q,&inf,&epsabs,&epsrel,&integ,&abserr,
&neval,&ier,&limit,&lenw,&last,iwork,work);
integ=2*tinteg-integ;
}
res=0.5*pt(x,df,1,0)*(digamma(0.5*(df+1))-digamma(0.5*df)-1/df)+integ;
return res;
}
/* n'th order derivative of (scaled) incomplete gamma wrt. shape parameter */
double D_incpl_gamma_shape(double x, double shape, double n, double logc){
if(n<.5){
return exp(logc + Rf_lgammafn(shape)) * Rf_pgamma(x, shape, 1.0, 1, 0);
}
double epsabs=1e-10;
double epsrel=1e-10;
double result1=0;
double result2=0;
double abserr=10000;
int neval=10000;
int ier=0;
int limit=100;
int lenw = 4 * limit;
int last=0;
int* iwork = (int*)malloc(limit * sizeof(int));
double* work = (double*)malloc(lenw * sizeof(double));
double ex[3];
ex[0] = shape;
ex[1] = n;
ex[2] = logc; /* Scale integrand with exp(logc) */
double bound; /* For indefinite integration */
int inf=-1; /* corresponds to (-Inf, bound) */
bound = log(Rf_fmin2(x,shape));
/* integrate -Inf...min(log(x),log(shape)) */
Rdqagi(integrand_D_incpl_gamma_shape, ex, &bound, &inf,
&epsabs, &epsrel,
&result1, &abserr, &neval, &ier,
&limit, &lenw, &last, iwork, work);
if(ier!=0){
#ifndef _OPENMP
warning("incpl_gamma (indef) integrate unreliable: x=%f shape=%f n=%f ier=%i", x, shape, n, ier);
#endif
}
/* integrate min(log(x),log(shape))...log(x) */
if(x>shape){
ier = 0;
double a = bound;
double b = log(x);
Rdqags(integrand_D_incpl_gamma_shape, ex, &a, &b,
&epsabs, &epsrel,
&result2, &abserr, &neval, &ier,
&limit, &lenw, &last, iwork, work);
if(ier!=0){
#ifndef _OPENMP
warning("incpl_gamma (def) integrate unreliable: x=%f shape=%f n=%f ier=%i", x, shape, n, ier);
#endif
}
}
free(iwork);
free(work);
return result1 + result2;
}
double ddf_pt(double x, double df)
{
double epsabs=0.0, epsrel=0.0, integ=0.0, tinteg=0.0;
double abserr=0.0, origin=0.0, q=0.0, res=0.0, *work;
int inf=0.0, neval=0.0, ier=0.0, limit=0.0, lenw=0.0;
int last=0.0, *iwork;
inf = -1;
epsabs = 1e-5;
epsrel = 1e-5;
limit = 100;
lenw = 4 * limit;
iwork = (int *) R_alloc(limit, sizeof(int));
work = (double *) R_alloc(lenw, sizeof(double));
if(x <= 0)
{
Rdqagi(integr_pt, (void*)&df, &x, &inf, &epsabs, &epsrel,
&integ, &abserr, &neval, &ier, &limit, &lenw, &last,
iwork, work);
}
else
{
q = - x;
Rdqagi(integr_pt, (void*)&df, &origin, &inf, &epsabs, &epsrel,
&tinteg, &abserr, &neval, &ier, &limit, &lenw, &last,
iwork, work);
Rdqagi(integr_pt, (void*)&df, &q, &inf, &epsabs, &epsrel,
&integ, &abserr, &neval, &ier, &limit, &lenw, &last,
iwork, work);
integ = 2 * tinteg - integ;
}
res = pt(x, df, 1, 0) * (digamma((df + 1) / 2) -
digamma(df / 2) - 1 / df) / 2 + integ;
return res;
}
