static double
hyperexp_complete_binned_func(double *p, int np, void *dptr)
{
struct hyperexp_binned_data *data = (struct hyperexp_binned_data *) dptr;
ESL_HISTOGRAM *g = data->g;
ESL_HYPEREXP *h = data->h;
double logL = 0.;
double ai, delta;
int i,k;
hyperexp_unpack_paramvector(p, np, h);
delta = g->w;
/* counting over occupied, uncensored histogram bins */
for (i = g->cmin; i <= g->imax; i++)
{
if (g->obs[i] == 0) continue; /* skip unoccupied ones */
ai = esl_histogram_Bin2LBound(g, i);
if (ai < h->mu) ai = h->mu; /* careful about the left boundary: no x < h->mu */
for (k = 0; k < h->K; k++)
{
h->wrk[k] = log(h->q[k]) - h->lambda[k]*(ai-h->mu);
if (delta * h->lambda[k] < eslSMALLX1)
h->wrk[k] += log(delta * h->lambda[k]);
else
h->wrk[k] += log(1 - exp(-delta * h->lambda[k]));
}
logL += g->obs[i] * esl_vec_DLogSum(h->wrk, h->K);
}
return -logL;
}
/* Same as above but in reverse: given parameter vector <p>,
* <np> = 2K-1, do appropriate c.o.v. back to desired parameter space, and
* update the hyperexponential <h>.
*/
static void
hyperexp_unpack_paramvector(double *p, int np, ESL_HYPEREXP *h)
{
int i; /* counter in parameter vector p */
int k; /* counter in mixture components */
double z; /* tmp variable */
/* Fetch the params in their c.o.v. space first
*/
i = 0;
if (! h->fixmix) {
h->q[0] = 0; /* implicitly */
for (k = 1; k < h->K; k++)
h->q[k] = p[i++];
}
for (k = 0; k < h->K; k++)
if (! h->fixlambda[k])
h->lambda[k] = p[i++];
/* Convert mix coefficients back to probabilities;
* their c.o.v. is q_k = e^{Q_k} / \sum_k e^{Q_k}
* which rearranges to exp(Q_k - log[\sum_k e^Q_k]),
* and we have the DLogSum() function to compute the log sum.
*/
if (! h->fixmix) {
z = esl_vec_DLogSum(h->q, h->K);
for (k = 0; k < h->K; k++)
h->q[k] = exp(h->q[k] - z);
}
/* lambda c.o.v. is \lambda = e^w */
for (k = 0; k < h->K; k++)
if (! h->fixlambda[k])
h->lambda[k] = exp(h->lambda[k]);
}
/* Function: esl_vec_DLogNorm()
* Synopsis: Normalize a log p-vector, make it a p-vector.
* Incept: SRE, Thu Apr 7 17:45:39 2005 [St. Louis]
*
* Purpose: Given an unnormalized log probability vector <vec>
* of length <n>, normalize it and make it a
* probability vector.
*
* <esl_vec_FLogNorm()> does the same, but for a vector
* of floats instead of doubles.
*
* Returns: (void); <vec> is changed in place.
*/
void
esl_vec_DLogNorm(double *vec, int n)
{
double denom;
denom = esl_vec_DLogSum(vec, n);
esl_vec_DIncrement(vec, n, -1.*denom);
esl_vec_DExp (vec, n);
esl_vec_DNorm(vec, n);
}
/* Function: esl_mixgev_logsurv()
*
* Purpose: Returns the log survivor function $\log P(X > x)$ (log(1-CDF))
* for quantile <x>, given mixture GEV parameters <mg>.
*/
double
esl_mixgev_logsurv(double x, ESL_MIXGEV *mg)
{
int k;
for (k = 0; k < mg->K; k++)
{
mg->wrk[k] = log(mg->q[k]);
mg->wrk[k] += esl_gev_logsurv(x, mg->mu[k], mg->lambda[k], mg->alpha[k]);
}
return esl_vec_DLogSum(mg->wrk, mg->K);
}
static void
hyperexp_complete_binned_gradient(double *p, int np, void *dptr, double *dp)
{
struct hyperexp_binned_data *data = (struct hyperexp_binned_data *) dptr;
ESL_HISTOGRAM *g = data->g;
ESL_HYPEREXP *h = data->h;
int i,k;
int pidx;
double z;
double tmp;
double ai, delta;
hyperexp_unpack_paramvector(p, np, h);
esl_vec_DSet(dp, np, 0.);
delta = g->w;
/* counting over occupied, uncensored histogram bins */
for (i = g->cmin; i <= g->imax; i++)
{
if (g->obs[i] == 0) continue;
ai = esl_histogram_Bin2LBound(g, i);
if (ai < h->mu) ai = h->mu; /* careful about the left boundary: no x < h->mu */
/* Calculate log (q_m alpha_m(a_i) terms
*/
for (k = 0; k < h->K; k++)
{
h->wrk[k] = log(h->q[k]) - h->lambda[k]*(ai-h->mu);
if (delta * h->lambda[k] < eslSMALLX1)
h->wrk[k] += log(delta * h->lambda[k]);
else
h->wrk[k] += log(1 - exp(-delta * h->lambda[k]));
}
z = esl_vec_DLogSum(h->wrk, h->K); /* z= log \sum_k q_k alpha_k(a_i) */
/* Bump the gradients for Q_1..Q_{K-1} */
pidx = 0;
if (! h->fixmix) {
for (k = 1; k < h->K; k++)
dp[pidx++] -= g->obs[i] * (exp(h->wrk[k] - z) - h->q[k]);
}
/* Bump the gradients for w_0..w_{K-1}
*/
for (k = 0; k < h->K; k++)
if (! h->fixlambda[k])
{
tmp = log(h->q[k]) + log(h->lambda[k])- h->lambda[k]*(ai-h->mu);
tmp = exp(tmp - z);
tmp *= (ai + delta - h->mu) * exp(-delta * h->lambda[k]) - (ai - h->mu);
dp[pidx++] -= g->obs[i] * tmp;
}
}
}
/* Function: esl_mixgev_logpdf()
*
* Purpose: Returns the log of the PDF ($\log P(X=x)$) for quantile <x>,
* given mixture GEV parameters <mg>.
*/
double
esl_mixgev_logpdf(double x, ESL_MIXGEV *mg)
{
int k;
for (k = 0; k < mg->K; k++)
if (mg->q[k] == 0.0)
mg->wrk[k] = -eslINFINITY;
else
mg->wrk[k] = log(mg->q[k]) +
esl_gev_logpdf(x, mg->mu[k], mg->lambda[k], mg->alpha[k]);
return esl_vec_DLogSum(mg->wrk, mg->K);
}
/* Function: esl_hxp_logsurv()
*
* Purpose: Returns the log survivor function $\log P(X > x)$ (log(1-CDF))
* for quantile <x>, given hyperexponential parameters <h>.
*/
double
esl_hxp_logsurv(double x, ESL_HYPEREXP *h)
{
int k;
if (x < h->mu) return 0.0;
for (k = 0; k < h->K; k++)
if (h->q[k] == 0.0)
h->wrk[k] = -eslINFINITY;
else
h->wrk[k] = log(h->q[k]) + esl_exp_logsurv(x, h->mu, h->lambda[k]);
return esl_vec_DLogSum(h->wrk, h->K);
}
/* Same as above but in reverse: given parameter vector <p>,
* do appropriate c.o.v. back to desired parameter space, and
* fill in the mixture GEV structure <mg>.
*/
static void
mixgev_unpack_paramvector(double *p, int np, ESL_MIXGEV *mg)
{
int i; /* counter in parameter vector p */
int k; /* counter in mixture components */
double z; /* tmp variable */
/* Fetch the params in their c.o.v. space first
*/
i = 0;
mg->q[0] = 0; /* implicitly */
for (k = 1; k < mg->K; k++)
mg->q[k] = p[i++];
for (k = 0; k < mg->K; k++)
{
mg->mu[k] = p[i++];
mg->lambda[k] = p[i++];
if (!mg->isgumbel[k]) mg->alpha[k] = p[i++];
else mg->alpha[k] = 0.;
}
assert(i==np);
/* Convert mix coefficients back to probabilities;
* their c.o.v. is q_k = e^{Q_k} / \sum_k e^{Q_k}
* which rearranges to exp(Q_k - log[\sum_k e^Q_k]),
* and we have the DLogSum() function to compute the log sum.
*/
z = esl_vec_DLogSum(mg->q, mg->K);
for (k = 0; k < mg->K; k++)
mg->q[k] = exp(mg->q[k] - z);
/* lambda c.o.v. is \lambda = e^w
*/
for (k = 0; k < mg->K; k++)
mg->lambda[k] = exp(mg->lambda[k]);
}
static void
utest_pvectors(void)
{
char *msg = "pvector unit test failed";
double p1[4] = { 0.25, 0.25, 0.25, 0.25 };
double p2[4];
double p3[4];
float p1f[4];
float p2f[4] = { 0.0, 0.5, 0.5, 0.0 };
float p3f[4];
int n = 4;
double result;
esl_vec_D2F(p1, n, p1f);
esl_vec_F2D(p2f, n, p2);
if (esl_vec_DValidate(p1, n, 1e-12, NULL) != eslOK) esl_fatal(msg);
if (esl_vec_FValidate(p1f, n, 1e-7, NULL) != eslOK) esl_fatal(msg);
result = esl_vec_DEntropy(p1, n); if (esl_DCompare(2.0, result, 1e-9) != eslOK) esl_fatal(msg);
result = esl_vec_FEntropy(p1f, n); if (esl_DCompare(2.0, result, 1e-9) != eslOK) esl_fatal(msg);
result = esl_vec_DEntropy(p2, n); if (esl_DCompare(1.0, result, 1e-9) != eslOK) esl_fatal(msg);
result = esl_vec_FEntropy(p2f, n); if (esl_DCompare(1.0, result, 1e-9) != eslOK) esl_fatal(msg);
result = esl_vec_DRelEntropy(p2, p1, n); if (esl_DCompare(1.0, result, 1e-9) != eslOK) esl_fatal(msg);
result = esl_vec_FRelEntropy(p2f, p1f, n); if (esl_DCompare(1.0, result, 1e-9) != eslOK) esl_fatal(msg);
result = esl_vec_DRelEntropy(p1, p2, n); if (result != eslINFINITY) esl_fatal(msg);
result = esl_vec_FRelEntropy(p1f, p2f, n); if (result != eslINFINITY) esl_fatal(msg);
esl_vec_DLog(p2, n);
if (esl_vec_DLogValidate(p2, n, 1e-12, NULL) != eslOK) esl_fatal(msg);
esl_vec_DExp(p2, n);
if (p2[0] != 0.) esl_fatal(msg);
esl_vec_FLog(p2f, n);
if (esl_vec_FLogValidate(p2f, n, 1e-7, NULL) != eslOK) esl_fatal(msg);
esl_vec_FExp(p2f, n);
if (p2f[0] != 0.) esl_fatal(msg);
esl_vec_DCopy(p2, n, p3);
esl_vec_DScale(p3, n, 10.);
esl_vec_DNorm(p3, n);
if (esl_vec_DCompare(p2, p3, n, 1e-12) != eslOK) esl_fatal(msg);
esl_vec_DLog(p3, n);
result = esl_vec_DLogSum(p3, n); if (esl_DCompare(0.0, result, 1e-12) != eslOK) esl_fatal(msg);
esl_vec_DIncrement(p3, n, 2.0);
esl_vec_DLogNorm(p3, n);
if (esl_vec_DCompare(p2, p3, n, 1e-12) != eslOK) esl_fatal(msg);
esl_vec_FCopy(p2f, n, p3f);
esl_vec_FScale(p3f, n, 10.);
esl_vec_FNorm(p3f, n);
if (esl_vec_FCompare(p2f, p3f, n, 1e-7) != eslOK) esl_fatal(msg);
esl_vec_FLog(p3f, n);
result = esl_vec_FLogSum(p3f, n); if (esl_DCompare(0.0, result, 1e-7) != eslOK) esl_fatal(msg);
esl_vec_FIncrement(p3f, n, 2.0);
esl_vec_FLogNorm(p3f, n);
if (esl_vec_FCompare(p2f, p3f, n, 1e-7) != eslOK) esl_fatal(msg);
return;
}
