void
arb_sech(arb_t res, const arb_t x, slong prec)
{
if (arf_cmpabs_2exp_si(arb_midref(x), 0) > 0)
{
arb_t t;
arb_init(t);
if (arf_sgn(arb_midref(x)) > 0)
{
arb_neg(t, x);
arb_exp(t, t, prec + 4);
}
else
{
arb_exp(t, x, prec + 4);
}
arb_mul(res, t, t, prec + 4);
arb_add_ui(res, res, 1, prec + 4);
arb_div(res, t, res, prec);
arb_mul_2exp_si(res, res, 1);
arb_clear(t);
}
else
{
arb_cosh(res, x, prec + 4);
arb_inv(res, res, prec);
}
}
void
acb_dirichlet_theta_arb(acb_t res, const dirichlet_group_t G, const dirichlet_char_t chi, const arb_t t, slong prec)
{
slong len;
ulong order;
arb_t xt;
mag_t e;
len = acb_dirichlet_theta_length(G->q, t, prec);
arb_init(xt);
_acb_dirichlet_theta_argument_at_arb(xt, G->q, t, prec);
mag_init(e);
mag_tail_kexpk2_arb(e, xt, len);
arb_neg(xt, xt);
arb_exp(xt, xt, prec);
/* TODO: tune this limit */
order = dirichlet_order_char(G, chi);
if (order < 30)
_acb_dirichlet_theta_arb_smallorder(res, G, chi, xt, len, prec);
else
_acb_dirichlet_theta_arb_naive(res, G, chi, xt, len, prec);
arb_add_error_mag(acb_realref(res), e);
arb_add_error_mag(acb_imagref(res), e);
mag_clear(e);
acb_mul_2exp_si(res, res, 1);
arb_clear(xt);
}
void
arb_root_ui_exp(arb_t res, const arb_t x, ulong k, slong prec)
{
arb_log(res, x, prec + 4);
arb_div_ui(res, res, k, prec + 4);
arb_exp(res, res, prec);
}
void
_arb_pow_exp(arb_t z, const arb_t x, int negx, const arb_t y, long prec)
{
arb_t t;
arb_init(t);
if (negx)
{
arb_neg(t, x);
arb_log(t, t, prec);
}
else
arb_log(t, x, prec);
arb_mul(t, t, y, prec);
arb_exp(z, t, prec);
arb_clear(t);
}
/* 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);
}
/* series of c^(d+x) */
static __inline__ void
_arb_poly_pow_cpx(arb_ptr res, const arb_t c, const arb_t d, long trunc, long prec)
{
long i;
arb_t logc;
arb_init(logc);
arb_log(logc, c, prec);
arb_mul(res + 0, logc, d, prec);
arb_exp(res + 0, res + 0, prec);
for (i = 1; i < trunc; i++)
{
arb_mul(res + i, res + i - 1, logc, prec);
arb_div_ui(res + i, res + i, i, prec);
}
arb_clear(logc);
}
void
acb_dirichlet_vec_mellin_arb(acb_ptr res, const dirichlet_group_t G, const dirichlet_char_t chi, slong len, const arb_t t, slong n, slong prec)
{
slong k;
arb_t tk, xt, stk, st;
acb_ptr a;
mag_t e;
a = _acb_vec_init(len);
acb_dirichlet_chi_vec(a, G, chi, len, prec);
if (dirichlet_parity_char(G, chi))
{
for (k = 2; k < len; k++)
acb_mul_si(a + k, a + k, k, prec);
}
arb_init(tk);
arb_init(xt);
arb_init(st);
arb_init(stk);
mag_init(e);
arb_sqrt(st, t, prec);
arb_one(tk);
arb_one(stk);
for (k = 0; k < n; k++)
{
_acb_dirichlet_theta_argument_at_arb(xt, G->q, tk, prec);
mag_tail_kexpk2_arb(e, xt, len);
arb_neg(xt, xt);
arb_exp(xt, xt, prec);
/* TODO: reduce len */
acb_dirichlet_qseries_arb(res + k, a, xt, len, prec);
acb_add_error_mag(res + k, e);
acb_mul_arb(res + k, res + k, stk, prec);
arb_mul(tk, tk, t, prec);
arb_mul(stk, stk, st, prec);
}
mag_clear(e);
arb_clear(xt);
arb_clear(tk);
arb_clear(stk);
arb_clear(st);
_acb_vec_clear(a, len);
}
static void
bound_K(arb_t C, const arb_t AN, const arb_t B, const arb_t T, slong wp)
{
if (arb_is_zero(B) || arb_is_zero(T))
{
arb_one(C);
}
else
{
arb_div(C, B, AN, wp);
/* TODO: atan is dumb, should also bound by pi/2 */
arb_atan(C, C, wp);
arb_mul(C, C, T, wp);
if (arb_is_nonpositive(C))
arb_one(C);
else
arb_exp(C, C, wp);
}
}
void
arb_pow_fmpq(arb_t y, const arb_t x, const fmpq_t a, long prec)
{
if (fmpz_is_one(fmpq_denref(a)))
{
arb_pow_fmpz(y, x, fmpq_numref(a), prec);
}
else if (fmpz_cmp_ui(fmpq_denref(a), 36) <= 0)
{
arb_root(y, x, *fmpq_denref(a), prec);
arb_pow_fmpz(y, y, fmpq_numref(a), prec);
}
else
{
long wp;
wp = prec + 10;
arb_log(y, x, wp);
arb_mul_fmpz(y, y, fmpq_numref(a), wp);
arb_div_fmpz(y, y, fmpq_denref(a), wp);
arb_exp(y, y, prec);
}
}
/* 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
_arb_poly_exp_series(arb_ptr f, arb_srcptr h, slong hlen, slong n, slong prec)
{
hlen = FLINT_MIN(hlen, n);
if (hlen == 1)
{
arb_exp(f, h, prec);
_arb_vec_zero(f + 1, n - 1);
}
else if (n == 2)
{
arb_exp(f, h, prec);
arb_mul(f + 1, f, h + 1, prec); /* safe since hlen >= 2 */
}
else if (_arb_vec_is_zero(h + 1, hlen - 2)) /* h = a + bx^d */
{
slong i, j, d = hlen - 1;
arb_t t;
arb_init(t);
arb_set(t, h + d);
arb_exp(f, h, prec);
for (i = 1, j = d; j < n; j += d, i++)
{
arb_mul(f + j, f + j - d, t, prec);
arb_div_ui(f + j, f + j, i, prec);
_arb_vec_zero(f + j - d + 1, hlen - 2);
}
_arb_vec_zero(f + j - d + 1, n - (j - d + 1));
arb_clear(t);
}
else if (hlen <= arb_poly_newton_exp_cutoff)
{
_arb_poly_exp_series_basecase(f, h, hlen, n, prec);
}
else
{
arb_ptr g, t;
arb_t u;
int fix;
g = _arb_vec_init((n + 1) / 2);
fix = (hlen < n || h == f || !arb_is_zero(h));
if (fix)
{
t = _arb_vec_init(n);
_arb_vec_set(t + 1, h + 1, hlen - 1);
}
else
t = (arb_ptr) h;
arb_init(u);
arb_exp(u, h, prec);
_arb_poly_exp_series_newton(f, g, t, n, prec, 0, arb_poly_newton_exp_cutoff);
if (!arb_is_one(u))
_arb_vec_scalar_mul(f, f, n, u, prec);
_arb_vec_clear(g, (n + 1) / 2);
if (fix)
_arb_vec_clear(t, n);
arb_clear(u);
}
}
void
arb_mat_exp(arb_mat_t B, const arb_mat_t A, slong prec)
{
slong i, j, dim, wp, N, q, r;
mag_t norm, err;
arb_mat_t T;
dim = arb_mat_nrows(A);
if (dim != arb_mat_ncols(A))
{
flint_printf("arb_mat_exp: a square matrix is required!\n");
abort();
}
if (dim == 0)
{
return;
}
else if (dim == 1)
{
arb_exp(arb_mat_entry(B, 0, 0), arb_mat_entry(A, 0, 0), prec);
return;
}
wp = prec + 3 * FLINT_BIT_COUNT(prec);
mag_init(norm);
mag_init(err);
arb_mat_init(T, dim, dim);
arb_mat_bound_inf_norm(norm, A);
if (mag_is_zero(norm))
{
arb_mat_one(B);
}
else
{
q = pow(wp, 0.25); /* wanted magnitude */
if (mag_cmp_2exp_si(norm, 2 * wp) > 0) /* too big */
r = 2 * wp;
else if (mag_cmp_2exp_si(norm, -q) < 0) /* tiny, no need to reduce */
r = 0;
else
r = FLINT_MAX(0, q + MAG_EXP(norm)); /* reduce to magnitude 2^(-r) */
arb_mat_scalar_mul_2exp_si(T, A, -r);
mag_mul_2exp_si(norm, norm, -r);
N = _arb_mat_exp_choose_N(norm, wp);
mag_exp_tail(err, norm, N);
_arb_mat_exp_taylor(B, T, N, wp);
for (i = 0; i < dim; i++)
for (j = 0; j < dim; j++)
arb_add_error_mag(arb_mat_entry(B, i, j), err);
for (i = 0; i < r; i++)
{
arb_mat_mul(T, B, B, wp);
arb_mat_swap(T, B);
}
for (i = 0; i < dim; i++)
for (j = 0; j < dim; j++)
arb_set_round(arb_mat_entry(B, i, j),
arb_mat_entry(B, i, j), prec);
}
mag_clear(norm);
mag_clear(err);
arb_mat_clear(T);
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("exp....");
fflush(stdout);
flint_randinit(state);
/* check large arguments + compare with exp_simple */
for (iter = 0; iter < 100000 *arb_test_multiplier(); iter++)
{
arb_t a, b, c, d;
slong prec0, prec1, prec2, acc1, acc2;
if (iter % 10 == 0)
prec0 = 10000;
else
prec0 = 1000;
prec1 = 2 + n_randint(state, prec0);
prec2 = 2 + n_randint(state, prec0);
arb_init(a);
arb_init(b);
arb_init(c);
arb_init(d);
arb_randtest_special(a, state, 1 + n_randint(state, prec0), 100);
arb_randtest_special(b, state, 1 + n_randint(state, prec0), 100);
arb_exp(b, a, prec1);
arb_exp(c, a, prec2);
arb_exp_simple(d, a, prec1);
if (!arb_overlaps(b, c) || !arb_overlaps(b, d) || !arb_overlaps(c, d))
{
flint_printf("FAIL: overlap\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_printf("c = "); arb_print(c); flint_printf("\n\n");
flint_printf("d = "); arb_print(d); flint_printf("\n\n");
flint_abort();
}
/* compare accuracy with exp_simple */
acc1 = arb_rel_accuracy_bits(b);
acc2 = arb_rel_accuracy_bits(d);
if (acc2 > 0 && acc1 < acc2 - 1)
{
flint_printf("FAIL: accuracy\n\n");
flint_printf("prec1 = %wd, acc1 = %wd, acc2 = %wd\n\n", prec1, acc1, acc2);
flint_printf("a = "); arb_printd(a, 50); flint_printf("\n\n");
flint_printf("b = "); arb_printd(b, 50); flint_printf("\n\n");
flint_printf("d = "); arb_printd(d, 50); flint_printf("\n\n");
flint_abort();
}
arb_randtest_special(b, state, 1 + n_randint(state, prec0), 100);
/* check exp(a)*exp(b) = exp(a+b) */
arb_exp(c, a, prec1);
arb_exp(d, b, prec1);
arb_mul(c, c, d, prec1);
arb_add(d, a, b, prec1);
arb_exp(d, d, prec1);
if (!arb_overlaps(c, d))
{
flint_printf("FAIL: functional equation\n\n");
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_printf("c = "); arb_print(c); flint_printf("\n\n");
flint_printf("d = "); arb_print(d); flint_printf("\n\n");
flint_abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
arb_clear(d);
}
/* test union */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t a, b, c, d, e;
slong prec0, prec1, prec2, prec3, prec4;
if (iter % 10 == 0)
prec0 = 10000;
else
prec0 = 1000;
prec1 = 2 + n_randint(state, prec0);
prec2 = 2 + n_randint(state, prec0);
prec3 = 2 + n_randint(state, prec0);
prec4 = 2 + n_randint(state, prec0);
arb_init(a);
arb_init(b);
arb_init(c);
arb_init(d);
arb_init(e);
arb_randtest_special(a, state, 1 + n_randint(state, prec0), 200);
arb_randtest_special(b, state, 1 + n_randint(state, prec0), 200);
arb_randtest_special(c, state, 1 + n_randint(state, prec0), 200);
arb_randtest_special(d, state, 1 + n_randint(state, prec0), 200);
arb_randtest_special(e, state, 1 + n_randint(state, prec0), 200);
arb_exp(c, a, prec1);
arb_exp(d, b, prec2);
arb_union(e, a, b, prec3);
arb_exp(e, e, prec4);
if (!arb_overlaps(e, c) || !arb_overlaps(e, d))
{
flint_printf("FAIL: union\n\n");
flint_printf("a = "); arb_printn(a, 1000, 0); flint_printf("\n\n");
flint_printf("b = "); arb_printn(b, 1000, 0); flint_printf("\n\n");
flint_printf("c = "); arb_printn(c, 1000, 0); flint_printf("\n\n");
flint_printf("d = "); arb_printn(d, 1000, 0); flint_printf("\n\n");
flint_printf("e = "); arb_printn(e, 1000, 0); flint_printf("\n\n");
flint_abort();
}
arb_clear(a);
arb_clear(b);
arb_clear(c);
arb_clear(d);
arb_clear(e);
}
/* comparison with mpfr */
for (iter = 0; iter < 100000 * arb_test_multiplier(); iter++)
{
arb_t a, b;
fmpq_t q;
mpfr_t t;
slong prec0, prec;
prec0 = 400;
if (iter % 100 == 0)
prec0 = 10000;
prec = 2 + n_randint(state, prec0);
arb_init(a);
arb_init(b);
fmpq_init(q);
mpfr_init2(t, prec + 100);
arb_randtest(a, state, 1 + n_randint(state, prec0), 4);
arb_randtest(b, state, 1 + n_randint(state, prec0), 4);
arb_get_rand_fmpq(q, state, a, 1 + n_randint(state, prec0));
fmpq_get_mpfr(t, q, MPFR_RNDN);
mpfr_exp(t, t, MPFR_RNDN);
arb_exp(b, a, prec);
if (!arb_contains_mpfr(b, t))
{
flint_printf("FAIL: containment\n\n");
flint_printf("iter = %wd, prec = %wd\n\n", iter, prec);
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_abort();
}
arb_exp(a, a, prec);
if (!arb_equal(a, b))
{
flint_printf("FAIL: aliasing\n\n");
flint_printf("iter = %wd, prec = %wd\n\n", iter, prec);
flint_printf("a = "); arb_print(a); flint_printf("\n\n");
flint_printf("b = "); arb_print(b); flint_printf("\n\n");
flint_abort();
}
arb_clear(a);
arb_clear(b);
fmpq_clear(q);
mpfr_clear(t);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
