/* Function: esl_gam_logpdf()
* Incept: SRE, Mon Nov 14 12:45:36 2005 [HHMI HQ]
*
* Purpose: Calculates log of the probability density function
* for the gamma, $\log P(X=x)$, given value <x>,
* location parameter <mu>, scale parameter <lambda>, and
* shape parameter <tau>.
*/
double
esl_gam_logpdf(double x, double mu, double lambda, double tau)
{
double y = lambda * (x - mu);
double gamtau;
double val;
if (x < 0.) return -eslINFINITY;
esl_stats_LogGamma(tau, &gamtau);
val = tau*log(lambda) + (tau-1.)*log(x-mu) - gamtau - y;
return val;
}
/* Function: esl_gam_pdf()
* Incept: SRE, Sun Nov 13 16:42:43 2005 [HHMI HQ]
*
* Purpose: Calculates the gamma PDF $P(X=x)$ given value <x>,
* location parameter <mu>, scale parameter <lambda>, and shape
* parameter <tau>.
*/
double
esl_gam_pdf(double x, double mu, double lambda, double tau)
{
double y = lambda * (x - mu);
double gamtau;
double val;
if (y < 0.) return 0.;
esl_stats_LogGamma(tau, &gamtau);
val = tau*log(lambda) + (tau-1.)*log(x-mu) - gamtau - y;
return exp(val);
}
/* Function: esl_sxp_logpdf()
*
* Purpose: Calculates the log probability density function for the
* stretched exponential pdf, $\log P(X=x)$, given
* quantile <x>, offset <mu>, and parameters <lambda> and <tau>.
*/
double
esl_sxp_logpdf(double x, double mu, double lambda, double tau)
{
double y = lambda * (x-mu);
double gt;
double val;
if (x < mu) return -eslINFINITY;
esl_stats_LogGamma(1/tau, >);
if (x == mu) val = log(lambda) + log(tau) - gt;
else val = log(lambda) + log(tau) - gt - exp(tau*log(y));
return val;
}
/* Function: esl_sxp_pdf()
*
* Purpose: Calculates the probability density function for the
* stretched exponential pdf, $P(X=x)$, given
* quantile <x>, offset <mu>, and parameters <lambda> and <tau>.
*/
double
esl_sxp_pdf(double x, double mu, double lambda, double tau)
{
double y = lambda * (x-mu);
double val;
double gt;
if (x < mu) return 0.;
esl_stats_LogGamma(1/tau, >);
if (x == mu) val = (lambda * tau / exp(gt));
else val = (lambda * tau / exp(gt)) * exp(- exp(tau * log(y)));
return val;
}
/* The LogGamma() function is rate-limiting in hmmbuild, because it is
* used so heavily in mixture Dirichlet calculations.
* ./configure --with-gsl; [compile test driver]
* ./stats_utest -v
* runs a comparison of time/precision against GSL.
* SRE, Sat May 23 10:04:41 2009, on home Mac:
* LogGamma = 1.29u / N=1e8 = 13 nsec/call
* gsl_sf_lngamma = 1.43u / N=1e8 = 14 nsec/call
*/
static void
utest_LogGamma(ESL_RANDOMNESS *r, int N, int be_verbose)
{
char *msg = "esl_stats_LogGamma() unit test failed";
ESL_STOPWATCH *w = esl_stopwatch_Create();
double *x = malloc(sizeof(double) * N);
double *lg = malloc(sizeof(double) * N);
double *lg2 = malloc(sizeof(double) * N);
int i;
for (i = 0; i < N; i++)
x[i] = esl_random(r) * 100.;
esl_stopwatch_Start(w);
for (i = 0; i < N; i++)
if (esl_stats_LogGamma(x[i], &(lg[i])) != eslOK) esl_fatal(msg);
esl_stopwatch_Stop(w);
if (be_verbose) esl_stopwatch_Display(stdout, w, "esl_stats_LogGamma() timing: ");
#ifdef HAVE_LIBGSL
esl_stopwatch_Start(w);
for (i = 0; i < N; i++) lg2[i] = gsl_sf_lngamma(x[i]);
esl_stopwatch_Stop(w);
if (be_verbose) esl_stopwatch_Display(stdout, w, "gsl_sf_lngamma() timing: ");
for (i = 0; i < N; i++)
if (esl_DCompare(lg[i], lg2[i], 1e-2) != eslOK) esl_fatal(msg);
#endif
free(lg2);
free(lg);
free(x);
esl_stopwatch_Destroy(w);
}
/* Function: esl_stats_IncompleteGamma()
* Synopsis: Calculates the incomplete Gamma function.
*
* Purpose: Returns $P(a,x)$ and $Q(a,x)$ where:
*
* \begin{eqnarray*}
* P(a,x) & = & \frac{1}{\Gamma(a)} \int_{0}^{x} t^{a-1} e^{-t} dt \\
* & = & \frac{\gamma(a,x)}{\Gamma(a)} \\
* Q(a,x) & = & \frac{1}{\Gamma(a)} \int_{x}^{\infty} t^{a-1} e^{-t} dt\\
* & = & 1 - P(a,x) \\
* \end{eqnarray*}
*
* $P(a,x)$ is the CDF of a gamma density with $\lambda = 1$,
* and $Q(a,x)$ is the survival function.
*
* For $x \simeq 0$, $P(a,x) \simeq 0$ and $Q(a,x) \simeq 1$; and
* $P(a,x)$ is less prone to roundoff error.
*
* The opposite is the case for large $x >> a$, where
* $P(a,x) \simeq 1$ and $Q(a,x) \simeq 0$; there, $Q(a,x)$ is
* less prone to roundoff error.
*
* Method: Based on ideas from Numerical Recipes in C, Press et al.,
* Cambridge University Press, 1988.
*
* Args: a - for instance, degrees of freedom / 2 [a > 0]
* x - for instance, chi-squared statistic / 2 [x >= 0]
* ret_pax - RETURN: P(a,x)
* ret_qax - RETURN: Q(a,x)
*
* Return: <eslOK> on success.
*
* Throws: <eslERANGE> if <a> or <x> is out of accepted range.
* <eslENOHALT> if approximation fails to converge.
*/
int
esl_stats_IncompleteGamma(double a, double x, double *ret_pax, double *ret_qax)
{
int iter; /* iteration counter */
double pax; /* P(a,x) */
double qax; /* Q(a,x) */
if (a <= 0.) ESL_EXCEPTION(eslERANGE, "esl_stats_IncompleteGamma(): a must be > 0");
if (x < 0.) ESL_EXCEPTION(eslERANGE, "esl_stats_IncompleteGamma(): x must be >= 0");
/* For x > a + 1 the following gives rapid convergence;
* calculate Q(a,x) = \frac{\Gamma(a,x)}{\Gamma(a)},
* using a continued fraction development for \Gamma(a,x).
*/
if (x > a+1)
{
double oldp; /* previous value of p */
double nu0, nu1; /* numerators for continued fraction calc */
double de0, de1; /* denominators for continued fraction calc */
nu0 = 0.; /* A_0 = 0 */
de0 = 1.; /* B_0 = 1 */
nu1 = 1.; /* A_1 = 1 */
de1 = x; /* B_1 = x */
oldp = nu1;
for (iter = 1; iter < 100; iter++)
{
/* Continued fraction development:
* set A_j = b_j A_j-1 + a_j A_j-2
* B_j = b_j B_j-1 + a_j B_j-2
* We start with A_2, B_2.
*/
/* j = even: a_j = iter-a, b_j = 1 */
/* A,B_j-2 are in nu0, de0; A,B_j-1 are in nu1,de1 */
nu0 = nu1 + ((double)iter - a) * nu0;
de0 = de1 + ((double)iter - a) * de0;
/* j = odd: a_j = iter, b_j = x */
/* A,B_j-2 are in nu1, de1; A,B_j-1 in nu0,de0 */
nu1 = x * nu0 + (double) iter * nu1;
de1 = x * de0 + (double) iter * de1;
/* rescale */
if (de1 != 0.)
{
nu0 /= de1;
de0 /= de1;
nu1 /= de1;
de1 = 1.;
}
/* check for convergence */
if (fabs((nu1-oldp)/nu1) < 1.e-7)
{
esl_stats_LogGamma(a, &qax);
qax = nu1 * exp(a * log(x) - x - qax);
if (ret_pax != NULL) *ret_pax = 1 - qax;
if (ret_qax != NULL) *ret_qax = qax;
return eslOK;
}
oldp = nu1;
}
ESL_EXCEPTION(eslENOHALT,
"esl_stats_IncompleteGamma(): fraction failed to converge");
}
else /* x <= a+1 */
{
double p; /* current sum */
double val; /* current value used in sum */
/* For x <= a+1 we use a convergent series instead:
* P(a,x) = \frac{\gamma(a,x)}{\Gamma(a)},
* where
* \gamma(a,x) = e^{-x}x^a \sum_{n=0}{\infty} \frac{\Gamma{a}}{\Gamma{a+1+n}} x^n
* which looks appalling but the sum is in fact rearrangeable to
* a simple series without the \Gamma functions:
* = \frac{1}{a} + \frac{x}{a(a+1)} + \frac{x^2}{a(a+1)(a+2)} ...
* and it's obvious that this should converge nicely for x <= a+1.
*/
p = val = 1. / a;
for (iter = 1; iter < 10000; iter++)
{
val *= x / (a+(double)iter);
p += val;
if (fabs(val/p) < 1.e-7)
{
esl_stats_LogGamma(a, &pax);
pax = p * exp(a * log(x) - x - pax);
if (ret_pax != NULL) *ret_pax = pax;
if (ret_qax != NULL) *ret_qax = 1. - pax;
return eslOK;
}
}
ESL_EXCEPTION(eslENOHALT,
"esl_stats_IncompleteGamma(): series failed to converge");
}
/*NOTREACHED*/
return eslOK;
}
