void
acb_log1p(acb_t r, const acb_t z, slong prec)
{
slong magz, magx, magy;
if (acb_is_zero(z))
{
acb_zero(r);
return;
}
magx = arf_abs_bound_lt_2exp_si(arb_midref(acb_realref(z)));
magy = arf_abs_bound_lt_2exp_si(arb_midref(acb_imagref(z)));
magz = FLINT_MAX(magx, magy);
if (magz < -prec)
{
acb_log1p_tiny(r, z, prec);
}
else
{
if (magz < 0)
acb_add_ui(r, z, 1, prec + (-magz) + 4);
else
acb_add_ui(r, z, 1, prec + 4);
acb_log(r, r, prec);
}
}
slong
_acb_get_mid_mag(const acb_t z)
{
slong rm, im;
rm = arf_abs_bound_lt_2exp_si(arb_midref(acb_realref(z)));
im = arf_abs_bound_lt_2exp_si(arb_midref(acb_imagref(z)));
return FLINT_MAX(rm, im);
}
void
arb_sqrt1pm1(arb_t r, const arb_t z, slong prec)
{
slong magz, wp;
if (arb_is_zero(z))
{
arb_zero(r);
return;
}
magz = arf_abs_bound_lt_2exp_si(arb_midref(z));
if (magz < -prec)
{
arb_sqrt1pm1_tiny(r, z, prec);
}
else
{
if (magz < 0)
wp = prec + (-magz) + 4;
else
wp = prec + 4;
arb_add_ui(r, z, 1, wp);
arb_sqrt(r, r, wp);
arb_sub_ui(r, r, 1, wp);
}
}
void
arb_log1p(arb_t r, const arb_t z, slong prec)
{
slong magz;
if (arb_is_zero(z))
{
arb_zero(r);
return;
}
magz = arf_abs_bound_lt_2exp_si(arb_midref(z));
if (magz < -prec)
{
arb_log1p_tiny(r, z, prec);
}
else
{
if (magz < 0)
arb_add_ui(r, z, 1, prec + (-magz) + 4);
else
arb_add_ui(r, z, 1, prec + 4);
arb_log(r, r, prec);
}
}
slong
_acb_get_rad_mag(const acb_t z)
{
slong rm, im;
/* TODO: write mag function */
arf_t t;
arf_init(t);
arf_set_mag(t, arb_radref(acb_realref(z)));
rm = arf_abs_bound_lt_2exp_si(t);
arf_set_mag(t, arb_radref(acb_imagref(z)));
im = arf_abs_bound_lt_2exp_si(t);
arf_clear(t);
return FLINT_MAX(rm, im);
}
int arb_calc_refine_root_newton(arb_t r, arb_calc_func_t func,
void * param, const arb_t start, const arb_t conv_region,
const arf_t conv_factor, slong eval_extra_prec, slong prec)
{
slong precs[FLINT_BITS];
slong i, iters, wp, padding, start_prec;
int result;
start_prec = arb_rel_accuracy_bits(start);
if (arb_calc_verbose)
flint_printf("newton initial accuracy: %wd\n", start_prec);
padding = arf_abs_bound_lt_2exp_si(conv_factor);
padding = FLINT_MIN(padding, prec) + 5;
padding = FLINT_MAX(0, padding);
precs[0] = prec + padding;
iters = 1;
while ((iters < FLINT_BITS) && (precs[iters-1] + padding > 2*start_prec))
{
precs[iters] = (precs[iters-1] / 2) + padding;
iters++;
if (iters == FLINT_BITS)
{
return ARB_CALC_IMPRECISE_INPUT;
}
}
arb_set(r, start);
for (i = iters - 1; i >= 0; i--)
{
wp = precs[i] + eval_extra_prec;
if (arb_calc_verbose)
flint_printf("newton step: wp = %wd + %wd = %wd\n",
precs[i], eval_extra_prec, wp);
if ((result = arb_calc_newton_step(r, func, param,
r, conv_region, conv_factor, wp)) != ARB_CALC_SUCCESS)
{
return result;
}
}
return ARB_CALC_SUCCESS;
}
void
acb_dirichlet_zeta_rs_mid(acb_t res, const acb_t s, slong K, slong prec)
{
acb_t R1, R2, X, t;
slong wp;
if (arf_sgn(arb_midref(acb_imagref(s))) < 0)
{
acb_init(t);
acb_conj(t, s);
acb_dirichlet_zeta_rs(res, t, K, prec);
acb_conj(res, res);
acb_clear(t);
return;
}
acb_init(R1);
acb_init(R2);
acb_init(X);
acb_init(t);
/* rs_r increases the precision internally */
wp = prec;
acb_dirichlet_zeta_rs_r(R1, s, K, wp);
if (arb_is_exact(acb_realref(s)) &&
(arf_cmp_2exp_si(arb_midref(acb_realref(s)), -1) == 0))
{
acb_conj(R2, R1);
}
else
{
/* conj(R(conj(1-s))) */
arb_sub_ui(acb_realref(t), acb_realref(s), 1, 10 * wp);
arb_neg(acb_realref(t), acb_realref(t));
arb_set(acb_imagref(t), acb_imagref(s));
acb_dirichlet_zeta_rs_r(R2, t, K, wp);
acb_conj(R2, R2);
}
if (acb_is_finite(R1) && acb_is_finite(R2))
{
wp += 10 + arf_abs_bound_lt_2exp_si(arb_midref(acb_imagref(s)));
wp = FLINT_MAX(wp, 10);
/* X = pi^(s-1/2) gamma((1-s)/2) rgamma(s/2)
= (2 pi)^s rgamma(s) / (2 cos(pi s / 2)) */
acb_rgamma(X, s, wp);
acb_const_pi(t, wp);
acb_mul_2exp_si(t, t, 1);
acb_pow(t, t, s, wp);
acb_mul(X, X, t, wp);
acb_mul_2exp_si(t, s, -1);
acb_cos_pi(t, t, wp);
acb_mul_2exp_si(t, t, 1);
acb_div(X, X, t, wp);
acb_mul(R2, R2, X, wp);
}
/* R1 + X * R2 */
acb_add(res, R1, R2, prec);
acb_clear(R1);
acb_clear(R2);
acb_clear(X);
acb_clear(t);
}
void
_arb_sin_cos_generic(arb_t s, arb_t c, const arf_t x, const mag_t xrad, slong prec)
{
int want_sin, want_cos;
slong maglim;
want_sin = (s != NULL);
want_cos = (c != NULL);
if (arf_is_zero(x) && mag_is_zero(xrad))
{
if (want_sin) arb_zero(s);
if (want_cos) arb_one(c);
return;
}
if (!arf_is_finite(x) || !mag_is_finite(xrad))
{
if (arf_is_nan(x))
{
if (want_sin) arb_indeterminate(s);
if (want_cos) arb_indeterminate(c);
}
else
{
if (want_sin) arb_zero_pm_one(s);
if (want_cos) arb_zero_pm_one(c);
}
return;
}
maglim = FLINT_MAX(65536, 4 * prec);
if (mag_cmp_2exp_si(xrad, -16) > 0 || arf_cmpabs_2exp_si(x, maglim) > 0)
{
_arb_sin_cos_wide(s, c, x, xrad, prec);
return;
}
if (arf_cmpabs_2exp_si(x, -(prec/2) - 2) <= 0)
{
mag_t t, u, v;
mag_init(t);
mag_init(u);
mag_init(v);
arf_get_mag(t, x);
mag_add(t, t, xrad);
mag_mul(u, t, t);
/* |sin(z)-z| <= z^3/6 */
if (want_sin)
{
arf_set(arb_midref(s), x);
mag_set(arb_radref(s), xrad);
arb_set_round(s, s, prec);
mag_mul(v, u, t);
mag_div_ui(v, v, 6);
arb_add_error_mag(s, v);
}
/* |cos(z)-1| <= z^2/2 */
if (want_cos)
{
arf_one(arb_midref(c));
mag_mul_2exp_si(arb_radref(c), u, -1);
}
mag_clear(t);
mag_clear(u);
mag_clear(v);
return;
}
if (mag_is_zero(xrad))
{
arb_sin_cos_arf_generic(s, c, x, prec);
}
else
{
mag_t t;
slong exp, radexp;
mag_init_set(t, xrad);
exp = arf_abs_bound_lt_2exp_si(x);
radexp = MAG_EXP(xrad);
if (radexp < MAG_MIN_LAGOM_EXP || radexp > MAG_MAX_LAGOM_EXP)
radexp = MAG_MIN_LAGOM_EXP;
if (want_cos && exp < -2)
prec = FLINT_MIN(prec, 20 - FLINT_MAX(exp, radexp) - radexp);
else
prec = FLINT_MIN(prec, 20 - radexp);
arb_sin_cos_arf_generic(s, c, x, prec);
/* todo: could use quadratic bound */
if (want_sin) mag_add(arb_radref(s), arb_radref(s), t);
if (want_cos) mag_add(arb_radref(c), arb_radref(c), t);
mag_clear(t);
}
}
int arb_mat_jacobi(arb_mat_t D, arb_mat_t P, const arb_mat_t A, slong prec) {
//
// Given a d x d real symmetric matrix A, compute an orthogonal matrix
// P and a diagonal D such that A = P D P^t = P D P^(-1).
//
// D should have already been initialized as a d x 1 matrix, and Pp
// should have already been initialized as a d x d matrix.
//
// If the eigenvalues can be certified as unique, then a nonzero int is
// returned, and the eigenvectors should have reasonable error bounds. If
// the eigenvalues cannot be certified as unique, then some of the
// eigenvectors will have infinite error radius.
#define B(i,j) arb_mat_entry(B, i, j)
#define D(i) arb_mat_entry(D, i, 0)
#define P(i,j) arb_mat_entry(P, i, j)
int dim = arb_mat_nrows(A);
if(dim == 1) {
arb_mat_set(D, A);
arb_mat_one(P);
return 0;
}
arb_mat_t B;
arb_mat_init(B, dim, dim);
arf_t * B1 = (arf_t*)malloc(dim * sizeof(arf_t));
arf_t * B2 = (arf_t*)malloc(dim * sizeof(arf_t));
arf_t * row_max = (arf_t*)malloc((dim - 1) * sizeof(arf_t));
int * row_max_indices = (int*)malloc((dim - 1) * sizeof(int));
for(int k = 0; k < dim; k++) {
arf_init(B1[k]);
arf_init(B2[k]);
}
for(int k = 0; k < dim - 1; k++) {
arf_init(row_max[k]);
}
arf_t x1, x2;
arf_init(x1);
arf_init(x2);
arf_t Gii, Gij, Gji, Gjj;
arf_init(Gii);
arf_init(Gij);
arf_init(Gji);
arf_init(Gjj);
arb_mat_set(B, A);
arb_mat_one(P);
for(int i = 0; i < dim - 1; i++) {
for(int j = i + 1; j < dim; j++) {
arf_abs(x1, arb_midref(B(i,j)));
if(arf_cmp(row_max[i], x1) < 0) {
arf_set(row_max[i], x1);
row_max_indices[i] = j;
}
}
}
int finished = 0;
while(!finished) {
arf_zero(x1);
int i = 0;
int j = 0;
for(int k = 0; k < dim - 1; k++) {
if(arf_cmp(x1, row_max[k]) < 0) {
arf_set(x1, row_max[k]);
i = k;
}
}
j = row_max_indices[i];
slong bound = arf_abs_bound_lt_2exp_si(x1);
if(bound < -prec * .9) {
finished = 1;
break;
}
else {
//printf("%ld\n", arf_abs_bound_lt_2exp_si(x1));
//arb_mat_printd(B, 10);
//printf("\n");
}
arf_twobytwo_diag(Gii, Gij, arb_midref(B(i,i)), arb_midref(B(i,j)), arb_midref(B(j,j)), 2*prec);
arf_neg(Gji, Gij);
arf_set(Gjj, Gii);
//printf("%d %d\n", i, j);
//arf_printd(Gii, 100);
//printf(" ");
//arf_printd(Gij, 100);
//printf("\n");
if(arf_is_zero(Gij)) { // If this happens, we're
finished = 1; // not going to do any better
break; // without increasing the precision.
}
for(int k = 0; k < dim; k++) {
arf_mul(B1[k], Gii, arb_midref(B(i,k)), prec, ARF_RND_NEAR);
arf_addmul(B1[k], Gji, arb_midref(B(j,k)), prec, ARF_RND_NEAR);
arf_mul(B2[k], Gij, arb_midref(B(i,k)), prec, ARF_RND_NEAR);
arf_addmul(B2[k], Gjj, arb_midref(B(j,k)), prec, ARF_RND_NEAR);
}
for(int k = 0; k < dim; k++) {
arf_set(arb_midref(B(i,k)), B1[k]);
arf_set(arb_midref(B(j,k)), B2[k]);
}
for(int k = 0; k < dim; k++) {
arf_mul(B1[k], Gii, arb_midref(B(k,i)), prec, ARF_RND_NEAR);
arf_addmul(B1[k], Gji, arb_midref(B(k,j)), prec, ARF_RND_NEAR);
arf_mul(B2[k], Gij, arb_midref(B(k,i)), prec, ARF_RND_NEAR);
arf_addmul(B2[k], Gjj, arb_midref(B(k,j)), prec, ARF_RND_NEAR);
}
for(int k = 0; k < dim; k++) {
arf_set(arb_midref(B(k,i)), B1[k]);
arf_set(arb_midref(B(k,j)), B2[k]);
}
for(int k = 0; k < dim; k++) {
arf_mul(B1[k], Gii, arb_midref(P(k,i)), prec, ARF_RND_NEAR);
arf_addmul(B1[k], Gji, arb_midref(P(k,j)), prec, ARF_RND_NEAR);
arf_mul(B2[k], Gij, arb_midref(P(k,i)), prec, ARF_RND_NEAR);
arf_addmul(B2[k], Gjj, arb_midref(P(k,j)), prec, ARF_RND_NEAR);
}
for(int k = 0; k < dim; k++) {
arf_set(arb_midref(P(k,i)), B1[k]);
arf_set(arb_midref(P(k,j)), B2[k]);
}
if(i < dim - 1)
arf_set_ui(row_max[i], 0);
if(j < dim - 1)
arf_set_ui(row_max[j], 0);
// Update the max in any row where the maximum
// was in a column that changed.
for(int k = 0; k < dim - 1; k++) {
if(row_max_indices[k] == j || row_max_indices[k] == i) {
arf_abs(row_max[k], arb_midref(B(k,k+1)));
row_max_indices[k] = k+1;
for(int l = k+2; l < dim; l++) {
arf_abs(x1, arb_midref(B(k,l)));
if(arf_cmp(row_max[k], x1) < 0) {
arf_set(row_max[k], x1);
row_max_indices[k] = l;
}
}
}
}
// Update the max in the ith row.
for(int k = i + 1; k < dim; k++) {
arf_abs(x1, arb_midref(B(i, k)));
if(arf_cmp(row_max[i], x1) < 0) {
arf_set(row_max[i], x1);
row_max_indices[i] = k;
}
}
// Update the max in the jth row.
for(int k = j + 1; k < dim; k++) {
arf_abs(x1, arb_midref(B(j, k)));
if(arf_cmp(row_max[j], x1) < 0) {
arf_set(row_max[j], x1);
row_max_indices[j] = k;
}
}
// Go through column i to see if any of
// the new entries are larger than the
// max of their row.
for(int k = 0; k < i; k++) {
if(k == dim) continue;
arf_abs(x1, arb_midref(B(k, i)));
if(arf_cmp(row_max[k], x1) < 0) {
arf_set(row_max[k], x1);
row_max_indices[k] = i;
}
}
// And then column j.
for(int k = 0; k < j; k++) {
if(k == dim) continue;
arf_abs(x1, arb_midref(B(k, j)));
if(arf_cmp(row_max[k], x1) < 0) {
arf_set(row_max[k], x1);
row_max_indices[k] = j;
}
}
}
for(int k = 0; k < dim; k++) {
arb_set(D(k), B(k,k));
arb_set_exact(D(k));
}
// At this point we've done that diagonalization and all that remains is
// to certify the correctness and compute error bounds.
arb_mat_t e;
arb_t error_norms[dim];
for(int k = 0; k < dim; k++) arb_init(error_norms[k]);
arb_mat_init(e, dim, 1);
arb_t z1, z2;
arb_init(z1);
arb_init(z2);
for(int j = 0; j < dim; j++) {
arb_mat_set(B, A);
for(int k = 0; k < dim; k++) {
arb_sub(B(k, k), B(k, k), D(j), prec);
}
for(int k = 0; k < dim; k++) {
arb_set(arb_mat_entry(e, k, 0), P(k, j));
}
arb_mat_L2norm(z2, e, prec);
arb_mat_mul(e, B, e, prec);
arb_mat_L2norm(error_norms[j], e, prec);
arb_div(z2, error_norms[j], z2, prec); // and now z1 is an upper bound for the
// error in the eigenvalue
arb_add_error(D(j), z2);
}
int unique_eigenvalues = 1;
for(int j = 0; j < dim; j++) {
if(j == 0) {
arb_sub(z1, D(j), D(1), prec);
}
else {
arb_sub(z1, D(j), D(0), prec);
}
arb_get_abs_lbound_arf(x1, z1, prec);
for(int k = 1; k < dim; k++) {
if(k == j) continue;
arb_sub(z1, D(j), D(k), prec);
arb_get_abs_lbound_arf(x2, z1, prec);
if(arf_cmp(x2, x1) < 0) {
arf_set(x1, x2);
}
}
if(arf_is_zero(x1)) {
unique_eigenvalues = 0;
}
arb_div_arf(z1, error_norms[j], x1, prec);
for(int k = 0; k < dim; k++) {
arb_add_error(P(k, j), z1);
}
}
arb_mat_clear(e);
arb_clear(z1);
arb_clear(z2);
for(int k = 0; k < dim; k++) arb_clear(error_norms[k]);
arf_clear(x1);
arf_clear(x2);
arb_mat_clear(B);
for(int k = 0; k < dim; k++) {
arf_clear(B1[k]);
arf_clear(B2[k]);
}
for(int k = 0; k < dim - 1; k++) {
arf_clear(row_max[k]);
}
arf_clear(Gii);
arf_clear(Gij);
arf_clear(Gji);
arf_clear(Gjj);
free(B1);
free(B2);
free(row_max);
free(row_max_indices);
if(unique_eigenvalues) return 0;
else return 1;
#undef B
#undef D
#undef P
}
static __inline__ slong _arf_mag(const arf_t c)
{
slong m = arf_abs_bound_lt_2exp_si(c);
return FLINT_MAX(m, 0);
}
void
arb_exp_arf_bb(arb_t z, const arf_t x, slong prec, int minus_one)
{
slong k, iter, bits, r, mag, q, wp, N;
slong argred_bits, start_bits;
mp_bitcnt_t Qexp[1];
int inexact;
fmpz_t t, u, T, Q;
arb_t w;
if (arf_is_zero(x))
{
if (minus_one)
arb_zero(z);
else
arb_one(z);
return;
}
if (arf_is_special(x))
{
abort();
}
mag = arf_abs_bound_lt_2exp_si(x);
/* We assume that this function only gets called with something
reasonable as input (huge/tiny input will be handled by
the main exp wrapper). */
if (mag > 200 || mag < -2 * prec - 100)
{
flint_printf("arb_exp_arf_bb: unexpectedly large/small input\n");
abort();
}
if (prec < 100000000)
{
argred_bits = 16;
start_bits = 32;
}
else
{
argred_bits = 32;
start_bits = 64;
}
/* Argument reduction: exp(x) -> exp(x/2^q). This improves efficiency
of the first iteration in the bit-burst algorithm. */
q = FLINT_MAX(0, mag + argred_bits);
/* Determine working precision. */
wp = prec + 10 + 2 * q + 2 * FLINT_BIT_COUNT(prec);
if (minus_one && mag < 0)
wp += (-mag);
fmpz_init(t);
fmpz_init(u);
fmpz_init(Q);
fmpz_init(T);
arb_init(w);
/* Convert x/2^q to a fixed-point number. */
inexact = arf_get_fmpz_fixed_si(t, x, -wp + q);
/* Aliasing of z and x is safe now that only use t. */
/* Start with z = 1. */
arb_one(z);
/* Bit-burst loop. */
for (iter = 0, bits = start_bits; !fmpz_is_zero(t);
iter++, bits *= 2)
{
/* Extract bits. */
r = FLINT_MIN(bits, wp);
fmpz_tdiv_q_2exp(u, t, wp - r);
/* Binary splitting (+1 fixed-point ulp truncation error). */
mag = fmpz_bits(u) - r;
N = bs_num_terms(mag, wp);
_arb_exp_sum_bs_powtab(T, Q, Qexp, u, r, N);
/* T = T / Q (+1 fixed-point ulp error). */
if (*Qexp >= wp)
{
fmpz_tdiv_q_2exp(T, T, *Qexp - wp);
fmpz_tdiv_q(T, T, Q);
}
else
{
fmpz_mul_2exp(T, T, wp - *Qexp);
fmpz_tdiv_q(T, T, Q);
}
/* T = 1 + T */
fmpz_one(Q);
fmpz_mul_2exp(Q, Q, wp);
fmpz_add(T, T, Q);
/* Now T = exp(u) with at most 2 fixed-point ulp error. */
/* Set z = z * T. */
arf_set_fmpz(arb_midref(w), T);
arf_mul_2exp_si(arb_midref(w), arb_midref(w), -wp);
mag_set_ui_2exp_si(arb_radref(w), 2, -wp);
arb_mul(z, z, w, wp);
/* Remove used bits. */
fmpz_mul_2exp(u, u, wp - r);
fmpz_sub(t, t, u);
}
/* We have exp(x + eps) - exp(x) < 2*eps (by assumption that the argument
reduction is large enough). */
if (inexact)
arb_add_error_2exp_si(z, -wp + 1);
fmpz_clear(t);
fmpz_clear(u);
fmpz_clear(Q);
fmpz_clear(T);
arb_clear(w);
/* exp(x) = exp(x/2^q)^(2^q) */
for (k = 0; k < q; k++)
arb_mul(z, z, z, wp);
if (minus_one)
arb_sub_ui(z, z, 1, wp);
arb_set_round(z, z, prec);
}
