void GLaguer::lgr(long m, double alpha, raterootarray lgroot)
{ /* For use by initgammacat. Get roots of m-th Generalized Laguerre
polynomial, given roots of (m-1)-th, these are to be
stored in lgroot[m][] */
long i;
double upper, lower, x, y;
bool dwn; /* is function declining in this interval? */
if (m == 1) {
lgroot[1][1] = 1.0+alpha;
} else {
dwn = true;
for (i=1; i<=m; i++) {
if (i < m) {
if (i == 1)
lower = 0.0;
else
lower = lgroot[m-1][i-1];
upper = lgroot[m-1][i];
}
else { /* i == m, must search above */
lower = lgroot[m-1][i-1];
x = lgroot[m-1][m-1];
do {
x = 2.0*x;
y = glaguerre(m, alpha,x);
} while ((dwn && (y > 0.0)) || ((!dwn) && (y < 0.0)));
upper = x;
}
while (upper-lower > 0.000000001) {
x = (upper+lower)/2.0;
if (glaguerre(m, alpha, x) > 0.0) {
if (dwn)
lower = x;
else
upper = x;
}
else {
if (dwn)
upper = x;
else
lower = x;
}
}
lgroot[m][i] = (lower+upper)/2.0;
dwn = !dwn; // switch for next one
}
}
} /* lgr */
void GLaguer::GetPhylipLaguer(const int categs, MDOUBLE alpha, Vdouble & points, Vdouble & weights)
{
/* calculate rates and probabilities to approximate Gamma distribution
of rates with "categs" categories and shape parameter "alpha" using
rates and weights from Generalized Laguerre quadrature */
points.resize(categs, 0.0);
weights.resize(categs, 0.0);
long i;
raterootarray lgroot; /* roots of GLaguerre polynomials */
double f, x, xi, y;
alpha = alpha - 1.0;
lgroot[1][1] = 1.0+alpha;
for (i = 2; i <= categs; i++)
{
cerr<<lgroot[i][1]<<"\t";
lgr(i, alpha, lgroot); /* get roots for L^(a)_n */
cerr<<lgroot[i][1]<<endl;
}
/* here get weights */
/* Gamma weights are (1+a)(1+a/2) ... (1+a/n)*x_i/((n+1)^2 [L_{n+1}^a(x_i)]^2) */
f = 1;
for (i = 1; i <= categs; i++)
f *= (1.0+alpha/i);
for (i = 1; i <= categs; i++) {
xi = lgroot[categs][i];
y = glaguerre(categs+1, alpha, xi);
x = f*xi/((categs+1)*(categs+1)*y*y);
points[i-1] = xi/(1.0+alpha);
weights[i-1] = x;
}
}
void
initlaguerrecat (long categs, MYREAL alpha, MYREAL theta1, MYREAL *rate,
MYREAL *probcat)
{
long i;
MYREAL **lgroot; /* roots of GLaguerre polynomials */
MYREAL f, x, xi, y;
lgroot = (MYREAL **) mycalloc (categs + 1, sizeof (MYREAL *));
lgroot[0] =
(MYREAL *) mycalloc ((categs + 1) * (categs + 1), sizeof (MYREAL));
for (i = 1; i < categs + 1; i++)
{
lgroot[i] = lgroot[0] + i * (categs + 1);
}
lgroot[1][1] = 1.0 + alpha;
for (i = 2; i <= categs; i++)
roots_laguerre (i, alpha, lgroot); /* get roots for L^(a)_n */
/* here get weights */
/* Gamma weights are
(1+a)(1+a/2) ... (1+a/n)*x_i/((n+1)^2 [L_{n+1}^a(x_i)]^2) */
f = 1;
for (i = 1; i <= categs; i++)
f *= (1.0 + alpha / i);
for (i = 1; i <= categs; i++)
{
xi = lgroot[categs][i];
y = glaguerre (categs + 1, alpha, xi);
x = f * xi / ((categs + 1) * (categs + 1) * y * y);
rate[i - 1] = xi / (1.0 + alpha);
probcat[i - 1] = x;
}
for (i = 0; i < categs; i++)
{
probcat[i] = LOG (probcat[i]);
rate[i] *= theta1;
}
myfree(lgroot[0]);
myfree(lgroot);
} /* initgammacat */
///
/// For use by initgammacat().
/// Get roots of m-th Generalized Laguerre polynomial, given roots
/// of (m-1)-th, these are to be stored in lgroot[m][]
void
roots_laguerre (long m, MYREAL b, MYREAL **lgroot)
{
long i;
long count=0;
MYREAL upperl, lower, x, y;
boolean dwn = FALSE;
//MYREAL tmp;
/* is function declining in this interval? */
if (m == 1)
{
lgroot[1][1] = 1.0 + b;
}
else
{
dwn = TRUE;
for (i = 1; i <= m; i++)
{
if (i < m)
{
if (i == 1)
lower = 0.0;
else
lower = lgroot[m - 1][i - 1];
upperl = lgroot[m - 1][i];
}
else
{ /* i == m, must search above */
lower = lgroot[m - 1][i - 1];
x = lgroot[m - 1][m - 1];
do
{
x = 2.0 * x;
y = glaguerre (m, b, x);
}
while ((dwn && (y > 0.0)) || ((!dwn) && (y < 0.0)));
upperl = x;
}
count = 0;
while (upperl - lower > 0.000000001 && count++ < 1000)
{
x = (upperl + lower) / 2.0;
if (glaguerre (m, b, x) > 0.0)
{
if (dwn)
lower = x;
else
upperl = x;
}
else
{
if (dwn)
upperl = x;
else
lower = x;
}
}
lgroot[m][i] = (lower + upperl) / 2.0;
dwn = !dwn; /* switch for next one */
}
}
} /* root_laguerre */
void
roots_laguerre(long m, double b, double **lgroot)
{
/* For use by initgammacat.
Get roots of m-th Generalized Laguerre polynomial, given roots
of (m-1)-th, these are to be stored in lgroot[m][] */
long i;
double upper, lower, x, y;
boolean dwn=FALSE;
double tmp;
/* is function declining in this interval? */
if (m == 1)
{
lgroot[1][1] = 1.0 + b;
}
else
{
dwn = TRUE;
for (i = 1; i <= m; i++)
{
if (i < m)
{
if (i == 1)
lower = 0.0;
else
lower = lgroot[m - 1][i - 1];
upper = lgroot[m - 1][i];
}
else
{ /* i == m, must search above */
lower = lgroot[m - 1][i - 1];
x = lgroot[m - 1][m - 1];
do
{
x = 2.0 * x;
y = glaguerre (m, b, x);
}
while ((dwn && (y > 0.0)) || ((!dwn) && (y < 0.0)));
upper = x;
}
while (upper - lower > 0.000000001)
{
x = (upper + lower) / 2.0;
if ((tmp=glaguerre (m, b, x)) > 0.0)
{
if (dwn)
lower = x;
else
upper = x;
}
else
{
if (dwn)
upper = x;
else
lower = x;
}
}
lgroot[m][i] = (lower + upper) / 2.0;
dwn = !dwn; /* switch for next one */
}
}
} /* root_laguerre */
