void
_arb_poly_evaluate_rectangular(arb_t y, arb_srcptr poly,
long len, const arb_t x, long prec)
{
long i, j, m, r;
arb_ptr xs;
arb_t s, t, c;
if (len < 3)
{
if (len == 0)
{
arb_zero(y);
}
else if (len == 1)
{
arb_set_round(y, poly + 0, prec);
}
else if (len == 2)
{
arb_mul(y, x, poly + 1, prec);
arb_add(y, y, poly + 0, prec);
}
return;
}
m = n_sqrt(len) + 1;
r = (len + m - 1) / m;
xs = _arb_vec_init(m + 1);
arb_init(s);
arb_init(t);
arb_init(c);
_arb_vec_set_powers(xs, x, m + 1, prec);
arb_set(y, poly + (r - 1) * m);
for (j = 1; (r - 1) * m + j < len; j++)
arb_addmul(y, xs + j, poly + (r - 1) * m + j, prec);
for (i = r - 2; i >= 0; i--)
{
arb_set(s, poly + i * m);
for (j = 1; j < m; j++)
arb_addmul(s, xs + j, poly + i * m + j, prec);
arb_mul(y, y, xs + m, prec);
arb_add(y, y, s, prec);
}
_arb_vec_clear(xs, m + 1);
arb_clear(s);
arb_clear(t);
arb_clear(c);
}
void
_arb_poly_revert_series_lagrange_fast(arb_ptr Qinv, arb_srcptr Q, long Qlen, long n, long prec)
{
long i, j, k, m;
arb_ptr R, S, T, tmp;
arb_t t;
if (n <= 2)
{
if (n >= 1)
arb_zero(Qinv);
if (n == 2)
arb_inv(Qinv + 1, Q + 1, prec);
return;
}
m = n_sqrt(n);
arb_init(t);
R = _arb_vec_init((n - 1) * m);
S = _arb_vec_init(n - 1);
T = _arb_vec_init(n - 1);
arb_zero(Qinv);
arb_inv(Qinv + 1, Q + 1, prec);
_arb_poly_inv_series(Ri(1), Q + 1, FLINT_MIN(Qlen, n) - 1, n - 1, prec);
for (i = 2; i <= m; i++)
_arb_poly_mullow(Ri(i), Ri((i + 1) / 2), n - 1, Ri(i / 2), n - 1, n - 1, prec);
for (i = 2; i < m; i++)
arb_div_ui(Qinv + i, Ri(i) + i - 1, i, prec);
_arb_vec_set(S, Ri(m), n - 1);
for (i = m; i < n; i += m)
{
arb_div_ui(Qinv + i, S + i - 1, i, prec);
for (j = 1; j < m && i + j < n; j++)
{
arb_mul(t, S + 0, Ri(j) + i + j - 1, prec);
for (k = 1; k <= i + j - 1; k++)
arb_addmul(t, S + k, Ri(j) + i + j - 1 - k, prec);
arb_div_ui(Qinv + i + j, t, i + j, prec);
}
if (i + 1 < n)
{
_arb_poly_mullow(T, S, n - 1, Ri(m), n - 1, n - 1, prec);
tmp = S; S = T; T = tmp;
}
}
arb_clear(t);
_arb_vec_clear(R, (n - 1) * m);
_arb_vec_clear(S, n - 1);
_arb_vec_clear(T, n - 1);
}
void
_arb_poly_sinh_cosh_series_basecase(arb_ptr s, arb_ptr c, arb_srcptr h, slong hlen,
slong n, slong prec)
{
slong j, k, alen = FLINT_MIN(n, hlen);
arb_ptr a;
arb_t t, u;
arb_sinh_cosh(s, c, h, prec);
if (hlen == 1)
{
_arb_vec_zero(s + 1, n - 1);
_arb_vec_zero(c + 1, n - 1);
return;
}
arb_init(t);
arb_init(u);
a = _arb_vec_init(alen);
for (k = 1; k < alen; k++)
arb_mul_ui(a + k, h + k, k, prec);
for (k = 1; k < n; k++)
{
arb_zero(t);
arb_zero(u);
for (j = 1; j < FLINT_MIN(k + 1, hlen); j++)
{
arb_addmul(t, a + j, s + k - j, prec);
arb_addmul(u, a + j, c + k - j, prec);
}
arb_div_ui(c + k, t, k, prec);
arb_div_ui(s + k, u, k, prec);
}
arb_clear(t);
arb_clear(u);
_arb_vec_clear(a, alen);
}
static void
zeta_bsplit(zeta_bsplit_t L, slong a, slong b,
slong n, slong s, int cont, slong bits)
{
if (a + 1 == b)
{
zeta_coeff_k(L, a, n, s);
}
else
{
zeta_bsplit_t R;
slong m = (a + b) / 2;
zeta_bsplit(L, m, b, n, s, 1, bits);
zeta_bsplit_init(R);
zeta_bsplit(R, a, m, n, s, 1, bits);
arb_mul(L->B, L->B, R->D, bits);
arb_addmul(L->B, L->A, R->C, bits);
arb_mul(L->B, L->B, R->Q2, bits);
arb_addmul(L->B, R->B, L->Q3, bits);
arb_mul(L->A, L->A, R->Q3, bits);
arb_addmul(L->A, R->A, L->Q3, bits);
arb_mul(L->C, L->C, R->D, bits);
arb_addmul(L->C, R->C, L->Q1, bits);
if (cont)
{
arb_mul(L->D, L->D, R->D, bits);
arb_mul(L->Q2, L->Q2, R->Q2, bits);
}
arb_mul(L->Q1, L->Q1, R->Q1, bits);
arb_mul(L->Q3, L->Q3, R->Q3, bits);
zeta_bsplit_clear(R);
}
}
void arb_mat_L2norm(arb_t out, const arb_mat_t in, slong prec) {
int nrows = arb_mat_nrows(in);
int ncols = arb_mat_ncols(in);
arb_zero(out);
for(int i = 0; i < nrows; i++) {
for(int j = 0; j < ncols; j++) {
arb_addmul(out, arb_mat_entry(in, i, j), arb_mat_entry(in, i, j), prec);
}
}
arb_sqrtpos(out, out, prec);
}
static void
bsplit(arb_poly_t pol, const arb_t sqrtD,
const slong * qbf, slong a, slong b, slong prec)
{
if (b - a == 0)
{
arb_poly_one(pol);
}
else if (b - a == 1)
{
acb_t z;
acb_init(z);
/* j((-b+sqrt(-D))/(2a)) */
arb_set_si(acb_realref(z), -FLINT_ABS(qbf[3 * a + 1]));
arb_set(acb_imagref(z), sqrtD);
acb_div_si(z, z, 2 * qbf[3 * a], prec);
acb_modular_j(z, z, prec);
if (qbf[3 * a + 1] < 0)
{
/* (x^2 - 2re(j) x + |j|^2) */
arb_poly_fit_length(pol, 3);
arb_mul(pol->coeffs, acb_realref(z), acb_realref(z), prec);
arb_addmul(pol->coeffs, acb_imagref(z), acb_imagref(z), prec);
arb_mul_2exp_si(pol->coeffs + 1, acb_realref(z), 1);
arb_neg(pol->coeffs + 1, pol->coeffs + 1);
arb_one(pol->coeffs + 2);
_arb_poly_set_length(pol, 3);
}
else
{
/* (x-j) */
arb_poly_fit_length(pol, 2);
arb_neg(pol->coeffs, acb_realref(z));
arb_one(pol->coeffs + 1);
_arb_poly_set_length(pol, 2);
}
acb_clear(z);
}
else
{
arb_poly_t tmp;
arb_poly_init(tmp);
bsplit(pol, sqrtD, qbf, a, a + (b - a) / 2, prec);
bsplit(tmp, sqrtD, qbf, a + (b - a) / 2, b, prec);
arb_poly_mul(pol, pol, tmp, prec);
arb_poly_clear(tmp);
}
}
void
arb_mat_mul_classical(arb_mat_t C, const arb_mat_t A, const arb_mat_t B, long prec)
{
long ar, ac, br, bc, i, j, k;
ar = arb_mat_nrows(A);
ac = arb_mat_ncols(A);
br = arb_mat_nrows(B);
bc = arb_mat_ncols(B);
if (ac != br || ar != arb_mat_nrows(C) || bc != arb_mat_ncols(C))
{
printf("arb_mat_mul: incompatible dimensions\n");
abort();
}
if (br == 0)
{
arb_mat_zero(C);
return;
}
if (A == C || B == C)
{
arb_mat_t T;
arb_mat_init(T, ar, bc);
arb_mat_mul(T, A, B, prec);
arb_mat_swap(T, C);
arb_mat_clear(T);
return;
}
for (i = 0; i < ar; i++)
{
for (j = 0; j < bc; j++)
{
arb_mul(arb_mat_entry(C, i, j),
arb_mat_entry(A, i, 0),
arb_mat_entry(B, 0, j), prec);
for (k = 1; k < br; k++)
{
arb_addmul(arb_mat_entry(C, i, j),
arb_mat_entry(A, i, k),
arb_mat_entry(B, k, j), prec);
}
}
}
}
void
custom_rate_mixture_expectation(arb_t rate, const custom_rate_mixture_t x, slong prec)
{
if (x->mode == RATE_MIXTURE_UNDEFINED)
{
flint_fprintf(stderr, "internal error: undefined rate mixture\n");
abort();
}
else if (x->mode == RATE_MIXTURE_NONE)
{
arb_one(rate);
}
else if (x->mode == RATE_MIXTURE_UNIFORM || x->mode == RATE_MIXTURE_CUSTOM)
{
slong i;
arb_t tmp, tmpb;
arb_init(tmp);
arb_init(tmpb);
arb_zero(rate);
if (x->mode == RATE_MIXTURE_UNIFORM)
{
for (i = 0; i < x->n; i++)
{
arb_set_d(tmp, x->rates[i]);
arb_add(rate, rate, tmp, prec);
}
arb_div_si(rate, rate, x->n, prec);
}
else if (x->mode == RATE_MIXTURE_CUSTOM)
{
for (i = 0; i < x->n; i++)
{
arb_set_d(tmp, x->rates[i]);
arb_set_d(tmpb, x->prior[i]);
arb_addmul(rate, tmp, tmpb, prec);
}
}
arb_clear(tmp);
arb_clear(tmpb);
}
else
{
flint_fprintf(stderr, "internal error: "
"unrecognized rate mixture mode\n");
abort();
}
}
void
_arb_poly_mullow_classical(arb_ptr res,
arb_srcptr poly1, long len1,
arb_srcptr poly2, long len2, long n, long prec)
{
len1 = FLINT_MIN(len1, n);
len2 = FLINT_MIN(len2, n);
if (n == 1)
{
arb_mul(res, poly1, poly2, prec);
}
else if (poly1 == poly2 && len1 == len2)
{
long i;
_arb_vec_scalar_mul(res, poly1, FLINT_MIN(len1, n), poly1, prec);
_arb_vec_scalar_mul(res + len1, poly1 + 1, n - len1, poly1 + len1 - 1, prec);
for (i = 1; i < len1 - 1; i++)
_arb_vec_scalar_addmul(res + i + 1, poly1 + 1,
FLINT_MIN(i - 1, n - (i + 1)), poly1 + i, prec);
for (i = 1; i < FLINT_MIN(2 * len1 - 2, n); i++)
arb_mul_2exp_si(res + i, res + i, 1);
for (i = 1; i < FLINT_MIN(len1 - 1, (n + 1) / 2); i++)
arb_addmul(res + 2 * i, poly1 + i, poly1 + i, prec);
}
else
{
long i;
_arb_vec_scalar_mul(res, poly1, FLINT_MIN(len1, n), poly2, prec);
if (n > len1)
_arb_vec_scalar_mul(res + len1, poly2 + 1, n - len1,
poly1 + len1 - 1, prec);
for (i = 0; i < FLINT_MIN(len1, n) - 1; i++)
_arb_vec_scalar_addmul(res + i + 1, poly2 + 1,
FLINT_MIN(len2, n - i) - 1,
poly1 + i, prec);
}
}
void arb_twobytwo_diag(arb_t u1, arb_t u2, const arb_t a, const arb_t b, const arb_t d, slong prec) {
// Compute the orthogonal matrix that diagonalizes
//
// A = [a b]
// [b d]
//
// This matrix will have the form
//
// U = [cos x , -sin x]
// [sin x, cos x]
//
// where the diagonal matrix is U^t A U.
// We set u1 = cos x, u2 = -sin x.
if(arb_contains_zero(b)) {
// this is not quite right (doesn't set error intervals)
arb_set_ui(u1, 1);
arb_set_ui(u2, 0);
return;
}
arb_t x; arb_init(x);
arb_mul(u1, b, b, prec); // u1 = b^2
arb_sub(u2, a, d, prec); // u2 = a - d
arb_mul_2exp_si(u2, u2, -1); // u2 = (a - d)/2
arb_mul(u2, u2, u2, prec); // u2 = ( (a - d)/2 )^2
arb_add(u1, u1, u2, prec); // u1 = b^2 + ( (a-d)/2 )^2
arb_sqrt(u1, u1, prec); // u1 = sqrt(above)
arb_mul_2exp_si(u1, u1, 1); // u1 = 2 (sqrt (above) )
arb_add(u1, u1, d, prec); // u1 += d
arb_sub(u1, u1, a, prec); // u1 -= a
arb_mul_2exp_si(u1, u1, -1); // u1 = (d - a)/2 + sqrt(b^2 + ( (a-d)/2 )^2)
arb_mul(x, u1, u1, prec);
arb_addmul(x, b, b, prec); // x = u1^2 + b^2
arb_sqrt(x, x, prec); // x = sqrt(u1^2 + b^2)
arb_div(u2, u1, x, prec);
arb_div(u1, b, x, prec);
arb_neg(u1, u1);
arb_clear(x);
}
void
evaluate_site_frechet(
arb_struct *lhood_scaled_edge_expectations,
const arb_mat_struct *lhood_node_vectors,
const arb_mat_struct *forward_edge_vectors,
const arb_mat_struct *frechet_matrices,
const csr_graph_t g, int *preorder,
int node_count, int state_count, slong prec)
{
slong u, idx, state;
arb_mat_t fvec;
arb_mat_init(fvec, state_count, 1);
for (u = 0; u < node_count; u++)
{
slong a = preorder[u];
slong start = g->indptr[a];
slong stop = g->indptr[a+1];
for (idx = start; idx < stop; idx++)
{
slong b = g->indices[idx];
const arb_mat_struct *lvec = lhood_node_vectors + b;
const arb_mat_struct *evec = forward_edge_vectors + idx;
arb_zero(lhood_scaled_edge_expectations + idx);
arb_mat_mul(fvec, frechet_matrices + idx, lvec, prec);
for (state = 0; state < state_count; state++)
{
arb_addmul(lhood_scaled_edge_expectations + idx,
arb_mat_entry(fvec, state, 0),
arb_mat_entry(evec, state, 0), prec);
}
}
}
arb_mat_clear(fvec);
}
void
arb_mat_frobenius_norm(arb_t res, const arb_mat_t A, slong prec)
{
slong i, j, r, c;
r = arb_mat_nrows(A);
c = arb_mat_ncols(A);
arb_zero(res);
if (r == 0 || c == 0)
return;
for (i = 0; i < r; i++)
{
for (j = 0; j < c; j++)
{
arb_srcptr x = arb_mat_entry(A, i, j);
arb_addmul(res, x, x, prec);
}
}
arb_sqrtpos(res, res, prec);
}
void
_arb_poly_taylor_shift_horner(arb_ptr poly, const arb_t c, slong n, slong prec)
{
slong i, j;
if (arb_is_one(c))
{
for (i = n - 2; i >= 0; i--)
for (j = i; j < n - 1; j++)
arb_add(poly + j, poly + j, poly + j + 1, prec);
}
else if (arb_equal_si(c, -1))
{
for (i = n - 2; i >= 0; i--)
for (j = i; j < n - 1; j++)
arb_sub(poly + j, poly + j, poly + j + 1, prec);
}
else if (!arb_is_zero(c))
{
for (i = n - 2; i >= 0; i--)
for (j = i; j < n - 1; j++)
arb_addmul(poly + j, poly + j + 1, c, prec);
}
}
void
_arb_bell_sum_taylor(arb_t res, const fmpz_t n,
const fmpz_t a, const fmpz_t b, const fmpz_t mmag, long tol)
{
fmpz_t m, r, R, tmp;
mag_t B, C, D, bound;
arb_t t, u;
long wp, k, N;
if (_fmpz_sub_small(b, a) < 5)
{
arb_bell_sum_bsplit(res, n, a, b, mmag, tol);
return;
}
fmpz_init(m);
fmpz_init(r);
fmpz_init(R);
fmpz_init(tmp);
/* r = max(m - a, b - m) */
/* m = a + (b - a) / 2 */
fmpz_sub(r, b, a);
fmpz_cdiv_q_2exp(r, r, 1);
fmpz_add(m, a, r);
fmpz_mul_2exp(R, r, RADIUS_BITS);
mag_init(B);
mag_init(C);
mag_init(D);
mag_init(bound);
arb_init(t);
arb_init(u);
if (fmpz_cmp(R, m) >= 0)
{
mag_inf(C);
mag_inf(D);
}
else
{
/* C = exp(R * |F'(m)| + (1/2) R^2 * (n/(m-R)^2 + 1/(m-R))) */
/* C = exp(R * (|F'(m)| + (1/2) R * (n/(m-R) + 1)/(m-R))) */
/* D = (1/2) R * (n/(m-R) + 1)/(m-R) */
fmpz_sub(tmp, m, R);
mag_set_fmpz(D, n);
mag_div_fmpz(D, D, tmp);
mag_one(C);
mag_add(D, D, C);
mag_div_fmpz(D, D, tmp);
mag_mul_fmpz(D, D, R);
mag_mul_2exp_si(D, D, -1);
/* C = |F'(m)| */
wp = 20 + 1.05 * fmpz_bits(n);
arb_set_fmpz(t, n);
arb_div_fmpz(t, t, m, wp);
fmpz_add_ui(tmp, m, 1);
arb_set_fmpz(u, tmp);
arb_digamma(u, u, wp);
arb_sub(t, t, u, wp);
arb_get_mag(C, t);
/* C = exp(R * (C + D)) */
mag_add(C, C, D);
mag_mul_fmpz(C, C, R);
mag_exp(C, C);
}
if (mag_cmp_2exp_si(C, tol / 4 + 2) > 0)
{
_arb_bell_sum_taylor(res, n, a, m, mmag, tol);
_arb_bell_sum_taylor(t, n, m, b, mmag, tol);
arb_add(res, res, t, 2 * tol);
}
else
{
arb_ptr mx, ser1, ser2, ser3;
/* D = T(m) */
wp = 20 + 1.05 * fmpz_bits(n);
arb_set_fmpz(t, m);
arb_pow_fmpz(t, t, n, wp);
fmpz_add_ui(tmp, m, 1);
arb_gamma_fmpz(u, tmp, wp);
arb_div(t, t, u, wp);
arb_get_mag(D, t);
/* error bound: (b-a) * C * D * B^N / (1 - B), B = r/R */
/* ((b-a) * C * D * 2) * 2^(-N*RADIUS_BITS) */
/* ((b-a) * C * D * 2) */
mag_mul(bound, C, D);
mag_mul_2exp_si(bound, bound, 1);
fmpz_sub(tmp, b, a);
mag_mul_fmpz(bound, bound, tmp);
/* N = (tol + log2((b-a)*C*D*2) - mmag) / RADIUS_BITS */
if (mmag == NULL)
{
/* estimate D ~= 2^mmag */
fmpz_add_ui(tmp, MAG_EXPREF(C), tol);
fmpz_cdiv_q_ui(tmp, tmp, RADIUS_BITS);
}
else
{
fmpz_sub(tmp, MAG_EXPREF(bound), mmag);
fmpz_add_ui(tmp, tmp, tol);
fmpz_cdiv_q_ui(tmp, tmp, RADIUS_BITS);
}
if (fmpz_cmp_ui(tmp, 5 * tol / 4) > 0)
N = 5 * tol / 4;
else if (fmpz_cmp_ui(tmp, 2) < 0)
N = 2;
else
N = fmpz_get_ui(tmp);
/* multiply by 2^(-N*RADIUS_BITS) */
mag_mul_2exp_si(bound, bound, -N * RADIUS_BITS);
mx = _arb_vec_init(2);
ser1 = _arb_vec_init(N);
ser2 = _arb_vec_init(N);
ser3 = _arb_vec_init(N);
/* estimate (this should work for moderate n and tol) */
wp = 1.1 * tol + 1.05 * fmpz_bits(n) + 5;
/* increase precision until convergence */
while (1)
{
/* (m+x)^n / gamma(m+1+x) */
arb_set_fmpz(mx, m);
arb_one(mx + 1);
_arb_poly_log_series(ser1, mx, 2, N, wp);
for (k = 0; k < N; k++)
arb_mul_fmpz(ser1 + k, ser1 + k, n, wp);
arb_add_ui(mx, mx, 1, wp);
_arb_poly_lgamma_series(ser2, mx, 2, N, wp);
_arb_vec_sub(ser1, ser1, ser2, N, wp);
_arb_poly_exp_series(ser3, ser1, N, N, wp);
/* t = a - m, u = b - m */
arb_set_fmpz(t, a);
arb_sub_fmpz(t, t, m, wp);
arb_set_fmpz(u, b);
arb_sub_fmpz(u, u, m, wp);
arb_power_sum_vec(ser1, t, u, N, wp);
arb_zero(res);
for (k = 0; k < N; k++)
arb_addmul(res, ser3 + k, ser1 + k, wp);
if (mmag != NULL)
{
if (_fmpz_sub_small(MAG_EXPREF(arb_radref(res)), mmag) <= -tol)
break;
}
else
{
if (arb_rel_accuracy_bits(res) >= tol)
break;
}
wp = 2 * wp;
}
/* add the series truncation bound */
arb_add_error_mag(res, bound);
_arb_vec_clear(mx, 2);
_arb_vec_clear(ser1, N);
_arb_vec_clear(ser2, N);
_arb_vec_clear(ser3, N);
}
mag_clear(B);
mag_clear(C);
mag_clear(D);
mag_clear(bound);
arb_clear(t);
arb_clear(u);
fmpz_clear(m);
fmpz_clear(r);
fmpz_clear(R);
fmpz_clear(tmp);
}
/*
* Note that the expectations are multiplied by the rates.
* This is a difference from the analogous function in arbplfdwell.c.
*/
static void
_update_site(nd_accum_t arr,
likelihood_ws_t w, cross_site_ws_t csw, model_and_data_t m,
int *coords, slong site, slong prec)
{
int edge, idx, cat;
arb_t site_lhood, cat_lhood, lhood;
arb_t tmp;
slong state_count = model_and_data_state_count(m);
slong edge_count = model_and_data_edge_count(m);
slong node_count = model_and_data_node_count(m);
slong rate_category_count = model_and_data_rate_category_count(m);
arb_init(site_lhood);
arb_init(cat_lhood);
arb_init(lhood);
arb_init(tmp);
/* only the edge axis is handled at this depth */
nd_axis_struct *edge_axis = arr->axes + EDGE_AXIS;
/* update base node vectors */
pmat_update_base_node_vectors(w->base_node_vectors, m->p, site);
/* clear cross-category expectations and site lhood */
_arb_vec_zero(w->cc_edge_expectations, edge_count);
arb_zero(site_lhood);
for (cat = 0; cat < rate_category_count; cat++)
{
const arb_struct * cat_rate = csw->rate_mix_rates + cat;
const arb_struct * prior_prob = csw->rate_mix_prior + cat;
arb_mat_struct *tmat_base, *fmat_base;
tmat_base = cross_site_ws_transition_matrix(csw, cat, 0);
fmat_base = cross_site_ws_trans_frechet_matrix(csw, cat, 0);
/*
* Update per-node and per-edge likelihood vectors.
* Actually the likelihood vectors on edges are not used.
* This is a backward pass from the leaves to the root.
*/
evaluate_site_lhood(lhood,
w->lhood_node_vectors,
w->lhood_edge_vectors,
w->base_node_vectors,
m->root_prior, csw->equilibrium,
tmat_base,
m->g, m->navigation->preorder, node_count, prec);
/* Update forward vectors. */
evaluate_site_forward(
w->forward_edge_vectors,
w->forward_node_vectors,
w->base_node_vectors,
w->lhood_edge_vectors,
m->root_prior, csw->equilibrium,
tmat_base, m->g, m->navigation,
csw->node_count, csw->state_count, prec);
/* Update expectations at edges. */
evaluate_site_frechet(
w->edge_expectations,
w->lhood_node_vectors,
w->forward_edge_vectors,
fmat_base,
m->g, m->navigation->preorder, node_count, state_count, prec);
/* compute category likelihood */
arb_mul(cat_lhood, lhood, prior_prob, prec);
arb_add(site_lhood, site_lhood, cat_lhood, prec);
/* Accumulate cross-category expectations. */
for (edge = 0; edge < edge_count; edge++)
{
if (!edge_axis->request_update[edge]) continue;
idx = m->edge_map->order[edge];
/*
* Multiply by the product of the category rate,
* the edge rate, and the prior category probability.
* In the analogous 'dwell' function (as opposed to 'trans'),
* only the prior category probability is included.
*/
arb_mul(tmp, cat_rate, csw->edge_rates + idx, prec);
arb_mul(tmp, tmp, prior_prob, prec);
arb_addmul(w->cc_edge_expectations + idx,
w->edge_expectations + idx, tmp, prec);
}
}
/* Divide cross-category expectations by site lhood */
for (edge = 0; edge < edge_count; edge++)
{
if (!edge_axis->request_update[edge]) continue;
idx = m->edge_map->order[edge];
arb_div(w->cc_edge_expectations + idx,
w->cc_edge_expectations + idx,
site_lhood, prec);
}
/* Update the nd accumulator. */
for (edge = 0; edge < edge_count; edge++)
{
/* skip edges that are not requested */
if (!edge_axis->request_update[edge]) continue;
coords[EDGE_AXIS] = edge;
/*
* Accumulate.
* Note that the axes, accumulator, and json interface
* work with "user" edge indices,
* whereas the workspace arrays work with
* tree graph preorder edge indices.
*/
idx = m->edge_map->order[edge];
nd_accum_accumulate(arr,
coords, w->cc_edge_expectations + idx, prec);
}
arb_clear(site_lhood);
arb_clear(cat_lhood);
arb_clear(lhood);
arb_clear(tmp);
}
void acb_modular_transform(acb_t w, const psl2z_t g, const acb_t z, slong prec)
{
#define a (&g->a)
#define b (&g->b)
#define c (&g->c)
#define d (&g->d)
#define x acb_realref(z)
#define y acb_imagref(z)
if (fmpz_is_zero(c))
{
/* (az+b)/d, where we must have a = d = 1 */
acb_add_fmpz(w, z, b, prec);
}
else if (fmpz_is_zero(a))
{
/* b/(cz+d), where -bc = 1, c = 1 => -1/(z+d) */
acb_add_fmpz(w, z, d, prec);
acb_inv(w, w, prec);
acb_neg(w, w);
}
else if (0)
{
acb_t t, u;
acb_init(t);
acb_init(u);
acb_set_fmpz(t, b);
acb_addmul_fmpz(t, z, a, prec);
acb_set_fmpz(u, d);
acb_addmul_fmpz(u, z, c, prec);
acb_div(w, t, u, prec);
acb_clear(t);
acb_clear(u);
}
else
{
/* (az+b)/(cz+d) = (re+im*i)/den where
re = bd + (bc+ad)x + ac(x^2+y^2)
im = (ad-bc)y
den = c^2(x^2+y^2) + 2cdx + d^2
*/
fmpz_t t;
arb_t re, im, den;
arb_init(re);
arb_init(im);
arb_init(den);
fmpz_init(t);
arb_mul(im, x, x, prec);
arb_addmul(im, y, y, prec);
fmpz_mul(t, b, d);
arb_set_fmpz(re, t);
fmpz_mul(t, b, c);
fmpz_addmul(t, a, d);
arb_addmul_fmpz(re, x, t, prec);
fmpz_mul(t, a, c);
arb_addmul_fmpz(re, im, t, prec);
fmpz_mul(t, d, d);
arb_set_fmpz(den, t);
fmpz_mul(t, c, d);
fmpz_mul_2exp(t, t, 1);
arb_addmul_fmpz(den, x, t, prec);
fmpz_mul(t, c, c);
arb_addmul_fmpz(den, im, t, prec);
fmpz_mul(t, a, d);
fmpz_submul(t, b, c);
arb_mul_fmpz(im, y, t, prec);
arb_div(acb_realref(w), re, den, prec);
arb_div(acb_imagref(w), im, den, prec);
arb_clear(re);
arb_clear(im);
arb_clear(den);
fmpz_clear(t);
}
#undef a
#undef b
#undef c
#undef d
#undef x
#undef y
}
int main()
{
slong iter, iter2;
flint_rand_t state;
flint_printf("addmul....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 100000 * arb_test_multiplier(); iter++)
{
arb_t a, b, c;
fmpq_t x, y, z;
arb_init(a);
arb_init(b);
arb_init(c);
fmpq_init(x);
fmpq_init(y);
fmpq_init(z);
arb_randtest(a, state, 1 + n_randint(state, 200), 10);
arb_randtest(b, state, 1 + n_randint(state, 200), 10);
arb_randtest(c, state, 1 + n_randint(state, 200), 10);
arb_get_rand_fmpq(x, state, a, 1 + n_randint(state, 200));
arb_get_rand_fmpq(y, state, b, 1 + n_randint(state, 200));
arb_get_rand_fmpq(z, state, c, 1 + n_randint(state, 200));
arb_addmul(c, a, b, 2 + n_randint(state, 200));
fmpq_addmul(z, x, y);
if (!arb_contains_fmpq(c, z))
{
flint_printf("FAIL: containment\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("x = "); fmpq_print(x); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_printf("y = "); fmpq_print(y); flint_printf("\n\n");
flint_printf("c = "); arb_print(c); flint_printf("\n\n");
flint_printf("z = "); fmpq_print(z); flint_printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
fmpq_clear(x);
fmpq_clear(y);
fmpq_clear(z);
}
/* aliasing of c and a */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t a, b;
fmpq_t x, y, z;
arb_init(a);
arb_init(b);
fmpq_init(x);
fmpq_init(y);
fmpq_init(z);
arb_randtest(a, state, 1 + n_randint(state, 200), 10);
arb_randtest(b, state, 1 + n_randint(state, 200), 10);
arb_get_rand_fmpq(x, state, a, 1 + n_randint(state, 200));
arb_get_rand_fmpq(y, state, b, 1 + n_randint(state, 200));
fmpq_set(z, x);
arb_addmul(a, a, b, 2 + n_randint(state, 200));
fmpq_addmul(z, x, y);
if (!arb_contains_fmpq(a, z))
{
flint_printf("FAIL: aliasing (c, a)\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("x = "); fmpq_print(x); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_printf("y = "); fmpq_print(y); flint_printf("\n\n");
flint_printf("z = "); fmpq_print(z); flint_printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
fmpq_clear(x);
fmpq_clear(y);
fmpq_clear(z);
}
/* aliasing of c and b */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t a, b;
fmpq_t x, y, z;
arb_init(a);
arb_init(b);
fmpq_init(x);
fmpq_init(y);
fmpq_init(z);
arb_randtest(a, state, 1 + n_randint(state, 200), 10);
arb_randtest(b, state, 1 + n_randint(state, 200), 10);
arb_get_rand_fmpq(x, state, a, 1 + n_randint(state, 200));
arb_get_rand_fmpq(y, state, b, 1 + n_randint(state, 200));
fmpq_set(z, y);
arb_addmul(b, a, b, 2 + n_randint(state, 200));
fmpq_addmul(z, x, y);
if (!arb_contains_fmpq(b, z))
{
flint_printf("FAIL: aliasing (c, b)\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("x = "); fmpq_print(x); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_printf("y = "); fmpq_print(y); flint_printf("\n\n");
flint_printf("z = "); fmpq_print(z); flint_printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
fmpq_clear(x);
fmpq_clear(y);
fmpq_clear(z);
}
/* main test */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t x, y, z, v;
slong prec;
arb_init(x);
arb_init(y);
arb_init(z);
arb_init(v);
for (iter2 = 0; iter2 < 100; iter2++)
{
arb_randtest_special(x, state, n_randint(state,2) ? 2000 : 200, 200);
arb_randtest_special(y, state, n_randint(state,2) ? 2000 : 200, 200);
arb_randtest_special(z, state, n_randint(state,2) ? 2000 : 200, 200);
prec = 2 + n_randint(state, 2000);
switch (n_randint(state, 5))
{
case 0:
arb_set(v, z);
arb_addmul(z, x, y, prec);
arb_addmul_naive(v, x, y, prec);
if (!arf_equal(arb_midref(z), arb_midref(v))
|| !mag_close(arb_radref(z), arb_radref(v)))
{
flint_printf("FAIL!\n");
flint_printf("x = "); arb_print(x); flint_printf("\n\n");
flint_printf("y = "); arb_print(y); flint_printf("\n\n");
flint_printf("z = "); arb_print(z); flint_printf("\n\n");
flint_printf("v = "); arb_print(v); flint_printf("\n\n");
abort();
}
break;
case 1:
arb_set(y, x);
arb_set(z, v);
arb_addmul(z, x, y, prec);
arb_addmul(v, x, x, prec);
if (!arf_equal(arb_midref(z), arb_midref(v))
|| !mag_close(arb_radref(z), arb_radref(v)))
{
flint_printf("FAIL (aliasing 1)!\n");
flint_printf("x = "); arb_print(x); flint_printf("\n\n");
flint_printf("z = "); arb_print(z); flint_printf("\n\n");
flint_printf("v = "); arb_print(v); flint_printf("\n\n");
abort();
}
break;
case 2:
arb_set(v, x);
arb_addmul(v, x, x, prec);
arb_addmul(x, x, x, prec);
if (!arf_equal(arb_midref(x), arb_midref(v))
|| !mag_close(arb_radref(x), arb_radref(v)))
{
flint_printf("FAIL (aliasing 2)!\n");
flint_printf("x = "); arb_print(x); flint_printf("\n\n");
flint_printf("v = "); arb_print(v); flint_printf("\n\n");
abort();
}
break;
case 3:
arb_set(v, x);
arb_addmul(v, x, y, prec);
arb_addmul(x, x, y, prec);
if (!arf_equal(arb_midref(x), arb_midref(v))
|| !mag_close(arb_radref(x), arb_radref(v)))
{
flint_printf("FAIL (aliasing 3)!\n");
flint_printf("x = "); arb_print(x); flint_printf("\n\n");
flint_printf("y = "); arb_print(y); flint_printf("\n\n");
flint_printf("v = "); arb_print(v); flint_printf("\n\n");
abort();
}
break;
default:
arb_set(v, x);
arb_addmul(v, x, y, prec);
arb_addmul(x, y, x, prec);
if (!arf_equal(arb_midref(x), arb_midref(v))
|| !mag_close(arb_radref(x), arb_radref(v)))
{
flint_printf("FAIL (aliasing 4)!\n");
flint_printf("x = "); arb_print(x); flint_printf("\n\n");
flint_printf("y = "); arb_print(y); flint_printf("\n\n");
flint_printf("v = "); arb_print(v); flint_printf("\n\n");
abort();
}
break;
}
}
arb_clear(x);
arb_clear(y);
arb_clear(z);
arb_clear(v);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("addmul_fmpz....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000; iter++)
{
arb_t a, b, c, d;
fmpz_t x;
slong prec;
arb_init(a);
arb_init(b);
arb_init(c);
arb_init(d);
fmpz_init(x);
arb_randtest_special(a, state, 1 + n_randint(state, 2000), 100);
arb_randtest_special(b, state, 1 + n_randint(state, 2000), 100);
arb_randtest_special(c, state, 1 + n_randint(state, 2000), 100);
fmpz_randtest(x, state, 1 + n_randint(state, 2000));
prec = 2 + n_randint(state, 2000);
arb_set_fmpz(b, x);
arb_set(d, c);
arb_addmul_fmpz(c, a, x, prec);
arb_addmul(d, a, b, prec);
if (!arb_equal(c, d))
{
flint_printf("FAIL\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_printf("c = "); arb_print(c); flint_printf("\n\n");
flint_printf("d = "); arb_print(d); flint_printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
arb_clear(d);
fmpz_clear(x);
}
/* aliasing */
for (iter = 0; iter < 10000; iter++)
{
arb_t a, b, c;
fmpz_t x;
slong prec;
arb_init(a);
arb_init(b);
arb_init(c);
fmpz_init(x);
arb_randtest_special(a, state, 1 + n_randint(state, 2000), 100);
arb_randtest_special(b, state, 1 + n_randint(state, 2000), 100);
arb_randtest_special(c, state, 1 + n_randint(state, 2000), 100);
fmpz_randtest(x, state, 1 + n_randint(state, 2000));
prec = 2 + n_randint(state, 2000);
arb_set_fmpz(b, x);
arb_set(c, a);
arb_addmul_fmpz(c, a, x, prec);
arb_addmul_fmpz(a, a, x, prec);
if (!arb_equal(a, c))
{
flint_printf("FAIL (aliasing)\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_printf("c = "); arb_print(c); flint_printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
fmpz_clear(x);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
static void
bsplit_recursive_arb(arb_t P, arb_t Q, arb_t B, arb_t T,
const hypgeom_t hyp, long a, long b, int cont, long prec)
{
if (b - a < 4)
{
fmpz_t PP, QQ, BB, TT;
fmpz_init(PP);
fmpz_init(QQ);
fmpz_init(BB);
fmpz_init(TT);
bsplit_recursive_fmpz(PP, QQ, BB, TT, hyp, a, b, cont);
arb_set_fmpz(P, PP);
arb_set_fmpz(Q, QQ);
arb_set_fmpz(B, BB);
arb_set_fmpz(T, TT);
fmpz_clear(PP);
fmpz_clear(QQ);
fmpz_clear(BB);
fmpz_clear(TT);
}
else
{
long m;
arb_t P2, Q2, B2, T2;
m = (a + b) / 2;
arb_init(P2);
arb_init(Q2);
arb_init(B2);
arb_init(T2);
bsplit_recursive_arb(P, Q, B, T, hyp, a, m, 1, prec);
bsplit_recursive_arb(P2, Q2, B2, T2, hyp, m, b, 1, prec);
if (arb_is_one(B) && arb_is_one(B2))
{
arb_mul(T, T, Q2, prec);
arb_addmul(T, P, T2, prec);
}
else
{
arb_mul(T, T, B2, prec);
arb_mul(T, T, Q2, prec);
arb_mul(T2, T2, B, prec);
arb_addmul(T, P, T2, prec);
}
arb_mul(B, B, B2, prec);
arb_mul(Q, Q, Q2, prec);
if (cont)
arb_mul(P, P, P2, prec);
arb_clear(P2);
arb_clear(Q2);
arb_clear(B2);
arb_clear(T2);
}
}
void
_arb_poly_inv_series(arb_ptr Qinv,
arb_srcptr Q, slong Qlen, slong len, slong prec)
{
Qlen = FLINT_MIN(Qlen, len);
arb_inv(Qinv, Q, prec);
if (Qlen == 1)
{
_arb_vec_zero(Qinv + 1, len - 1);
}
else if (len == 2)
{
arb_mul(Qinv + 1, Qinv, Qinv, prec);
arb_mul(Qinv + 1, Qinv + 1, Q + 1, prec);
arb_neg(Qinv + 1, Qinv + 1);
}
else
{
slong i, j, blen;
/* The basecase algorithm is faster for much larger Qlen or len than
this, but unfortunately also much less numerically stable. */
if (Qlen == 2 || len <= 8)
blen = len;
else
blen = FLINT_MIN(len, 4);
for (i = 1; i < blen; i++)
{
arb_mul(Qinv + i, Q + 1, Qinv + i - 1, prec);
for (j = 2; j < FLINT_MIN(i + 1, Qlen); j++)
arb_addmul(Qinv + i, Q + j, Qinv + i - j, prec);
if (!arb_is_one(Qinv))
arb_mul(Qinv + i, Qinv + i, Qinv, prec);
arb_neg(Qinv + i, Qinv + i);
}
if (len > blen)
{
slong Qnlen, Wlen, W2len;
arb_ptr W;
W = _arb_vec_init(len);
NEWTON_INIT(blen, len)
NEWTON_LOOP(m, n)
Qnlen = FLINT_MIN(Qlen, n);
Wlen = FLINT_MIN(Qnlen + m - 1, n);
W2len = Wlen - m;
MULLOW(W, Q, Qnlen, Qinv, m, Wlen, prec);
MULLOW(Qinv + m, Qinv, m, W + m, W2len, n - m, prec);
_arb_vec_neg(Qinv + m, Qinv + m, n - m);
NEWTON_END_LOOP
NEWTON_END
_arb_vec_clear(W, len);
}
}
}
void
arb_rising2_ui_rs(arb_t u, arb_t v,
const arb_t x, ulong n, ulong m, slong prec)
{
if (n == 0)
{
arb_zero(v);
arb_one(u);
}
else if (n == 1)
{
arb_set(u, x);
arb_one(v);
}
else
{
slong wp;
ulong i, j, a, b;
arb_ptr xs;
arb_t S, T, U, V;
fmpz *A, *B;
wp = ARF_PREC_ADD(prec, FLINT_BIT_COUNT(n));
if (m == 0)
{
ulong m1, m2;
m1 = 0.6 * pow(wp, 0.4);
m2 = n_sqrt(n);
m = FLINT_MIN(m1, m2);
}
m = FLINT_MAX(m, 1);
xs = _arb_vec_init(m + 1);
A = _fmpz_vec_init(2 * m + 1);
B = A + (m + 1);
arb_init(S);
arb_init(T);
arb_init(U);
arb_init(V);
_arb_vec_set_powers(xs, x, m + 1, wp);
for (i = 0; i < n; i += m)
{
a = i;
b = FLINT_MIN(n, a + m);
if (a == 0 || b != a + m)
{
_gamma_rf_bsplit(A, a, b);
}
else
{
fmpz tt = m;
_fmpz_poly_taylor_shift(A, &tt, m + 1);
}
_fmpz_poly_derivative(B, A, b - a + 1);
arb_set_fmpz(S, A);
for (j = 1; j <= b - a; j++)
arb_addmul_fmpz(S, xs + j, A + j, wp);
arb_set_fmpz(T, B);
for (j = 1; j < b - a; j++)
arb_addmul_fmpz(T, xs + j, B + j, wp);
if (i == 0)
{
arb_set(U, S);
arb_set(V, T);
}
else
{
arb_mul(V, V, S, wp);
arb_addmul(V, U, T, wp);
arb_mul(U, U, S, wp);
}
}
arb_set(u, U);
arb_set(v, V);
_arb_vec_clear(xs, m + 1);
_fmpz_vec_clear(A, 2 * m + 1);
arb_clear(S);
arb_clear(T);
arb_clear(U);
arb_clear(V);
}
}