int
arf_sub_special(arf_t z, const arf_t x, const arf_t y, slong prec, arf_rnd_t rnd)
{
if (arf_is_zero(x))
{
if (arf_is_zero(y))
{
arf_zero(z);
return 0;
}
else
return arf_neg_round(z, y, prec, rnd);
}
else if (arf_is_zero(y))
{
return arf_set_round(z, x, prec, rnd);
}
else if (arf_is_nan(x) || arf_is_nan(y)
|| (arf_is_pos_inf(x) && arf_is_pos_inf(y))
|| (arf_is_neg_inf(x) && arf_is_neg_inf(y)))
{
arf_nan(z);
return 0;
}
else if (arf_is_special(x))
{
arf_set(z, x);
return 0;
}
else
{
arf_neg(z, y);
return 0;
}
}
void
arf_fprint(FILE * file, const arf_t x)
{
if (arf_is_normal(x))
{
fmpz_t man, exp;
fmpz_init(man);
fmpz_init(exp);
arf_get_fmpz_2exp(man, exp, x);
flint_fprintf(file, "(");
fmpz_fprint(file, man);
flint_fprintf(file, " * 2^");
fmpz_fprint(file, exp);
flint_fprintf(file, ")");
fmpz_clear(man);
fmpz_clear(exp);
}
else
{
if (arf_is_zero(x)) flint_fprintf(file, "(0)");
else if (arf_is_pos_inf(x)) flint_fprintf(file, "(+inf)");
else if (arf_is_neg_inf(x)) flint_fprintf(file, "(-inf)");
else flint_fprintf(file, "(nan)");
}
}
int
arf_cmpabs(const arf_t x, const arf_t y)
{
int ec, mc;
mp_size_t xn, yn;
mp_srcptr xp, yp;
if (arf_is_special(x) || arf_is_special(y))
{
if (arf_equal(x, y))
return 0;
if (arf_is_nan(x) || arf_is_nan(y))
return 0;
if (arf_is_zero(x)) return -1;
if (arf_is_zero(y)) return 1;
if (arf_is_inf(x)) return arf_is_inf(y) ? 0 : 1;
if (arf_is_inf(y)) return -1;
return -1;
}
ec = fmpz_cmp(ARF_EXPREF(x), ARF_EXPREF(y));
if (ec != 0)
return (ec < 0) ? -1 : 1;
ARF_GET_MPN_READONLY(xp, xn, x);
ARF_GET_MPN_READONLY(yp, yn, y);
if (xn >= yn)
mc = mpn_cmp(xp + xn - yn, yp, yn);
else
mc = mpn_cmp(xp, yp + yn - xn, xn);
if (mc != 0)
return (mc < 0) ? -1 : 1;
if (xn != yn)
return (xn < yn) ? -1 : 1;
return 0;
}
void
arb_sinc(arb_t z, const arb_t x, slong prec)
{
mag_t c, r;
mag_init(c);
mag_init(r);
mag_set_ui_2exp_si(c, 5, -1);
arb_get_mag_lower(r, x);
if (mag_cmp(c, r) < 0)
{
/* x is not near the origin */
_arb_sinc_direct(z, x, prec);
}
else if (mag_cmp_2exp_si(arb_radref(x), 1) < 0)
{
/* determine error magnitude using the derivative bound */
if (arb_is_exact(x))
{
mag_zero(c);
}
else
{
_arb_sinc_derivative_bound(r, x);
mag_mul(c, arb_radref(x), r);
}
/* evaluate sinc at the midpoint of x */
if (arf_is_zero(arb_midref(x)))
{
arb_one(z);
}
else
{
arb_get_mid_arb(z, x);
_arb_sinc_direct(z, z, prec);
}
/* add the error */
mag_add(arb_radref(z), arb_radref(z), c);
}
else
{
/* x has a large radius and includes points near the origin */
arf_zero(arb_midref(z));
mag_one(arb_radref(z));
}
mag_clear(c);
mag_clear(r);
}
int
arf_sub_si(arf_ptr z, arf_srcptr x, slong y, slong prec, arf_rnd_t rnd)
{
mp_size_t xn, yn;
mp_srcptr xptr, yptr;
mp_limb_t ytmp;
int xsgnbit, ysgnbit;
fmpz yexp;
slong shift;
if (y == 0)
{
return arf_set_round(z, x, prec, rnd);
}
else if (arf_is_special(x))
{
if (arf_is_zero(x))
{
arf_set_si(z, y);
return arf_neg_round(z, z, prec, rnd);
}
else
{
arf_set(z, x);
return 0;
}
}
ysgnbit = (y < 0);
if (ysgnbit)
ytmp = -y;
else
ytmp = y;
yptr = &ytmp;
yn = 1;
yexp = FLINT_BITS;
ysgnbit ^= 1;
shift = _fmpz_sub_small(ARF_EXPREF(x), &yexp);
xsgnbit = ARF_SGNBIT(x);
ARF_GET_MPN_READONLY(xptr, xn, x);
if (shift >= 0)
return _arf_add_mpn(z, xptr, xn, xsgnbit, ARF_EXPREF(x),
yptr, yn, ysgnbit, shift, prec, rnd);
else
return _arf_add_mpn(z, yptr, yn, ysgnbit, &yexp,
xptr, xn, xsgnbit, -shift, prec, rnd);
}
int
arf_add_fmpz_2exp(arf_ptr z, arf_srcptr x, const fmpz_t y, const fmpz_t exp, slong prec, arf_rnd_t rnd)
{
mp_size_t xn, yn;
mp_srcptr xptr, yptr;
mp_limb_t ytmp;
int xsgnbit, ysgnbit, inexact;
fmpz_t yexp;
slong shift;
if (fmpz_is_zero(y))
{
return arf_set_round(z, x, prec, rnd);
}
else if (arf_is_special(x))
{
if (arf_is_zero(x))
{
inexact = arf_set_round_fmpz(z, y, prec, rnd);
arf_mul_2exp_fmpz(z, z, exp);
return inexact;
}
else
{
arf_set(z, x);
return 0;
}
}
FMPZ_GET_MPN_READONLY(ysgnbit, yn, yptr, ytmp, *y)
fmpz_init(yexp);
fmpz_add_ui(yexp, exp, yn * FLINT_BITS);
shift = _fmpz_sub_small(ARF_EXPREF(x), yexp);
xsgnbit = ARF_SGNBIT(x);
ARF_GET_MPN_READONLY(xptr, xn, x);
if (shift >= 0)
inexact = _arf_add_mpn(z, xptr, xn, xsgnbit, ARF_EXPREF(x),
yptr, yn, ysgnbit, shift, prec, rnd);
else
inexact = _arf_add_mpn(z, yptr, yn, ysgnbit, yexp,
xptr, xn, xsgnbit, -shift, prec, rnd);
fmpz_clear(yexp);
return inexact;
}
void
arf_get_fmpr(fmpr_t y, const arf_t x)
{
if (arf_is_special(x))
{
if (arf_is_zero(x))
fmpr_zero(y);
else if (arf_is_pos_inf(x))
fmpr_pos_inf(y);
else if (arf_is_neg_inf(x))
fmpr_neg_inf(y);
else
fmpr_nan(y);
}
else
{
arf_get_fmpz_2exp(fmpr_manref(y), fmpr_expref(y), x);
}
}
void
arb_div_arf(arb_t z, const arb_t x, const arf_t y, long prec)
{
mag_t zr, ym;
int inexact;
if (arf_is_zero(y))
{
arb_zero_pm_inf(z);
}
else if (arb_is_exact(x))
{
inexact = arf_div(arb_midref(z), arb_midref(x), y, prec, ARB_RND);
if (inexact)
arf_mag_set_ulp(arb_radref(z), arb_midref(z), prec);
else
mag_zero(arb_radref(z));
}
else if (mag_is_inf(arb_radref(x)))
{
arf_div(arb_midref(z), arb_midref(x), y, prec, ARB_RND);
mag_inf(arb_radref(z));
}
else
{
mag_init(ym);
mag_init(zr);
arf_get_mag_lower(ym, y);
mag_div(zr, arb_radref(x), ym);
inexact = arf_div(arb_midref(z), arb_midref(x), y, prec, ARB_RND);
if (inexact)
arf_mag_add_ulp(arb_radref(z), zr, arb_midref(z), prec);
else
mag_swap(arb_radref(z), zr);
mag_clear(ym);
mag_clear(zr);
}
}
int
arf_sub_fmpz(arf_ptr z, arf_srcptr x, const fmpz_t y, slong prec, arf_rnd_t rnd)
{
mp_size_t xn, yn;
mp_srcptr xptr, yptr;
mp_limb_t ytmp;
int xsgnbit, ysgnbit;
fmpz yexp;
slong shift;
if (fmpz_is_zero(y))
{
return arf_set_round(z, x, prec, rnd);
}
else if (arf_is_special(x))
{
if (arf_is_zero(x))
{
arf_set_fmpz(z, y);
return arf_neg_round(z, z, prec, rnd);
}
else
{
arf_set(z, x);
return 0;
}
}
FMPZ_GET_MPN_READONLY(ysgnbit, yn, yptr, ytmp, *y)
yexp = yn * FLINT_BITS;
shift = _fmpz_sub_small(ARF_EXPREF(x), &yexp);
ysgnbit ^= 1;
xsgnbit = ARF_SGNBIT(x);
ARF_GET_MPN_READONLY(xptr, xn, x);
if (shift >= 0)
return _arf_add_mpn(z, xptr, xn, xsgnbit, ARF_EXPREF(x),
yptr, yn, ysgnbit, shift, prec, rnd);
else
return _arf_add_mpn(z, yptr, yn, ysgnbit, &yexp,
xptr, xn, xsgnbit, -shift, prec, rnd);
}
void arf_twobytwo_diag(arf_t u1, arf_t u2, const arf_t a, const arf_t b, const arf_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(arf_is_zero(b)) {
arf_set_ui(u1, 1);
arf_set_ui(u2, 0);
return;
}
arf_t x; arf_init(x);
arf_mul(u1, b, b, prec, ARF_RND_NEAR); // u1 = b^2
arf_sub(u2, a, d, prec, ARF_RND_NEAR); // u2 = a - d
arf_mul_2exp_si(u2, u2, -1); // u2 = (a - d)/2
arf_mul(u2, u2, u2, prec, ARF_RND_NEAR); // u2 = ( (a - d)/2 )^2
arf_add(u1, u1, u2, prec, ARF_RND_NEAR); // u1 = b^2 + ( (a-d)/2 )^2
arf_sqrt(u1, u1, prec, ARF_RND_NEAR); // u1 = sqrt(above)
arf_mul_2exp_si(u1, u1, 1); // u1 = 2 (sqrt (above) )
arf_add(u1, u1, d, prec, ARF_RND_NEAR); // u1 += d
arf_sub(u1, u1, a, prec, ARF_RND_NEAR); // u1 -= a
arf_mul_2exp_si(u1, u1, -1); // u1 = (d - a)/2 + sqrt(b^2 + ( (a-d)/2 )^2)
arf_mul(x, u1, u1, prec, ARF_RND_NEAR);
arf_addmul(x, b, b, prec, ARF_RND_NEAR); // x = u1^2 + b^2
arf_sqrt(x, x, prec, ARF_RND_NEAR); // x = sqrt(u1^2 + b^2)
arf_div(u2, u1, x, prec, ARF_RND_NEAR);
arf_div(u1, b, x, prec, ARF_RND_NEAR);
arf_neg(u1, u1);
arf_clear(x);
}
void
arf_get_fmpq(fmpq_t y, const arf_t x)
{
if (arf_is_zero(x))
{
fmpq_zero(y);
}
else if (arf_is_special(x) || !ARF_IS_LAGOM(x))
{
flint_printf("exception: arf_get_fmpq: cannot convert to rational\n");
abort();
}
else
{
fmpz_t man, exp;
slong e;
fmpz_init(man);
fmpz_init(exp);
arf_get_fmpz_2exp(man, exp, x);
e = *exp;
fmpz_set_ui(fmpq_denref(y), UWORD(1));
if (e >= 0)
{
fmpz_mul_2exp(fmpq_numref(y), man, e);
}
else
{
fmpz_set(fmpq_numref(y), man);
fmpz_mul_2exp(fmpq_denref(y), fmpq_denref(y), -e);
}
fmpz_clear(man);
fmpz_clear(exp);
}
}
int
arf_cmp_2exp_si(const arf_t x, long e)
{
if (arf_is_special(x))
{
if (arf_is_zero(x)) return -1;
if (arf_is_pos_inf(x)) return 1;
if (arf_is_neg_inf(x)) return -1;
return 0;
}
if (ARF_SGNBIT(x))
return -1;
/* Fast path. */
if (!COEFF_IS_MPZ(ARF_EXP(x)))
{
if (ARF_IS_POW2(x) && (ARF_EXP(x) - 1 == e))
return 0;
else
return (ARF_EXP(x) <= e) ? -1 : 1;
}
if (ARF_IS_POW2(x))
{
fmpz_t t;
fmpz_init(t);
fmpz_one(t);
fmpz_add_si(t, t, e);
if (fmpz_equal(ARF_EXPREF(x), t))
{
fmpz_clear(t);
return 0;
}
fmpz_clear(t);
}
return (fmpz_cmp_si(ARF_EXPREF(x), e) <= 0) ? -1 : 1;
}
int
arf_sum(arf_t s, arf_srcptr terms, long len, long prec, arf_rnd_t rnd)
{
arf_ptr blocks;
long i, j, used;
int have_merged, res;
/* first check if the result is inf or nan */
{
int have_pos_inf = 0;
int have_neg_inf = 0;
for (i = 0; i < len; i++)
{
if (arf_is_pos_inf(terms + i))
{
if (have_neg_inf)
{
arf_nan(s);
return 0;
}
have_pos_inf = 1;
}
else if (arf_is_neg_inf(terms + i))
{
if (have_pos_inf)
{
arf_nan(s);
return 0;
}
have_neg_inf = 1;
}
else if (arf_is_nan(terms + i))
{
arf_nan(s);
return 0;
}
}
if (have_pos_inf)
{
arf_pos_inf(s);
return 0;
}
if (have_neg_inf)
{
arf_neg_inf(s);
return 0;
}
}
blocks = flint_malloc(sizeof(arf_struct) * len);
for (i = 0; i < len; i++)
arf_init(blocks + i);
/* put all terms into blocks */
used = 0;
for (i = 0; i < len; i++)
{
if (!arf_is_zero(terms + i))
{
arf_set(blocks + used, terms + i);
used++;
}
}
/* merge blocks until all are well separated */
have_merged = 1;
while (used >= 2 && have_merged)
{
have_merged = 0;
for (i = 0; i < used && !have_merged; i++)
{
for (j = i + 1; j < used && !have_merged; j++)
{
if (_arf_are_close(blocks + i, blocks + j, prec))
{
arf_add(blocks + i, blocks + i, blocks + j,
ARF_PREC_EXACT, ARF_RND_DOWN);
/* remove the merged block */
arf_swap(blocks + j, blocks + used - 1);
used--;
/* remove the updated block if the sum is zero */
if (arf_is_zero(blocks + i))
{
arf_swap(blocks + i, blocks + used - 1);
used--;
}
have_merged = 1;
}
}
}
}
if (used == 0)
{
arf_zero(s);
res = 0;
}
else if (used == 1)
{
res = arf_set_round(s, blocks + 0, prec, rnd);
}
else
{
/* find the two largest blocks */
for (i = 1; i < used; i++)
if (arf_cmpabs(blocks + 0, blocks + i) < 0)
arf_swap(blocks + 0, blocks + i);
for (i = 2; i < used; i++)
if (arf_cmpabs(blocks + 1, blocks + i) < 0)
arf_swap(blocks + 1, blocks + i);
res = _arf_add_eps(s, blocks + 0, arf_sgn(blocks + 1), prec, rnd);
}
for (i = 0; i < len; i++)
arf_clear(blocks + i);
flint_free(blocks);
return res;
}
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
}
void
_arb_poly_mullow_block(arb_ptr z, arb_srcptr x, slong xlen,
arb_srcptr y, slong ylen, slong n, slong prec)
{
slong xmlen, xrlen, ymlen, yrlen, i;
fmpz *xz, *yz, *zz;
fmpz *xe, *ye;
slong *xblocks, *yblocks;
int squaring;
fmpz_t scale, t;
xlen = FLINT_MIN(xlen, n);
ylen = FLINT_MIN(ylen, n);
squaring = (x == y) && (xlen == ylen);
/* Strip trailing zeros */
xmlen = xrlen = xlen;
while (xmlen > 0 && arf_is_zero(arb_midref(x + xmlen - 1))) xmlen--;
while (xrlen > 0 && mag_is_zero(arb_radref(x + xrlen - 1))) xrlen--;
if (squaring)
{
ymlen = xmlen;
yrlen = xrlen;
}
else
{
ymlen = yrlen = ylen;
while (ymlen > 0 && arf_is_zero(arb_midref(y + ymlen - 1))) ymlen--;
while (yrlen > 0 && mag_is_zero(arb_radref(y + yrlen - 1))) yrlen--;
}
/* We don't know how to deal with infinities or NaNs */
if (!_arb_vec_is_finite(x, xlen) ||
(!squaring && !_arb_vec_is_finite(y, ylen)))
{
_arb_poly_mullow_classical(z, x, xlen, y, ylen, n, prec);
return;
}
xlen = FLINT_MAX(xmlen, xrlen);
ylen = FLINT_MAX(ymlen, yrlen);
/* Start with the zero polynomial */
_arb_vec_zero(z, n);
/* Nothing to do */
if (xlen == 0 || ylen == 0)
return;
n = FLINT_MIN(n, xlen + ylen - 1);
fmpz_init(scale);
fmpz_init(t);
xz = _fmpz_vec_init(xlen);
yz = _fmpz_vec_init(ylen);
zz = _fmpz_vec_init(n);
xe = _fmpz_vec_init(xlen);
ye = _fmpz_vec_init(ylen);
xblocks = flint_malloc(sizeof(slong) * (xlen + 1));
yblocks = flint_malloc(sizeof(slong) * (ylen + 1));
_arb_poly_get_scale(scale, x, xlen, y, ylen);
/* Error propagation */
/* (xm + xr)*(ym + yr) = (xm*ym) + (xr*ym + xm*yr + xr*yr)
= (xm*ym) + (xm*yr + xr*(ym + yr)) */
if (xrlen != 0 || yrlen != 0)
{
mag_ptr tmp;
double *xdbl, *ydbl;
tmp = _mag_vec_init(FLINT_MAX(xlen, ylen));
xdbl = flint_malloc(sizeof(double) * xlen);
ydbl = flint_malloc(sizeof(double) * ylen);
/* (xm + xr)^2 = (xm*ym) + (xr^2 + 2 xm xr)
= (xm*ym) + xr*(2 xm + xr) */
if (squaring)
{
_mag_vec_get_fmpz_2exp_blocks(xz, xdbl, xe, xblocks, scale, x, NULL, xrlen);
for (i = 0; i < xlen; i++)
{
arf_get_mag(tmp + i, arb_midref(x + i));
mag_mul_2exp_si(tmp + i, tmp + i, 1);
mag_add(tmp + i, tmp + i, arb_radref(x + i));
}
_mag_vec_get_fmpz_2exp_blocks(yz, ydbl, ye, yblocks, scale, NULL, tmp, xlen);
_arb_poly_addmullow_rad(z, zz, xz, xdbl, xe, xblocks, xrlen, yz, ydbl, ye, yblocks, xlen, n);
}
else if (yrlen == 0)
{
/* xr * |ym| */
_mag_vec_get_fmpz_2exp_blocks(xz, xdbl, xe, xblocks, scale, x, NULL, xrlen);
for (i = 0; i < ymlen; i++)
arf_get_mag(tmp + i, arb_midref(y + i));
_mag_vec_get_fmpz_2exp_blocks(yz, ydbl, ye, yblocks, scale, NULL, tmp, ymlen);
_arb_poly_addmullow_rad(z, zz, xz, xdbl, xe, xblocks, xrlen, yz, ydbl, ye, yblocks, ymlen, n);
}
else
{
/* |xm| * yr */
for (i = 0; i < xmlen; i++)
arf_get_mag(tmp + i, arb_midref(x + i));
_mag_vec_get_fmpz_2exp_blocks(xz, xdbl, xe, xblocks, scale, NULL, tmp, xmlen);
_mag_vec_get_fmpz_2exp_blocks(yz, ydbl, ye, yblocks, scale, y, NULL, yrlen);
_arb_poly_addmullow_rad(z, zz, xz, xdbl, xe, xblocks, xmlen, yz, ydbl, ye, yblocks, yrlen, n);
/* xr*(|ym| + yr) */
if (xrlen != 0)
{
_mag_vec_get_fmpz_2exp_blocks(xz, xdbl, xe, xblocks, scale, x, NULL, xrlen);
for (i = 0; i < ylen; i++)
arb_get_mag(tmp + i, y + i);
_mag_vec_get_fmpz_2exp_blocks(yz, ydbl, ye, yblocks, scale, NULL, tmp, ylen);
_arb_poly_addmullow_rad(z, zz, xz, xdbl, xe, xblocks, xrlen, yz, ydbl, ye, yblocks, ylen, n);
}
}
_mag_vec_clear(tmp, FLINT_MAX(xlen, ylen));
flint_free(xdbl);
flint_free(ydbl);
}
/* multiply midpoints */
if (xmlen != 0 && ymlen != 0)
{
_arb_vec_get_fmpz_2exp_blocks(xz, xe, xblocks, scale, x, xmlen, prec);
if (squaring)
{
_arb_poly_addmullow_block(z, zz, xz, xe, xblocks, xmlen, xz, xe, xblocks, xmlen, n, prec, 1);
}
else
{
_arb_vec_get_fmpz_2exp_blocks(yz, ye, yblocks, scale, y, ymlen, prec);
_arb_poly_addmullow_block(z, zz, xz, xe, xblocks, xmlen, yz, ye, yblocks, ymlen, n, prec, 0);
}
}
/* Unscale. */
if (!fmpz_is_zero(scale))
{
fmpz_zero(t);
for (i = 0; i < n; i++)
{
arb_mul_2exp_fmpz(z + i, z + i, t);
fmpz_add(t, t, scale);
}
}
_fmpz_vec_clear(xz, xlen);
_fmpz_vec_clear(yz, ylen);
_fmpz_vec_clear(zz, n);
_fmpz_vec_clear(xe, xlen);
_fmpz_vec_clear(ye, ylen);
flint_free(xblocks);
flint_free(yblocks);
fmpz_clear(scale);
fmpz_clear(t);
}
int
arf_submul(arf_ptr z, arf_srcptr x, arf_srcptr y, slong prec, arf_rnd_t rnd)
{
mp_size_t xn, yn, zn, tn, alloc;
mp_srcptr xptr, yptr, zptr;
mp_ptr tptr, tptr2;
fmpz_t texp;
slong shift;
int tsgnbit, inexact;
ARF_MUL_TMP_DECL
if (arf_is_special(x) || arf_is_special(y) || arf_is_special(z))
{
if (arf_is_zero(z))
{
return arf_neg_mul(z, x, y, prec, rnd);
}
else if (arf_is_finite(x) && arf_is_finite(y))
{
return arf_set_round(z, z, prec, rnd);
}
else
{
/* todo: speed up */
arf_t t;
arf_init(t);
arf_mul(t, x, y, ARF_PREC_EXACT, ARF_RND_DOWN);
inexact = arf_sub(z, z, t, prec, rnd);
arf_clear(t);
return inexact;
}
}
tsgnbit = ARF_SGNBIT(x) ^ ARF_SGNBIT(y) ^ 1;
ARF_GET_MPN_READONLY(xptr, xn, x);
ARF_GET_MPN_READONLY(yptr, yn, y);
ARF_GET_MPN_READONLY(zptr, zn, z);
fmpz_init(texp);
_fmpz_add2_fast(texp, ARF_EXPREF(x), ARF_EXPREF(y), 0);
shift = _fmpz_sub_small(ARF_EXPREF(z), texp);
alloc = tn = xn + yn;
ARF_MUL_TMP_ALLOC(tptr2, alloc)
tptr = tptr2;
ARF_MPN_MUL(tptr, xptr, xn, yptr, yn);
tn -= (tptr[0] == 0);
tptr += (tptr[0] == 0);
if (shift >= 0)
inexact = _arf_add_mpn(z, zptr, zn, ARF_SGNBIT(z), ARF_EXPREF(z),
tptr, tn, tsgnbit, shift, prec, rnd);
else
inexact = _arf_add_mpn(z, tptr, tn, tsgnbit, texp,
zptr, zn, ARF_SGNBIT(z), -shift, prec, rnd);
ARF_MUL_TMP_FREE(tptr2, alloc)
fmpz_clear(texp);
return inexact;
}
void
arb_atan_arf(arb_t z, const arf_t x, slong prec)
{
if (arf_is_special(x))
{
if (arf_is_zero(x))
{
arb_zero(z);
}
else if (arf_is_pos_inf(x))
{
arb_const_pi(z, prec);
arb_mul_2exp_si(z, z, -1);
}
else if (arf_is_neg_inf(x))
{
arb_const_pi(z, prec);
arb_mul_2exp_si(z, z, -1);
arb_neg(z, z);
}
else
{
arb_indeterminate(z);
}
}
else if (COEFF_IS_MPZ(*ARF_EXPREF(x)))
{
if (fmpz_sgn(ARF_EXPREF(x)) < 0)
arb_atan_eps(z, x, prec);
else
arb_atan_inf_eps(z, x, prec);
}
else
{
slong exp, wp, wn, N, r;
mp_srcptr xp;
mp_size_t xn, tn;
mp_ptr tmp, w, t, u;
mp_limb_t p1, q1bits, p2, q2bits, error, error2;
int negative, inexact, reciprocal;
TMP_INIT;
exp = ARF_EXP(x);
negative = ARF_SGNBIT(x);
if (exp < -(prec/2) - 2 || exp > prec + 2)
{
if (exp < 0)
arb_atan_eps(z, x, prec);
else
arb_atan_inf_eps(z, x, prec);
return;
}
ARF_GET_MPN_READONLY(xp, xn, x);
/* Special case: +/- 1 (we require |x| != 1 later on) */
if (exp == 1 && xn == 1 && xp[xn-1] == LIMB_TOP)
{
arb_const_pi(z, prec);
arb_mul_2exp_si(z, z, -2);
if (negative)
arb_neg(z, z);
return;
}
/* Absolute working precision (NOT rounded to a limb multiple) */
wp = prec - FLINT_MIN(0, exp) + 4;
/* Too high precision to use table */
if (wp > ARB_ATAN_TAB2_PREC)
{
arb_atan_arf_bb(z, x, prec);
return;
}
/* Working precision in limbs */
wn = (wp + FLINT_BITS - 1) / FLINT_BITS;
TMP_START;
tmp = TMP_ALLOC_LIMBS(4 * wn + 3);
w = tmp; /* requires wn+1 limbs */
t = w + wn + 1; /* requires wn+1 limbs */
u = t + wn + 1; /* requires 2wn+1 limbs */
/* ----------------------------------------------------------------- */
/* Convert x or 1/x to a fixed-point number |w| < 1 */
/* ----------------------------------------------------------------- */
if (exp <= 0) /* |x| < 1 */
{
reciprocal = 0;
/* todo: just zero top */
flint_mpn_zero(w, wn);
/* w = x as a fixed-point number */
error = _arf_get_integer_mpn(w, xp, xn, exp + wn * FLINT_BITS);
}
else /* |x| > 1 */
{
slong one_exp, one_limbs, one_bits;
mp_ptr one;
reciprocal = 1;
one_exp = xn * FLINT_BITS + wn * FLINT_BITS - exp;
flint_mpn_zero(w, wn);
/* 1/x becomes zero */
if (one_exp >= FLINT_BITS - 1)
{
/* w = 1/x */
one_limbs = one_exp / FLINT_BITS;
one_bits = one_exp % FLINT_BITS;
if (one_limbs + 1 >= xn)
{
one = TMP_ALLOC_LIMBS(one_limbs + 1);
flint_mpn_zero(one, one_limbs);
one[one_limbs] = UWORD(1) << one_bits;
/* todo: only zero necessary part */
flint_mpn_zero(w, wn);
mpn_tdiv_q(w, one, one_limbs + 1, xp, xn);
/* Now w must be < 1 since x > 1 and we rounded down; thus
w[wn] must be zero */
}
}
/* todo: moderate powers of two would be exact... */
error = 1;
}
/* ----------------------------------------------------------------- */
/* Table-based argument reduction */
/* ----------------------------------------------------------------- */
/* choose p such that p/q <= x < (p+1)/q */
if (wp <= ARB_ATAN_TAB1_PREC)
q1bits = ARB_ATAN_TAB1_BITS;
else
q1bits = ARB_ATAN_TAB21_BITS;
p1 = w[wn-1] >> (FLINT_BITS - q1bits);
/* atan(w) = atan(p/q) + atan(w2) */
/* where w2 = (q*w-p)/(q+p*w) */
if (p1 != 0)
{
t[wn] = (UWORD(1) << q1bits) + mpn_mul_1(t, w, wn, p1);
flint_mpn_zero(u, wn);
u[2 * wn] = mpn_lshift(u + wn, w, wn, q1bits) - p1;
mpn_tdiv_q(w, u, 2 * wn + 1, t, wn + 1);
error++; /* w2 is computed with 1 ulp error */
}
/* Do a second round of argument reduction */
if (wp <= ARB_ATAN_TAB1_PREC)
{
p2 = 0;
}
else
{
q2bits = ARB_ATAN_TAB21_BITS + ARB_ATAN_TAB22_BITS;
p2 = w[wn-1] >> (FLINT_BITS - q2bits);
if (p2 != 0)
{
t[wn] = (UWORD(1) << q2bits) + mpn_mul_1(t, w, wn, p2);
flint_mpn_zero(u, wn);
u[2 * wn] = mpn_lshift(u + wn, w, wn, q2bits) - p2;
mpn_tdiv_q(w, u, 2 * wn + 1, t, wn + 1);
error++;
}
}
/* |w| <= 2^-r */
r = _arb_mpn_leading_zeros(w, wn);
/* N >= (wp-r)/(2r) */
N = (wp - r + (2*r-1)) / (2*r);
/* Evaluate Taylor series */
_arb_atan_taylor_rs(t, &error2, w, wn, N, 1);
/* Taylor series evaluation error */
error += error2;
/* Size of output number */
tn = wn;
/* First table lookup */
if (p1 != 0)
{
if (wp <= ARB_ATAN_TAB1_PREC)
mpn_add_n(t, t, arb_atan_tab1[p1] + ARB_ATAN_TAB1_LIMBS - tn, tn);
else
mpn_add_n(t, t, arb_atan_tab21[p1] + ARB_ATAN_TAB2_LIMBS - tn, tn);
error++;
}
/* Second table lookup */
if (p2 != 0)
{
mpn_add_n(t, t, arb_atan_tab22[p2] + ARB_ATAN_TAB2_LIMBS - tn, tn);
error++;
}
/* pi/2 - atan(1/x) */
if (reciprocal)
{
t[tn] = LIMB_ONE - mpn_sub_n(t,
arb_atan_pi2_minus_one + ARB_ATAN_TAB2_LIMBS - tn, t, tn);
/* result can be >= 1 */
tn += (t[tn] != 0);
/* error of pi/2 */
error++;
}
/* The accumulated arithmetic error */
mag_set_ui_2exp_si(arb_radref(z), error, -wn * FLINT_BITS);
/* Truncation error from the Taylor series */
mag_add_ui_2exp_si(arb_radref(z), arb_radref(z), 1, -r*(2*N+1));
/* Set the midpoint */
inexact = _arf_set_mpn_fixed(arb_midref(z), t, tn, wn, negative, prec, ARB_RND);
if (inexact)
arf_mag_add_ulp(arb_radref(z), arb_radref(z), arb_midref(z), prec);
TMP_END;
}
}
int
arf_submul_mpz(arf_ptr z, arf_srcptr x, const mpz_t y, slong prec, arf_rnd_t rnd)
{
mp_size_t xn, yn, zn, tn, alloc;
mp_srcptr xptr, yptr, zptr;
mp_ptr tptr, tptr2;
fmpz_t texp, yexp;
slong shift;
int tsgnbit, ysgnbit, inexact;
ARF_MUL_TMP_DECL
yn = FLINT_ABS(y->_mp_size);
if (arf_is_special(x) || yn == 0 || arf_is_special(z))
{
if (arf_is_zero(z))
{
/* TODO: make more efficient */
arf_mul_mpz(z, x, y, ARF_PREC_EXACT, rnd);
return arf_neg_round(z, z, prec, rnd);
}
else if (arf_is_finite(x))
{
return arf_set_round(z, z, prec, rnd);
}
else
{
/* todo: speed up */
arf_t t;
arf_init(t);
arf_mul_mpz(t, x, y, ARF_PREC_EXACT, ARF_RND_DOWN);
inexact = arf_sub(z, z, t, prec, rnd);
arf_clear(t);
return inexact;
}
}
ARF_GET_MPN_READONLY(xptr, xn, x);
yptr = y->_mp_d;
ysgnbit = (y->_mp_size > 0);
*yexp = yn * FLINT_BITS;
ARF_GET_MPN_READONLY(zptr, zn, z);
fmpz_init(texp);
tsgnbit = ARF_SGNBIT(x) ^ ysgnbit;
alloc = tn = xn + yn;
ARF_MUL_TMP_ALLOC(tptr2, alloc)
tptr = tptr2;
ARF_MPN_MUL(tptr, xptr, xn, yptr, yn);
shift = (tptr[tn - 1] == 0) * FLINT_BITS;
tn -= (tptr[tn - 1] == 0);
_fmpz_add2_fast(texp, ARF_EXPREF(x), yexp, -shift);
shift = _fmpz_sub_small(ARF_EXPREF(z), texp);
if (shift >= 0)
inexact = _arf_add_mpn(z, zptr, zn, ARF_SGNBIT(z), ARF_EXPREF(z),
tptr, tn, tsgnbit, shift, prec, rnd);
else
inexact = _arf_add_mpn(z, tptr, tn, tsgnbit, texp,
zptr, zn, ARF_SGNBIT(z), -shift, prec, rnd);
ARF_MUL_TMP_FREE(tptr2, alloc)
fmpz_clear(texp);
return inexact;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("is_int_2exp_si....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arf_t x, y;
fmpz_t t;
slong e;
int res1, res2;
arf_init(x);
arf_init(y);
fmpz_init(t);
arf_randtest_special(x, state, 2000, 100);
e = n_randtest(state);
arf_mul_2exp_si(y, x, e);
res1 = arf_is_int(x);
res2 = arf_is_int_2exp_si(y, e);
if (res1 != res2)
{
flint_printf("FAIL! (1)\n");
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("y = "); arf_print(y); flint_printf("\n\n");
flint_printf("res1 = %d, res2 = %d\n\n", res1, res2);
abort();
}
if (res1)
{
if (n_randint(state, 2))
arf_floor(y, x);
else
arf_ceil(y, x);
if (!arf_equal(x, y) || !arf_is_finite(x))
{
flint_printf("FAIL! (2)\n");
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("y = "); arf_print(y); flint_printf("\n\n");
flint_printf("res1 = %d\n\n", res1);
abort();
}
}
if (arf_is_finite(x) && !arf_is_zero(x))
{
arf_bot(t, x);
fmpz_neg(t, t);
arf_mul_2exp_fmpz(x, x, t);
res1 = arf_is_int(x);
arf_mul_2exp_si(y, x, -1);
res2 = arf_is_int(y);
if (!arf_is_int(x) || arf_is_int(y))
{
flint_printf("FAIL! (3)\n");
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("y = "); arf_print(y); flint_printf("\n\n");
flint_printf("res1 = %d, res2 = %d\n\n", res1, res2);
abort();
}
}
arf_clear(x);
arf_clear(y);
fmpz_clear(t);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
void
arf_get_fmpz(fmpz_t z, const arf_t x, arf_rnd_t rnd)
{
if (arf_is_special(x))
{
if (arf_is_zero(x))
{
fmpz_zero(z);
}
else
{
flint_printf("arf_get_fmpz: cannot convert infinity or nan to integer\n");
abort();
}
}
else if (COEFF_IS_MPZ(*ARF_EXPREF(x)))
{
/* tiny */
if (fmpz_sgn(ARF_EXPREF(x)) < 0)
{
int negative = ARF_SGNBIT(x);
if (rnd == ARF_RND_NEAR
|| rnd == ARF_RND_DOWN
|| (rnd == ARF_RND_FLOOR && !negative)
|| (rnd == ARF_RND_CEIL && negative))
{
fmpz_zero(z);
}
else
{
fmpz_set_si(z, negative ? -1 : 1);
}
}
else
{
flint_printf("arf_get_fmpz: number too large to convert to integer\n");
abort();
}
}
else
{
slong exp;
int negative, inexact;
mp_size_t xn, zn;
mp_srcptr xp;
__mpz_struct * zz;
/* TBD: implement efficiently */
if (rnd == ARF_RND_NEAR)
{
fmpr_t t;
fmpr_init(t);
arf_get_fmpr(t, x);
fmpr_get_fmpz(z, t, rnd);
fmpr_clear(t);
return;
}
exp = ARF_EXP(x);
negative = ARF_SGNBIT(x);
/* |x| < 1 */
if (exp <= 0)
{
if (rnd == ARF_RND_DOWN ||
(rnd == ARF_RND_FLOOR && !negative) ||
(rnd == ARF_RND_CEIL && negative))
{
fmpz_zero(z);
}
else
{
fmpz_set_si(z, negative ? -1 : 1);
}
return;
}
ARF_GET_MPN_READONLY(xp, xn, x);
/* |x| < 2^31 or 2^63 (must save 1 bit for rounding up!) */
if (exp < FLINT_BITS)
{
mp_limb_t v, v2;
v = xp[xn - 1];
v2 = v >> (FLINT_BITS - exp);
inexact = (xn > 1) || ((v2 << (FLINT_BITS - exp)) != v);
if (inexact && rnd != ARF_RND_DOWN)
{
if (negative && (rnd == ARF_RND_UP || rnd == ARF_RND_FLOOR))
v2++;
if (!negative && (rnd == ARF_RND_UP || rnd == ARF_RND_CEIL))
v2++;
}
if (negative)
fmpz_neg_ui(z, v2);
else
fmpz_set_ui(z, v2);
return;
}
/* |x| >= 1 */
zn = (exp + FLINT_BITS - 1) / FLINT_BITS;
zz = _fmpz_promote(z);
if (zz->_mp_alloc < zn)
mpz_realloc2(zz, zn * FLINT_BITS);
inexact = _arf_get_integer_mpn(zz->_mp_d, xp, xn, exp);
zz->_mp_size = negative ? -zn : zn;
_fmpz_demote_val(z);
if (inexact && rnd != ARF_RND_DOWN)
{
if (negative && (rnd == ARF_RND_UP || rnd == ARF_RND_FLOOR))
fmpz_sub_ui(z, z, 1);
if (!negative && (rnd == ARF_RND_UP || rnd == ARF_RND_CEIL))
fmpz_add_ui(z, z, 1);
}
}
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);
}
