double Random::Poisson(double lambda)
{
static double sq, alxm, g, oldm = -1.0;
double em, t, y;
const double PI = 3.1415926535897932;
if (lambda < 12.0) {
if (lambda != oldm) {
oldm = lambda;
g = exp(-lambda);
}
em = -1;
t = 1.0;
do {
++em;
t *= rng_open();
} while (t > g);
} else {
if (lambda != oldm) {
oldm = lambda;
sq = sqrt(2.0 * lambda);
alxm = log(lambda);
g = lambda * alxm - gammalog(lambda + 1.0);
}
do {
do {
y = tan(PI * rng_open());
em = sq * y + lambda;
} while (em < 0.0);
em = floor(em);
t = 0.9 * (1.0 + y * y) * exp(em * alxm - gammalog(em + 1.0)-g);
} while (rng_open() > t);
}
return em;
}
// d/d a_i f(a_i, b_i) = - sum_j sum_k pgtab_jk
// (NB'_r(c_ij, a_i, b_i / (g_jk d_j t_i + b_i)) /
// NB(c_ij, a_i, b_i / (g_jk d_j t_i + b_i)))
static void sp_rate_df(const gsl_vector *x, void *params, gsl_vector *df)
{
RatesEM *em = (RatesEM*) params;
double sp_alpha_i = gsl_vector_get(x, 0);
double sp_beta_i = gsl_vector_get(x, 1);
int i = em->cur_species;
double alpha_sum = 0.0;
double beta_sum = 0.0;
for (int j=0; j<em->ntrees; j++) {
double l = em->lengths[j][i];
// skip nulls
if (l < 0)
continue;
for (int k=0; k<em->nrates; k++) {
double g = em->gtab[j][k];
double bgt = sp_beta_i / (g * em->times[i]);
double lngamma = gammalog(l, sp_alpha_i, bgt);
double gamma = exp(lngamma);
if (gamma != 0.0) {
alpha_sum += em->pgtab[j][k] *
gammaDerivA(l, sp_alpha_i, bgt) / gamma;
beta_sum += em->pgtab[j][k] *
gammaDerivB(l, sp_alpha_i, bgt) /
(gamma * g * em->times[i]);
}
}
}
gsl_vector_set(df, 0, -alpha_sum);
gsl_vector_set(df, 1, -beta_sum);
}
float likelihood()
{
double logl = 0.0;
for (int j=0; j<ntrees; j++) {
double sum = 0.0;
for (int k=0; k<nrates; k++) {
double prod = 0.0;
for (int i=0; i<nspecies; i++) {
double l = lengths[j][i];
// skip nulls
if (l < 0)
continue;
prod += gammalog(l, sp_alpha[i],
sp_beta[i] / (times[i] * gtab[j][k]));
}
sum += pgtab[j][k] * exp(prod);
}
logl += log(sum);
}
return logl;
}
// f(a_i, b_i) = - sum_j sum_k pgtab_jk
// log(NB(c_ij, a_i, b_i / (g_jk d_j t_i + b_i)))
static double sp_rate_f(const gsl_vector *x, void *params)
{
RatesEM *em = (RatesEM*) params;
double sp_alpha_i = gsl_vector_get(x, 0);
double sp_beta_i = gsl_vector_get(x, 1);
int i = em->cur_species;
double sum = 0.0;
for (int j=0; j<em->ntrees; j++) {
// skip nulls
if (em->lengths[j][i] < 0)
continue;
for (int k=0; k<em->nrates; k++) {
double lngamma = gammalog(em->lengths[j][i], sp_alpha_i,
sp_beta_i / (em->gtab[j][k] *
em->times[i]));
if (!isnan(lngamma))
sum += em->pgtab[j][k] * lngamma;
}
}
return -sum;
}
