void
arb_set_interval_arf(arb_t x, const arf_t a, const arf_t b, long prec)
{
arf_t t;
int inexact;
if (arf_is_inf(a) && arf_equal(a, b))
{
/* [-inf, -inf] or [+inf, +inf] */
arf_set(arb_midref(x), a);
mag_zero(arb_radref(x));
return;
}
arf_init(t);
arf_sub(t, b, a, MAG_BITS, ARF_RND_UP);
if (arf_sgn(t) < 0)
{
printf("exception: arb_set_interval_arf: endpoints not ordered\n");
abort();
}
arf_get_mag(arb_radref(x), t);
inexact = arf_add(arb_midref(x), a, b, prec, ARB_RND);
if (inexact)
arf_mag_add_ulp(arb_radref(x), arb_radref(x), arb_midref(x), prec);
arb_mul_2exp_si(x, x, -1);
arf_clear(t);
}
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;
}
}
int
arf_set_round(arf_t y, const arf_t x, slong prec, arf_rnd_t rnd)
{
if (arf_is_special(x))
{
arf_set(y, x);
return 0;
}
else
{
int inexact;
slong fix;
mp_size_t xn;
mp_srcptr xptr;
if (y == x)
{
mp_ptr xtmp;
TMP_INIT;
ARF_GET_MPN_READONLY(xptr, xn, x);
/* exact */
if (xn * FLINT_BITS <= prec)
return 0;
if ((xn - 1) * FLINT_BITS < prec)
{
/* exact */
if ((xptr[0] << (prec - (xn-1) * FLINT_BITS)) == 0)
return 0;
}
/* inexact */
TMP_START;
xtmp = TMP_ALLOC(xn * sizeof(mp_limb_t));
flint_mpn_copyi(xtmp, xptr, xn);
inexact = _arf_set_round_mpn(y, &fix, xtmp, xn, ARF_SGNBIT(x), prec, rnd);
_fmpz_add_fast(ARF_EXPREF(y), ARF_EXPREF(x), fix);
TMP_END;
return inexact;
}
else
{
ARF_GET_MPN_READONLY(xptr, xn, x);
inexact = _arf_set_round_mpn(y, &fix, xptr, xn,
ARF_SGNBIT(x), prec, rnd);
_fmpz_add_fast(ARF_EXPREF(y), ARF_EXPREF(x), fix);
return inexact;
}
}
}
void
acb_hypgeom_erf_1f1(acb_t res, const acb_t z, slong prec,
slong wp, int more_imaginary)
{
if (acb_rel_accuracy_bits(z) >= wp)
{
if (more_imaginary)
acb_hypgeom_erf_1f1a(res, z, wp);
else
acb_hypgeom_erf_1f1b(res, z, wp);
}
else
{
acb_t zmid;
mag_t re_err, im_err;
acb_init(zmid);
mag_init(re_err);
mag_init(im_err);
acb_hypgeom_erf_propagated_error(re_err, im_err, z);
arf_set(arb_midref(acb_realref(zmid)), arb_midref(acb_realref(z)));
arf_set(arb_midref(acb_imagref(zmid)), arb_midref(acb_imagref(z)));
if (more_imaginary)
acb_hypgeom_erf_1f1a(res, zmid, wp);
else
acb_hypgeom_erf_1f1b(res, zmid, wp);
arb_add_error_mag(acb_realref(res), re_err);
arb_add_error_mag(acb_imagref(res), im_err);
acb_clear(zmid);
mag_clear(re_err);
mag_clear(im_err);
}
acb_set_round(res, res, prec);
}
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 arb_calc_newton_step(arb_t xnew, arb_calc_func_t func,
void * param, const arb_t x, const arb_t conv_region,
const arf_t conv_factor, slong prec)
{
mag_t err, v;
arb_t t;
arb_struct u[2];
int result;
mag_init(err);
mag_init(v);
arb_init(t);
arb_init(u + 0);
arb_init(u + 1);
mag_mul(err, arb_radref(x), arb_radref(x));
arf_get_mag(v, conv_factor);
mag_mul(err, err, v);
arf_set(arb_midref(t), arb_midref(x));
mag_zero(arb_radref(t));
func(u, t, param, 2, prec);
arb_div(u, u, u + 1, prec);
arb_sub(u, t, u, prec);
mag_add(arb_radref(u), arb_radref(u), err);
if (arb_contains(conv_region, u) &&
(mag_cmp(arb_radref(u), arb_radref(x)) < 0))
{
arb_swap(xnew, u);
result = ARB_CALC_SUCCESS;
}
else
{
arb_set(xnew, x);
result = ARB_CALC_NO_CONVERGENCE;
}
arb_clear(t);
arb_clear(u);
arb_clear(u + 1);
mag_clear(err);
mag_clear(v);
return result;
}
int
_arb_poly_newton_step(arb_t xnew, arb_srcptr poly, long len,
const arb_t x,
const arb_t convergence_interval,
const arf_t convergence_factor, long prec)
{
arf_t err;
arb_t t, u, v;
int result;
arf_init(err);
arb_init(t);
arb_init(u);
arb_init(v);
arf_set_mag(err, arb_radref(x));
arf_mul(err, err, err, MAG_BITS, ARF_RND_UP);
arf_mul(err, err, convergence_factor, MAG_BITS, ARF_RND_UP);
arf_set(arb_midref(t), arb_midref(x));
mag_zero(arb_radref(t));
_arb_poly_evaluate2(u, v, poly, len, t, prec);
arb_div(u, u, v, prec);
arb_sub(u, t, u, prec);
arb_add_error_arf(u, err);
if (arb_contains(convergence_interval, u) &&
(mag_cmp(arb_radref(u), arb_radref(x)) < 0))
{
arb_swap(xnew, u);
result = 1;
}
else
{
arb_set(xnew, x);
result = 0;
}
arb_clear(t);
arb_clear(u);
arb_clear(v);
arf_clear(err);
return result;
}
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;
}
/* check accuracy compared to reference algorithm */
void arb_exp_simple(arb_t res, const arb_t x, slong prec)
{
mag_t t, u;
mag_init_set(t, arb_radref(x));
mag_init(u);
arf_set(arb_midref(res), arb_midref(x));
mag_zero(arb_radref(res));
arb_exp(res, x, prec);
mag_expm1(t, t);
arb_get_mag(u, res);
mag_addmul(arb_radref(res), t, u);
mag_clear(t);
mag_clear(u);
}
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
arb_sqrtpos(arb_t z, const arb_t x, long prec)
{
if (!arb_is_finite(x))
{
if (mag_is_zero(arb_radref(x)) && arf_is_pos_inf(arb_midref(x)))
arb_pos_inf(z);
else
arb_zero_pm_inf(z);
}
else if (arb_contains_nonpositive(x))
{
arf_t t;
arf_init(t);
arf_set_mag(t, arb_radref(x));
arf_add(t, arb_midref(x), t, MAG_BITS, ARF_RND_CEIL);
if (arf_sgn(t) <= 0)
{
arb_zero(z);
}
else
{
arf_sqrt(t, t, MAG_BITS, ARF_RND_CEIL);
arf_mul_2exp_si(t, t, -1);
arf_set(arb_midref(z), t);
arf_get_mag(arb_radref(z), t);
}
arf_clear(t);
}
else
{
arb_sqrt(z, x, prec);
}
arb_nonnegative_part(z, z, prec);
}
int main()
{
slong iter, iter2;
flint_rand_t state;
flint_printf("addmul_si....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 1000 * arb_test_multiplier(); iter++)
{
arf_t x, z, v;
slong y;
slong prec, r1, r2;
arf_rnd_t rnd;
arf_init(x);
arf_init(z);
arf_init(v);
for (iter2 = 0; iter2 < 100; iter2++)
{
arf_randtest_special(x, state, 2000, 100);
y = z_randtest(state);
arf_randtest_special(z, state, 2000, 100);
arf_set(v, z);
prec = 2 + n_randint(state, 2000);
if (n_randint(state, 10) == 0 &&
fmpz_bits(ARF_EXPREF(x)) < 10 &&
fmpz_bits(ARF_EXPREF(z)) < 10)
{
prec = ARF_PREC_EXACT;
}
switch (n_randint(state, 5))
{
case 0: rnd = ARF_RND_DOWN; break;
case 1: rnd = ARF_RND_UP; break;
case 2: rnd = ARF_RND_FLOOR; break;
case 3: rnd = ARF_RND_CEIL; break;
default: rnd = ARF_RND_NEAR; break;
}
switch (n_randint(state, 2))
{
case 0:
r1 = arf_addmul_si(z, x, y, prec, rnd);
r2 = arf_addmul_si_naive(v, x, y, prec, rnd);
if (!arf_equal(z, v) || r1 != r2)
{
flint_printf("FAIL!\n");
flint_printf("prec = %wd, rnd = %d\n\n", prec, rnd);
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("y = %wd", y); flint_printf("\n\n");
flint_printf("z = "); arf_debug(z); flint_printf("\n\n");
flint_printf("v = "); arf_debug(v); flint_printf("\n\n");
flint_printf("r1 = %wd, r2 = %wd\n", r1, r2);
abort();
}
break;
default:
r2 = arf_addmul_si_naive(v, v, y, prec, rnd);
r1 = arf_addmul_si(z, z, y, prec, rnd);
if (!arf_equal(v, z) || r1 != r2)
{
flint_printf("FAIL (aliasing)!\n");
flint_printf("prec = %wd, rnd = %d\n\n", prec, rnd);
flint_printf("y = %wd", y); flint_printf("\n\n");
flint_printf("v = "); arf_print(v); flint_printf("\n\n");
flint_printf("z = "); arf_print(z); flint_printf("\n\n");
flint_printf("r1 = %wd, r2 = %wd\n", r1, r2);
abort();
}
break;
}
}
arf_clear(x);
arf_clear(z);
arf_clear(v);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
void
arb_mul_naive(arb_t z, const arb_t x, const arb_t y, slong prec)
{
arf_t zm_exact, zm_rounded, zr, t, u;
arf_init(zm_exact);
arf_init(zm_rounded);
arf_init(zr);
arf_init(t);
arf_init(u);
arf_mul(zm_exact, arb_midref(x), arb_midref(y), ARF_PREC_EXACT, ARF_RND_DOWN);
arf_set_round(zm_rounded, zm_exact, prec, ARB_RND);
/* rounding error */
if (arf_equal(zm_exact, zm_rounded))
{
arf_zero(zr);
}
else
{
fmpz_t e;
fmpz_init(e);
/* more accurate, but not what we are testing
arf_sub(zr, zm_exact, zm_rounded, MAG_BITS, ARF_RND_UP);
arf_abs(zr, zr); */
fmpz_sub_ui(e, ARF_EXPREF(zm_rounded), prec);
arf_one(zr);
arf_mul_2exp_fmpz(zr, zr, e);
fmpz_clear(e);
}
/* propagated error */
if (!arb_is_exact(x))
{
arf_set_mag(t, arb_radref(x));
arf_abs(u, arb_midref(y));
arf_addmul(zr, t, u, MAG_BITS, ARF_RND_UP);
}
if (!arb_is_exact(y))
{
arf_set_mag(t, arb_radref(y));
arf_abs(u, arb_midref(x));
arf_addmul(zr, t, u, MAG_BITS, ARF_RND_UP);
}
if (!arb_is_exact(x) && !arb_is_exact(y))
{
arf_set_mag(t, arb_radref(x));
arf_set_mag(u, arb_radref(y));
arf_addmul(zr, t, u, MAG_BITS, ARF_RND_UP);
}
arf_set(arb_midref(z), zm_rounded);
arf_get_mag(arb_radref(z), zr);
arf_clear(zm_exact);
arf_clear(zm_rounded);
arf_clear(zr);
arf_clear(t);
arf_clear(u);
}
/* error propagation based on derivatives */
void
acb_hypgeom_airy_direct_prop(acb_t ai, acb_t aip, acb_t bi, acb_t bip,
const acb_t z, slong n, slong prec)
{
mag_t aib, aipb, bib, bipb, zb, rad;
acb_t zz;
int real;
mag_init(aib);
mag_init(aipb);
mag_init(bib);
mag_init(bipb);
mag_init(zb);
mag_init(rad);
acb_init(zz);
real = acb_is_real(z);
arf_set(arb_midref(acb_realref(zz)), arb_midref(acb_realref(z)));
arf_set(arb_midref(acb_imagref(zz)), arb_midref(acb_imagref(z)));
mag_hypot(rad, arb_radref(acb_realref(z)), arb_radref(acb_imagref(z)));
acb_get_mag(zb, z);
acb_hypgeom_airy_bound(aib, aipb, bib, bipb, z);
acb_hypgeom_airy_direct(ai, aip, bi, bip, zz, n, prec);
if (ai != NULL)
{
mag_mul(aipb, aipb, rad);
if (real)
arb_add_error_mag(acb_realref(ai), aipb);
else
acb_add_error_mag(ai, aipb);
}
if (aip != NULL)
{
mag_mul(aib, aib, rad);
mag_mul(aib, aib, zb); /* |Ai''(z)| = |z Ai(z)| */
if (real)
arb_add_error_mag(acb_realref(aip), aib);
else
acb_add_error_mag(aip, aib);
}
if (bi != NULL)
{
mag_mul(bipb, bipb, rad);
if (real)
arb_add_error_mag(acb_realref(bi), bipb);
else
acb_add_error_mag(bi, bipb);
}
if (bip != NULL)
{
mag_mul(bib, bib, rad);
mag_mul(bib, bib, zb); /* |Bi''(z)| = |z Bi(z)| */
if (real)
arb_add_error_mag(acb_realref(bip), bib);
else
acb_add_error_mag(bip, bib);
}
mag_clear(aib);
mag_clear(aipb);
mag_clear(bib);
mag_clear(bipb);
mag_clear(zb);
mag_clear(rad);
acb_clear(zz);
}
int main()
{
long iter, iter2;
flint_rand_t state;
printf("complex_mul....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000; iter++)
{
arf_t e1, f1, e2, f2, a, b, c, d;
long prec, r1, r2;
arf_rnd_t rnd;
arf_init(a);
arf_init(b);
arf_init(c);
arf_init(d);
arf_init(e1);
arf_init(f1);
arf_init(e2);
arf_init(f2);
for (iter2 = 0; iter2 < 100; iter2++)
{
arf_randtest_special(a, state, 3000, 100);
arf_randtest_special(b, state, 3000, 100);
arf_randtest_special(c, state, 3000, 100);
arf_randtest_special(d, state, 3000, 100);
prec = 2 + n_randint(state, 3000);
switch (n_randint(state, 4))
{
case 0: rnd = ARF_RND_DOWN; break;
case 1: rnd = ARF_RND_UP; break;
case 2: rnd = ARF_RND_FLOOR; break;
default: rnd = ARF_RND_CEIL; break;
}
switch (n_randint(state, 5))
{
case 0:
r1 = arf_complex_mul(e1, f1, a, b, c, d, prec, rnd);
r2 = arf_complex_mul_fallback(e2, f2, a, b, c, d, prec, rnd);
if (!arf_equal(e1, e2) || !arf_equal(f1, f2) || r1 != r2)
{
printf("FAIL!\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("a = "); arf_print(a); printf("\n\n");
printf("b = "); arf_print(b); printf("\n\n");
printf("c = "); arf_print(c); printf("\n\n");
printf("d = "); arf_print(d); printf("\n\n");
printf("e1 = "); arf_print(e1); printf("\n\n");
printf("f1 = "); arf_print(f1); printf("\n\n");
printf("e2 = "); arf_print(e2); printf("\n\n");
printf("f2 = "); arf_print(f2); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
case 1:
arf_set(c, a);
arf_set(d, b);
r1 = arf_complex_mul(e1, f1, a, b, a, b, prec, rnd);
r2 = arf_complex_mul_fallback(e2, f2, a, b, c, d, prec, rnd);
if (!arf_equal(e1, e2) || !arf_equal(f1, f2) || r1 != r2)
{
printf("FAIL! (aliasing 1)\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("a = "); arf_print(a); printf("\n\n");
printf("b = "); arf_print(b); printf("\n\n");
printf("c = "); arf_print(c); printf("\n\n");
printf("d = "); arf_print(d); printf("\n\n");
printf("e1 = "); arf_print(e1); printf("\n\n");
printf("f1 = "); arf_print(f1); printf("\n\n");
printf("e2 = "); arf_print(e2); printf("\n\n");
printf("f2 = "); arf_print(f2); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
case 2:
r1 = arf_complex_mul_fallback(e1, f1, a, b, a, b, prec, rnd);
r2 = arf_complex_mul(a, b, a, b, a, b, prec, rnd);
if (!arf_equal(e1, a) || !arf_equal(f1, b) || r1 != r2)
{
printf("FAIL! (aliasing 2)\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("a = "); arf_print(a); printf("\n\n");
printf("b = "); arf_print(b); printf("\n\n");
printf("e1 = "); arf_print(e1); printf("\n\n");
printf("f1 = "); arf_print(f1); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
case 3:
r1 = arf_complex_mul_fallback(e1, f1, a, b, c, d, prec, rnd);
r2 = arf_complex_mul(a, b, a, b, c, d, prec, rnd);
if (!arf_equal(e1, a) || !arf_equal(f1, b) || r1 != r2)
{
printf("FAIL! (aliasing 3)\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("a = "); arf_print(a); printf("\n\n");
printf("b = "); arf_print(b); printf("\n\n");
printf("c = "); arf_print(c); printf("\n\n");
printf("d = "); arf_print(d); printf("\n\n");
printf("e1 = "); arf_print(e1); printf("\n\n");
printf("f1 = "); arf_print(f1); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
default:
r1 = arf_complex_mul_fallback(e1, f1, a, b, c, d, prec, rnd);
r2 = arf_complex_mul(c, d, a, b, c, d, prec, rnd);
if (!arf_equal(e1, c) || !arf_equal(f1, d) || r1 != r2)
{
printf("FAIL! (aliasing 4)\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("a = "); arf_print(a); printf("\n\n");
printf("b = "); arf_print(b); printf("\n\n");
printf("c = "); arf_print(c); printf("\n\n");
printf("d = "); arf_print(d); printf("\n\n");
printf("e1 = "); arf_print(e1); printf("\n\n");
printf("f1 = "); arf_print(f1); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
}
}
arf_clear(a);
arf_clear(b);
arf_clear(c);
arf_clear(d);
arf_clear(e1);
arf_clear(f1);
arf_clear(e2);
arf_clear(f2);
}
flint_randclear(state);
flint_cleanup();
printf("PASS\n");
return EXIT_SUCCESS;
}
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;
}
/* derivatives: |8/sqrt(pi) sin(2z^2)|, |8/sqrt(pi) cos(2z^2)| <= 5 exp(4|xy|) */
void
acb_hypgeom_fresnel_erf_error(acb_t res1, acb_t res2, const acb_t z, slong prec)
{
mag_t re;
mag_t im;
acb_t zmid;
mag_init(re);
mag_init(im);
acb_init(zmid);
if (arf_cmpabs_ui(arb_midref(acb_realref(z)), 1000) < 0 &&
arf_cmpabs_ui(arb_midref(acb_imagref(z)), 1000) < 0)
{
arb_get_mag(re, acb_realref(z));
arb_get_mag(im, acb_imagref(z));
mag_mul(re, re, im);
mag_mul_2exp_si(re, re, 2);
mag_exp(re, re);
mag_mul_ui(re, re, 5);
}
else
{
arb_t t;
arb_init(t);
arb_mul(t, acb_realref(z), acb_imagref(z), prec);
arb_abs(t, t);
arb_mul_2exp_si(t, t, 2);
arb_exp(t, t, prec);
arb_get_mag(re, t);
mag_mul_ui(re, re, 5);
arb_clear(t);
}
mag_hypot(im, arb_radref(acb_realref(z)), arb_radref(acb_imagref(z)));
mag_mul(re, re, im);
if (arb_is_zero(acb_imagref(z)))
{
mag_set_ui(im, 8); /* For real x, |S(x)| < 4, |C(x)| < 4. */
mag_min(re, re, im);
mag_zero(im);
}
else if (arb_is_zero(acb_realref(z)))
{
mag_set_ui(im, 8);
mag_min(im, re, im);
mag_zero(re);
}
else
{
mag_set(im, re);
}
arf_set(arb_midref(acb_realref(zmid)), arb_midref(acb_realref(z)));
arf_set(arb_midref(acb_imagref(zmid)), arb_midref(acb_imagref(z)));
acb_hypgeom_fresnel_erf(res1, res2, zmid, prec);
if (res1 != NULL)
{
arb_add_error_mag(acb_realref(res1), re);
arb_add_error_mag(acb_imagref(res1), im);
}
if (res2 != NULL)
{
arb_add_error_mag(acb_realref(res2), re);
arb_add_error_mag(acb_imagref(res2), im);
}
mag_clear(re);
mag_clear(im);
acb_clear(zmid);
}
void
acb_hypgeom_erf_asymp(acb_t res, const acb_t z, int complementary, slong prec, slong prec2)
{
acb_t a, t, u;
acb_init(a);
acb_init(t);
acb_init(u);
if (!acb_is_exact(z) &&
(arf_cmpabs_ui(arb_midref(acb_realref(z)), prec) < 0) &&
(arf_cmpabs_ui(arb_midref(acb_imagref(z)), prec) < 0))
{
acb_t zmid;
mag_t re_err, im_err;
acb_init(zmid);
mag_init(re_err);
mag_init(im_err);
acb_hypgeom_erf_propagated_error(re_err, im_err, z);
arf_set(arb_midref(acb_realref(zmid)), arb_midref(acb_realref(z)));
arf_set(arb_midref(acb_imagref(zmid)), arb_midref(acb_imagref(z)));
acb_hypgeom_erf_asymp(res, zmid, complementary, prec, prec2);
arb_add_error_mag(acb_realref(res), re_err);
arb_add_error_mag(acb_imagref(res), im_err);
acb_clear(zmid);
mag_clear(re_err);
mag_clear(im_err);
return;
}
acb_one(a);
acb_mul_2exp_si(a, a, -1);
acb_mul(t, z, z, prec2);
acb_hypgeom_u_asymp(u, a, a, t, -1, prec2);
acb_neg(t, t);
acb_exp(t, t, prec2);
acb_mul(u, u, t, prec2);
arb_const_sqrt_pi(acb_realref(t), prec2);
arb_zero(acb_imagref(t));
acb_mul(t, t, z, prec2);
acb_div(u, u, t, prec2);
/* branch cut term: -1 or 1 */
acb_csgn(acb_realref(t), z);
arb_zero(acb_imagref(t));
if (complementary)
{
/* erfc(z) = 1 - erf(z) = u - (sgn - 1) */
acb_sub_ui(t, t, 1, prec);
acb_sub(t, u, t, prec);
}
else
{
/* erf(z) = sgn - u */
acb_sub(t, t, u, prec);
}
if (arb_is_zero(acb_imagref(z)))
{
arb_zero(acb_imagref(t));
}
else if (arb_is_zero(acb_realref(z)))
{
if (complementary)
arb_one(acb_realref(t));
else
arb_zero(acb_realref(t));
}
acb_set(res, t);
acb_clear(a);
acb_clear(t);
acb_clear(u);
}
static void
acb_log_sin_pi_half(acb_t res, const acb_t z, slong prec, int upper)
{
acb_t t, u, zmid;
arf_t n;
arb_t pi;
acb_init(t);
acb_init(u);
acb_init(zmid);
arf_init(n);
arb_init(pi);
arf_set(arb_midref(acb_realref(zmid)), arb_midref(acb_realref(z)));
arf_set(arb_midref(acb_imagref(zmid)), arb_midref(acb_imagref(z)));
arf_floor(n, arb_midref(acb_realref(zmid)));
arb_sub_arf(acb_realref(zmid), acb_realref(zmid), n, prec);
arb_const_pi(pi, prec);
if (arf_cmpabs_2exp_si(arb_midref(acb_imagref(zmid)), 2) < 1)
{
acb_sin_pi(t, zmid, prec);
acb_log(t, t, prec);
}
else /* i*pi*(z-0.5) + log((1-exp(-2i*pi*z))/2) */
{
acb_mul_2exp_si(t, zmid, 1);
acb_neg(t, t);
if (upper)
acb_conj(t, t);
acb_exp_pi_i(t, t, prec);
acb_sub_ui(t, t, 1, prec);
acb_neg(t, t);
acb_mul_2exp_si(t, t, -1);
acb_log(t, t, prec);
acb_one(u);
acb_mul_2exp_si(u, u, -1);
acb_sub(u, zmid, u, prec);
if (upper)
acb_conj(u, u);
acb_mul_onei(u, u);
acb_addmul_arb(t, u, pi, prec);
if (upper)
acb_conj(t, t);
}
if (upper)
arb_submul_arf(acb_imagref(t), pi, n, prec);
else
arb_addmul_arf(acb_imagref(t), pi, n, prec);
/* propagated error bound from the derivative pi cot(pi z) */
if (!acb_is_exact(z))
{
mag_t zm, um;
mag_init(zm);
mag_init(um);
acb_cot_pi(u, z, prec);
acb_mul_arb(u, u, pi, prec);
mag_hypot(zm, arb_radref(acb_realref(z)), arb_radref(acb_imagref(z)));
acb_get_mag(um, u);
mag_mul(um, um, zm);
acb_add_error_mag(t, um);
mag_clear(zm);
mag_clear(um);
}
acb_set(res, t);
acb_clear(t);
acb_clear(u);
acb_clear(zmid);
arf_clear(n);
arb_clear(pi);
}
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 main()
{
long iter;
flint_rand_t state;
printf("add_error....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000; iter++)
{
arb_t a, b, c;
arf_t m, r;
arb_init(a);
arb_init(b);
arb_init(c);
arf_init(m);
arf_init(r);
arb_randtest_special(a, state, 1 + n_randint(state, 2000), 10);
arb_randtest_special(b, state, 1 + n_randint(state, 2000), 10);
arb_randtest_special(c, state, 1 + n_randint(state, 2000), 10);
arf_randtest_special(m, state, 1 + n_randint(state, 2000), 10);
arf_randtest_special(r, state, 1 + n_randint(state, 2000), 10);
/* c = a plus error bounds */
arb_set(c, a);
arf_set(arb_midref(b), m);
arf_get_mag(arb_radref(b), r);
arb_add_error(c, b);
/* b = a + random point */
arb_set(b, a);
if (n_randint(state, 2))
arf_add(arb_midref(b), arb_midref(b), m, ARF_PREC_EXACT, ARF_RND_DOWN);
else
arf_sub(arb_midref(b), arb_midref(b), m, ARF_PREC_EXACT, ARF_RND_DOWN);
if (n_randint(state, 2))
arf_add(arb_midref(b), arb_midref(b), r, ARF_PREC_EXACT, ARF_RND_DOWN);
else
arf_sub(arb_midref(b), arb_midref(b), r, ARF_PREC_EXACT, ARF_RND_DOWN);
/* should this be done differently? */
if (arf_is_nan(arb_midref(b)))
arf_zero(arb_midref(b));
if (!arb_contains(c, b))
{
printf("FAIL (arb_add_error)\n\n");
printf("a = "); arb_printn(a, 50, 0); printf("\n\n");
printf("b = "); arb_printn(b, 50, 0); printf("\n\n");
printf("c = "); arb_printn(c, 50, 0); printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
arf_clear(m);
arf_clear(r);
}
for (iter = 0; iter < 10000; iter++)
{
arb_t a, b, c;
arf_t m;
arb_init(a);
arb_init(b);
arb_init(c);
arf_init(m);
arb_randtest_special(a, state, 1 + n_randint(state, 2000), 10);
arb_randtest_special(b, state, 1 + n_randint(state, 2000), 10);
arb_randtest_special(c, state, 1 + n_randint(state, 2000), 10);
arf_randtest_special(m, state, 1 + n_randint(state, 2000), 10);
/* c = a plus error bounds */
arb_set(c, a);
arb_add_error_arf(c, m);
/* b = a + random point */
arb_set(b, a);
if (n_randint(state, 2))
arf_add(arb_midref(b), arb_midref(b), m, ARF_PREC_EXACT, ARF_RND_DOWN);
else
arf_sub(arb_midref(b), arb_midref(b), m, ARF_PREC_EXACT, ARF_RND_DOWN);
/* should this be done differently? */
if (arf_is_nan(arb_midref(b)))
arf_zero(arb_midref(b));
if (!arb_contains(c, b))
{
printf("FAIL (arb_add_error_arf)\n\n");
printf("a = "); arb_printn(a, 50, 0); printf("\n\n");
printf("b = "); arb_printn(b, 50, 0); printf("\n\n");
printf("c = "); arb_printn(c, 50, 0); printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
arf_clear(m);
}
for (iter = 0; iter < 10000; iter++)
{
arb_t a, b, c;
arf_t t;
mag_t r;
arb_init(a);
arb_init(b);
arb_init(c);
mag_init(r);
arf_init(t);
arb_randtest_special(a, state, 1 + n_randint(state, 2000), 10);
arb_randtest_special(b, state, 1 + n_randint(state, 2000), 10);
mag_randtest(r, state, 10);
/* c = a plus error bounds */
arb_set(c, a);
arb_add_error_mag(c, r);
/* b = a + random point */
arb_set(b, a);
arf_set_mag(t, r);
if (n_randint(state, 2))
arf_add(arb_midref(b), arb_midref(b), t, ARF_PREC_EXACT, ARF_RND_DOWN);
else
arf_sub(arb_midref(b), arb_midref(b), t, ARF_PREC_EXACT, ARF_RND_DOWN);
/* should this be done differently? */
if (arf_is_nan(arb_midref(b)))
arf_zero(arb_midref(b));
if (!arb_contains(c, b))
{
printf("FAIL (arb_add_error_mag)\n\n");
printf("a = "); arb_printn(a, 50, 0); printf("\n\n");
printf("b = "); arb_printn(b, 50, 0); printf("\n\n");
printf("c = "); arb_printn(c, 50, 0); printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
mag_clear(r);
arf_clear(t);
}
for (iter = 0; iter < 10000; iter++)
{
arb_t a, b, c;
arf_t t;
long e;
arb_init(a);
arb_init(b);
arb_init(c);
arf_init(t);
arb_randtest_special(a, state, 1 + n_randint(state, 2000), 10);
arb_randtest_special(b, state, 1 + n_randint(state, 2000), 10);
e = n_randint(state, 10) - 10;
/* c = a plus error bounds */
arb_set(c, a);
arb_add_error_2exp_si(c, e);
/* b = a + random point */
arb_set(b, a);
arf_one(t);
arf_mul_2exp_si(t, t, e);
if (n_randint(state, 2))
arf_add(arb_midref(b), arb_midref(b), t, ARF_PREC_EXACT, ARF_RND_DOWN);
else
arf_sub(arb_midref(b), arb_midref(b), t, ARF_PREC_EXACT, ARF_RND_DOWN);
/* should this be done differently? */
if (arf_is_nan(arb_midref(b)))
arf_zero(arb_midref(b));
if (!arb_contains(c, b))
{
printf("FAIL (arb_add_error_2exp_si)\n\n");
printf("a = "); arb_printn(a, 50, 0); printf("\n\n");
printf("b = "); arb_printn(b, 50, 0); printf("\n\n");
printf("c = "); arb_printn(c, 50, 0); printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
arf_clear(t);
}
for (iter = 0; iter < 10000; iter++)
{
arb_t a, b, c;
arf_t t;
fmpz_t e;
arb_init(a);
arb_init(b);
arb_init(c);
arf_init(t);
fmpz_init(e);
arb_randtest_special(a, state, 1 + n_randint(state, 2000), 10);
arb_randtest_special(b, state, 1 + n_randint(state, 2000), 10);
fmpz_randtest(e, state, 10);
/* c = a plus error bounds */
arb_set(c, a);
arb_add_error_2exp_fmpz(c, e);
/* b = a + random point */
arb_set(b, a);
arf_one(t);
arf_mul_2exp_fmpz(t, t, e);
if (n_randint(state, 2))
arf_add(arb_midref(b), arb_midref(b), t, ARF_PREC_EXACT, ARF_RND_DOWN);
else
arf_sub(arb_midref(b), arb_midref(b), t, ARF_PREC_EXACT, ARF_RND_DOWN);
/* should this be done differently? */
if (arf_is_nan(arb_midref(b)))
arf_zero(arb_midref(b));
if (!arb_contains(c, b))
{
printf("FAIL (arb_add_error_2exp_fmpz)\n\n");
printf("a = "); arb_printn(a, 50, 0); printf("\n\n");
printf("b = "); arb_printn(b, 50, 0); printf("\n\n");
printf("c = "); arb_printn(c, 50, 0); printf("\n\n");
abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
arf_clear(t);
fmpz_clear(e);
}
flint_randclear(state);
flint_cleanup();
printf("PASS\n");
return EXIT_SUCCESS;
}
int
arf_root(arf_ptr z, arf_srcptr x, ulong k, slong prec, arf_rnd_t rnd)
{
mp_size_t xn, zn, val;
mp_srcptr xptr;
mp_ptr tmp, zptr;
mpfr_t xf, zf;
fmpz_t q, r;
int inexact;
if (k == 0)
{
arf_nan(z);
return 0;
}
if (k == 1)
return arf_set_round(z, x, prec, rnd);
if (k == 2)
return arf_sqrt(z, x, prec, rnd);
if (arf_is_special(x))
{
if (arf_is_neg_inf(x))
arf_nan(z);
else
arf_set(z, x);
return 0;
}
if (ARF_SGNBIT(x))
{
arf_nan(z);
return 0;
}
fmpz_init(q);
fmpz_init(r);
/* x = m * 2^e where e = qk + r */
/* x^(1/k) = (m * 2^(qk+r))^(1/k) */
/* x^(1/k) = (m * 2^r)^(1/k) * 2^q */
fmpz_set_ui(r, k);
fmpz_fdiv_qr(q, r, ARF_EXPREF(x), r);
ARF_GET_MPN_READONLY(xptr, xn, x);
zn = (prec + FLINT_BITS - 1) / FLINT_BITS;
zf->_mpfr_d = tmp = flint_malloc(zn * sizeof(mp_limb_t));
zf->_mpfr_prec = prec;
zf->_mpfr_sign = 1;
zf->_mpfr_exp = 0;
xf->_mpfr_d = (mp_ptr) xptr;
xf->_mpfr_prec = xn * FLINT_BITS;
xf->_mpfr_sign = 1;
xf->_mpfr_exp = fmpz_get_ui(r);
inexact = mpfr_root(zf, xf, k, arf_rnd_to_mpfr(rnd));
inexact = (inexact != 0);
val = 0;
while (tmp[val] == 0)
val++;
ARF_GET_MPN_WRITE(zptr, zn - val, z);
flint_mpn_copyi(zptr, tmp + val, zn - val);
fmpz_add_si(ARF_EXPREF(z), q, zf->_mpfr_exp);
flint_free(tmp);
fmpz_clear(q);
fmpz_clear(r);
return inexact;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("set_round....");
fflush(stdout);
flint_randinit(state);
{
arf_t x, y, z;
arf_init(x);
arf_init(y);
arf_init(z);
for (iter = 0; iter < 100000 * arb_test_multiplier(); iter++)
{
slong bits1, bits2;
int ret1, ret2;
mpfr_t g1, g2;
fmpz_t e;
arf_rnd_t rnd;
bits1 = 1 + n_randint(state, 1000);
bits2 = 2 + n_randint(state, 1000);
if (n_randint(state, 100) == 0)
bits2 = ARF_PREC_EXACT;
switch (n_randint(state, 5))
{
case 0: rnd = ARF_RND_DOWN; break;
case 1: rnd = ARF_RND_UP; break;
case 2: rnd = ARF_RND_FLOOR; break;
case 3: rnd = ARF_RND_CEIL; break;
default: rnd = ARF_RND_NEAR; break;
}
fmpz_init(e);
mpfr_init2(g1, FLINT_MAX(2, bits1));
mpfr_init2(g2, FLINT_MIN(bits2, 10000));
if (n_randint(state, 100) == 0)
{
arf_clear(x); arf_clear(y); arf_clear(z);
arf_init(x); arf_init(y); arf_init(z);
}
/* dirty output variables */
if (n_randint(state, 2))
{
arf_randtest_special(y, state, 1 + n_randint(state, 1000),
1 + n_randint(state, 100));
arf_randtest_special(z, state, 1 + n_randint(state, 1000),
1 + n_randint(state, 100));
}
arf_randtest_special(x, state, bits1, 1 + n_randint(state, 10));
arf_get_mpfr(g1, x, MPFR_RNDD); /* exact */
/* test large exponents */
if (n_randint(state, 4) == 0)
fmpz_randtest(e, state, 1 + n_randint(state, 100));
if (!arf_is_special(x))
fmpz_add(ARF_EXPREF(x), ARF_EXPREF(x), e);
ret1 = arf_set_round(y, x, bits2, rnd);
ret2 = mpfr_set(g2, g1, arf_rnd_to_mpfr(rnd));
arf_set_mpfr(z, g2);
if (!arf_is_special(y))
fmpz_sub(ARF_EXPREF(y), ARF_EXPREF(y), e);
if (!arf_equal(y, z) || ((ret1 == ARF_RESULT_EXACT) != (ret2 == 0)))
{
flint_printf("FAIL\n\n");
flint_printf("bits1: %wd\n", bits1);
flint_printf("bits2: %wd\n", bits2);
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("y = "); arf_print(y); flint_printf("\n\n");
flint_printf("z = "); arf_print(z); flint_printf("\n\n");
flint_printf("ret1 = %d, ret2 = %d\n\n", ret1, ret2);
flint_abort();
}
if (!arf_is_special(x))
fmpz_add(ARF_EXPREF(x), ARF_EXPREF(x), e);
ret1 = arf_set_round(y, x, bits2, rnd);
arf_set(z, x);
ret2 = arf_set_round(z, z, bits2, rnd);
if (!arf_equal(y, z) || ret1 != ret2)
{
flint_printf("FAIL (aliasing)\n\n");
flint_printf("bits1: %wd\n", bits1);
flint_printf("bits2: %wd\n", bits2);
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("y = "); arf_print(y); flint_printf("\n\n");
flint_printf("z = "); arf_print(z); flint_printf("\n\n");
flint_printf("ret1 = %d, ret2 = %d\n\n", ret1, ret2);
flint_abort();
}
mpfr_clear(g1);
mpfr_clear(g2);
fmpz_clear(e);
}
arf_clear(x);
arf_clear(y);
arf_clear(z);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("rel_accuracy_bits....");
fflush(stdout);
flint_randinit(state);
/* test aliasing of c and a */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t x;
acb_t z;
slong a1, a2;
arb_init(x);
acb_init(z);
arb_randtest_special(x, state, 1 + n_randint(state, 200), 1 + n_randint(state, 200));
acb_set_arb(z, x);
a1 = arb_rel_accuracy_bits(x);
a2 = acb_rel_accuracy_bits(z);
if (a1 != a2)
{
flint_printf("FAIL: acb != arb\n\n");
flint_printf("x = "); arb_print(x); flint_printf("\n\n");
flint_printf("z = "); acb_print(z); flint_printf("\n\n");
flint_printf("a1 = %wd, a2 = %wd\n\n", a1, a2);
abort();
}
acb_randtest_special(z, state, 1 + n_randint(state, 200), 1 + n_randint(state, 200));
a1 = acb_rel_accuracy_bits(z);
if (n_randint(state, 2))
arf_swap(arb_midref(acb_realref(z)), arb_midref(acb_imagref(z)));
if (n_randint(state, 2))
mag_swap(arb_radref(acb_realref(z)), arb_radref(acb_imagref(z)));
a2 = acb_rel_accuracy_bits(z);
if (a1 != a2)
{
flint_printf("FAIL: swapping\n\n");
flint_printf("z = "); acb_print(z); flint_printf("\n\n");
flint_printf("a1 = %wd, a2 = %wd\n\n", a1, a2);
abort();
}
acb_randtest_special(z, state, 1 + n_randint(state, 200), 1 + n_randint(state, 200));
if (arf_cmpabs(arb_midref(acb_realref(z)), arb_midref(acb_imagref(z))) >= 0)
arf_set(arb_midref(x), arb_midref(acb_realref(z)));
else
arf_set(arb_midref(x), arb_midref(acb_imagref(z)));
if (mag_cmp(arb_radref(acb_realref(z)), arb_radref(acb_imagref(z))) >= 0)
mag_set(arb_radref(x), arb_radref(acb_realref(z)));
else
mag_set(arb_radref(x), arb_radref(acb_imagref(z)));
a1 = acb_rel_accuracy_bits(z);
a2 = arb_rel_accuracy_bits(x);
if (a1 != a2)
{
flint_printf("FAIL: acb != arb (2)\n\n");
flint_printf("x = "); arb_print(x); flint_printf("\n\n");
flint_printf("z = "); acb_print(z); flint_printf("\n\n");
flint_printf("a1 = %wd, a2 = %wd\n\n", a1, a2);
abort();
}
arb_clear(x);
acb_clear(z);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("floor....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000; iter++)
{
arf_t x, y;
int result;
arf_init(x);
arf_init(y);
arf_randtest_special(x, state, 2000, 100);
arf_randtest_special(y, state, 2000, 100);
arf_floor(y, x);
result = 1;
if (arf_is_int(x) || !arf_is_finite(x))
{
result = arf_equal(y, x);
}
else if (!arf_is_int(y))
{
result = 0;
}
else if (arf_cmp(y, x) >= 0)
{
result = 0;
}
else
{
arf_t s, t[3];
/* check floor(x) - x + 1 > 0 */
arf_init(s);
arf_init(t[0]);
arf_init(t[1]);
arf_init(t[2]);
arf_set(t[0], y);
arf_neg(t[1], x);
arf_one(t[2]);
arf_sum(s, (arf_ptr) t, 3, 32, ARF_RND_DOWN);
result = arf_sgn(s) > 0;
arf_clear(s);
arf_clear(t[0]);
arf_clear(t[1]);
arf_clear(t[2]);
}
if (!result)
{
flint_printf("FAIL!\n");
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("y = "); arf_print(y); flint_printf("\n\n");
abort();
}
arf_floor(x, x);
if (!arf_equal(x, y))
{
flint_printf("FAIL (aliasing)!\n");
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("y = "); arf_print(y); flint_printf("\n\n");
abort();
}
arf_clear(x);
arf_clear(y);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
void
arb_set(arb_t x, const arb_t y)
{
arf_set(arb_midref(x), arb_midref(y));
mag_set(arb_radref(x), arb_radref(y));
}
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
}
int
acb_calc_integrate_taylor(acb_t res,
acb_calc_func_t func, void * param,
const acb_t a, const acb_t b,
const arf_t inner_radius,
const arf_t outer_radius,
long accuracy_goal, long prec)
{
long num_steps, step, N, bp;
int result;
acb_t delta, m, x, y1, y2, sum;
acb_ptr taylor_poly;
arf_t err;
acb_init(delta);
acb_init(m);
acb_init(x);
acb_init(y1);
acb_init(y2);
acb_init(sum);
arf_init(err);
acb_sub(delta, b, a, prec);
/* precision used for bounds calculations */
bp = MAG_BITS;
/* compute the number of steps */
{
arf_t t;
arf_init(t);
acb_get_abs_ubound_arf(t, delta, bp);
arf_div(t, t, inner_radius, bp, ARF_RND_UP);
arf_mul_2exp_si(t, t, -1);
num_steps = (long) (arf_get_d(t, ARF_RND_UP) + 1.0);
/* make sure it's not something absurd */
num_steps = FLINT_MIN(num_steps, 10 * prec);
num_steps = FLINT_MAX(num_steps, 1);
arf_clear(t);
}
result = ARB_CALC_SUCCESS;
acb_zero(sum);
for (step = 0; step < num_steps; step++)
{
/* midpoint of subinterval */
acb_mul_ui(m, delta, 2 * step + 1, prec);
acb_div_ui(m, m, 2 * num_steps, prec);
acb_add(m, m, a, prec);
if (arb_calc_verbose)
{
printf("integration point %ld/%ld: ", 2 * step + 1, 2 * num_steps);
acb_printd(m, 15); printf("\n");
}
/* evaluate at +/- x */
/* TODO: exactify m, and include error in x? */
acb_div_ui(x, delta, 2 * num_steps, prec);
/* compute bounds and number of terms to use */
{
arb_t cbound, xbound, rbound;
arf_t C, D, R, X, T;
double DD, TT, NN;
arb_init(cbound);
arb_init(xbound);
arb_init(rbound);
arf_init(C);
arf_init(D);
arf_init(R);
arf_init(X);
arf_init(T);
/* R is the outer radius */
arf_set(R, outer_radius);
/* X = upper bound for |x| */
acb_get_abs_ubound_arf(X, x, bp);
arb_set_arf(xbound, X);
/* Compute C(m,R). Important subtlety: due to rounding when
computing m, we will in general be farther than R away from
the integration path. But since acb_calc_cauchy_bound
actually integrates over the area traced by a complex
interval, it will catch any extra singularities (giving
an infinite bound). */
arb_set_arf(rbound, outer_radius);
acb_calc_cauchy_bound(cbound, func, param, m, rbound, 8, bp);
arf_set_mag(C, arb_radref(cbound));
arf_add(C, arb_midref(cbound), C, bp, ARF_RND_UP);
/* Sanity check: we need C < inf and R > X */
if (arf_is_finite(C) && arf_cmp(R, X) > 0)
{
/* Compute upper bound for D = C * R * X / (R - X) */
arf_mul(D, C, R, bp, ARF_RND_UP);
arf_mul(D, D, X, bp, ARF_RND_UP);
arf_sub(T, R, X, bp, ARF_RND_DOWN);
arf_div(D, D, T, bp, ARF_RND_UP);
/* Compute upper bound for T = (X / R) */
arf_div(T, X, R, bp, ARF_RND_UP);
/* Choose N */
/* TODO: use arf arithmetic to avoid overflow */
/* TODO: use relative accuracy (look at |f(m)|?) */
DD = arf_get_d(D, ARF_RND_UP);
TT = arf_get_d(T, ARF_RND_UP);
NN = -(accuracy_goal * 0.69314718055994530942 + log(DD)) / log(TT);
N = NN + 0.5;
N = FLINT_MIN(N, 100 * prec);
N = FLINT_MAX(N, 1);
/* Tail bound: D / (N + 1) * T^N */
{
mag_t TT;
mag_init(TT);
arf_get_mag(TT, T);
mag_pow_ui(TT, TT, N);
arf_set_mag(T, TT);
mag_clear(TT);
}
arf_mul(D, D, T, bp, ARF_RND_UP);
arf_div_ui(err, D, N + 1, bp, ARF_RND_UP);
}
else
{
N = 1;
arf_pos_inf(err);
result = ARB_CALC_NO_CONVERGENCE;
}
if (arb_calc_verbose)
{
printf("N = %ld; bound: ", N); arf_printd(err, 15); printf("\n");
printf("R: "); arf_printd(R, 15); printf("\n");
printf("C: "); arf_printd(C, 15); printf("\n");
printf("X: "); arf_printd(X, 15); printf("\n");
}
arb_clear(cbound);
arb_clear(xbound);
arb_clear(rbound);
arf_clear(C);
arf_clear(D);
arf_clear(R);
arf_clear(X);
arf_clear(T);
}
/* evaluate Taylor polynomial */
taylor_poly = _acb_vec_init(N + 1);
func(taylor_poly, m, param, N, prec);
_acb_poly_integral(taylor_poly, taylor_poly, N + 1, prec);
_acb_poly_evaluate(y2, taylor_poly, N + 1, x, prec);
acb_neg(x, x);
_acb_poly_evaluate(y1, taylor_poly, N + 1, x, prec);
acb_neg(x, x);
/* add truncation error */
arb_add_error_arf(acb_realref(y1), err);
arb_add_error_arf(acb_imagref(y1), err);
arb_add_error_arf(acb_realref(y2), err);
arb_add_error_arf(acb_imagref(y2), err);
acb_add(sum, sum, y2, prec);
acb_sub(sum, sum, y1, prec);
if (arb_calc_verbose)
{
printf("values: ");
acb_printd(y1, 15); printf(" ");
acb_printd(y2, 15); printf("\n");
}
_acb_vec_clear(taylor_poly, N + 1);
if (result == ARB_CALC_NO_CONVERGENCE)
break;
}
acb_set(res, sum);
acb_clear(delta);
acb_clear(m);
acb_clear(x);
acb_clear(y1);
acb_clear(y2);
acb_clear(sum);
arf_clear(err);
return result;
}
