/* Copyright (C) 2015 Fredrik Johansson This file is part of Arb. Arb is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License (LGPL) as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. See . */ #include "acb_hypgeom.h" void acb_hypgeom_mag_chi(mag_t chi, ulong n); static int arg_lt_2pi3(const acb_t z, const acb_t zeta) { if (arb_is_nonnegative(acb_realref(z))) return 1; if (arb_is_positive(acb_imagref(z)) && arb_is_positive(acb_imagref(zeta))) return 1; if (arb_is_negative(acb_imagref(z)) && arb_is_negative(acb_imagref(zeta))) return 1; return 0; } /* assuming a >= b >= c >= d, e >= f */ void _acb_mul4div2_ui(acb_t x, ulong a, ulong b, ulong c, ulong d, ulong e, ulong f, slong prec) { if (a < (UWORD(1) << (FLINT_BITS / 4))) { acb_mul_ui(x, x, a * b * c * d, prec); } else if (a < (UWORD(1) << (FLINT_BITS / 2))) { acb_mul_ui(x, x, a * b, prec); acb_mul_ui(x, x, c * d, prec); } else { acb_mul_ui(x, x, a, prec); acb_mul_ui(x, x, b, prec); acb_mul_ui(x, x, c, prec); acb_mul_ui(x, x, d, prec); } if (e < (UWORD(1) << (FLINT_BITS / 2))) { acb_div_ui(x, x, e * f, prec); } else { acb_div_ui(x, x, e, prec); acb_div_ui(x, x, f, prec); } } void acb_hypgeom_airy_asymp_sum(acb_t s0even, acb_t s0odd, acb_t s1even, acb_t s1odd, mag_t t0n, mag_t t1n, const acb_t z, const acb_t z2, slong n, slong prec) { slong m, k, j; acb_ptr z2pow; acb_get_mag(t0n, z); mag_mul_ui(t0n, t0n, 72); mag_pow_ui(t0n, t0n, n); mag_one(t1n); for (k = 1; k <= n; k++) { mag_mul_ui(t0n, t0n, 6 * k - 1); mag_mul_ui(t0n, t0n, 6 * k - 5); mag_mul_ui_lower(t1n, t1n, 72 * k); } mag_div(t0n, t0n, t1n); mag_mul_ui(t1n, t0n, 6 * n + 1); mag_div_ui(t1n, t1n, 6 * n - 1); m = n_sqrt(n / 2); m = FLINT_MAX(m, 1); z2pow = _acb_vec_init(m + 1); _acb_vec_set_powers(z2pow, z2, m + 1, prec); if (s0even != NULL) { acb_zero(s0even); for (k = n + (n % 2); k >= 0; k -= 2) { j = (k / 2) % m; if (k < n) acb_add(s0even, s0even, z2pow + j, prec); if (k > 0) { _acb_mul4div2_ui(s0even, 6*k-1, 6*k-5, 6*k-7, 6*k-11, k, k-1, prec); if (j == 0 && k < n) acb_mul(s0even, s0even, z2pow + m, prec); } } } if (s0odd != NULL) { acb_zero(s0odd); for (k = n + 1 + (n % 2); k >= 1; k -= 2) { j = ((k - 1) / 2) % m; if (k < n) acb_add(s0odd, s0odd, z2pow + j, prec); if (k > 1) { _acb_mul4div2_ui(s0odd, 6*k-1, 6*k-5, 6*k-7, 6*k-11, k, k-1, prec); if (j == 0 && k < n) acb_mul(s0odd, s0odd, z2pow + m, prec); } else { acb_mul(s0odd, s0odd, z, prec); acb_mul_ui(s0odd, s0odd, 5, prec); } } } if (s1even != NULL) { acb_zero(s1even); for (k = n + (n % 2); k >= 0; k -= 2) { j = (k / 2) % m; if (k < n) acb_add(s1even, s1even, z2pow + j, prec); if (k > 0) { _acb_mul4div2_ui(s1even, 6*k+1, 6*k-5, 6*k-7, FLINT_ABS(6*k-13), k, k-1, prec); if (k == 2) acb_neg(s1even, s1even); if (j == 0 && k < n) acb_mul(s1even, s1even, z2pow + m, prec); } } } if (s1odd != NULL) { acb_zero(s1odd); for (k = n + 1 + (n % 2); k >= 1; k -= 2) { j = ((k - 1) / 2) % m; if (k < n) acb_add(s1odd, s1odd, z2pow + j, prec); if (k > 1) { _acb_mul4div2_ui(s1odd, 6*k+1, 6*k-5, 6*k-7, 6*k-13, k, k-1, prec); if (j == 0 && k < n) acb_mul(s1odd, s1odd, z2pow + m, prec); } else { acb_mul(s1odd, s1odd, z, prec); acb_mul_si(s1odd, s1odd, -7, prec); } } } _acb_vec_clear(z2pow, m + 1); } void acb_hypgeom_airy_asymp_bound_factor(mag_t bound, const acb_t z, const acb_t zeta, ulong n) { mag_t t, u, v; mag_init(t); mag_init(u); mag_init(v); if (arb_is_nonnegative(acb_realref(z)) && arb_is_nonnegative(acb_realref(zeta))) { /* 2 exp(7 / (36 |zeta|)) */ mag_set_ui_2exp_si(t, 50, -8); /* bound for 7/36 */ acb_get_mag_lower(u, zeta); mag_div(t, t, u); mag_exp(t, t); mag_mul_2exp_si(bound, t, 1); } else { /* 2 exp(7 pi / (72 |zeta|)) */ mag_set_ui_2exp_si(t, 79, -8); /* bound for 7 pi/72 */ acb_get_mag_lower(u, zeta); mag_div(t, t, u); mag_exp(t, t); mag_mul_2exp_si(bound, t, 1); /* 4 exp(7 pi / (36 |re(zeta)|)) / |cos(arg(zeta))|^n */ if (!arg_lt_2pi3(z, zeta)) { arb_get_mag_lower(u, acb_realref(zeta)); arb_get_mag(v, acb_imagref(zeta)); /* 4 exp(7 pi / (36 u)) < exp(157/(256 u)) */ mag_set_ui_2exp_si(t, 157, -8); mag_div(t, t, u); mag_exp(t, t); mag_mul_2exp_si(t, t, 2); /* |1/cos(arg(zeta))| = sqrt(1+(v/u)^2) */ mag_div(v, v, u); mag_mul(v, v, v); mag_one(u); mag_add(v, v, u); mag_sqrt(v, v); mag_pow_ui(v, v, n); mag_mul(t, t, v); mag_max(bound, bound, t); } /* chi(n) */ acb_hypgeom_mag_chi(t, n); mag_mul(bound, bound, t); } mag_clear(t); mag_clear(u); mag_clear(v); } void acb_hypgeom_airy_asymp(acb_t ai, acb_t aip, acb_t bi, acb_t bip, const acb_t z, slong n, slong prec) { acb_t t, u, w, z_root, zeta; acb_t s0even, s0odd, s1even, s1odd, E1, E2; mag_t err1, err2, erru, errv, errtmp; int want_d0, want_d1, is_real, upper; acb_init(t); acb_init(u); acb_init(w); acb_init(z_root); acb_init(zeta); acb_init(s0even); acb_init(s0odd); acb_init(s1even); acb_init(s1odd); acb_init(E1); acb_init(E2); mag_init(err1); mag_init(err2); mag_init(errtmp); mag_init(erru); mag_init(errv); is_real = acb_is_real(z); want_d0 = (ai != NULL) || (bi != NULL); want_d1 = (aip != NULL) || (bip != NULL); /* required for some of the error bounds to be valid */ n = FLINT_MAX(n, 1); /* this is just a heuristic; the sectors are validated later */ if (arf_sgn(arb_midref(acb_realref(z))) >= 0) { /* z_root = z^(1/4), zeta = 2 z^(3/2) / 3 */ acb_sqrt(z_root, z, prec); acb_cube(zeta, z_root, prec); acb_sqrt(z_root, z_root, prec); acb_mul_2exp_si(zeta, zeta, 1); acb_div_ui(zeta, zeta, 3, prec); /* compute bound factor for z = t = z1, zeta = u = zeta1 */ acb_hypgeom_airy_asymp_bound_factor(err1, z, zeta, n); /* this is just a heuristic; the sectors are validated later */ upper = arf_sgn(arb_midref(acb_imagref(z))) >= 0; if (upper) { /* check -pi/3 < arg(z) < pi */ if (arb_is_positive(acb_imagref(z)) || (arb_is_positive(acb_realref(z)) && arb_is_positive(acb_realref(zeta)))) { arb_one(acb_realref(w)); arb_sqrt_ui(acb_imagref(w), 3, prec); acb_mul_2exp_si(w, w, -1); acb_neg(w, w); acb_mul(t, w, z, prec); acb_neg(u, zeta); acb_hypgeom_airy_asymp_bound_factor(err2, t, u, n); } else { mag_inf(err2); } } else { /* check -pi < arg(z) < pi/3 */ if (arb_is_negative(acb_imagref(z)) || (arb_is_positive(acb_realref(z)) && arb_is_positive(acb_realref(zeta)))) { arb_set_si(acb_realref(w), -1); arb_sqrt_ui(acb_imagref(w), 3, prec); acb_mul_2exp_si(w, w, -1); acb_mul(t, w, z, prec); acb_neg(u, zeta); acb_hypgeom_airy_asymp_bound_factor(err2, t, u, n); } else { mag_inf(err2); } } acb_mul_ui(t, zeta, 72, prec); acb_inv(t, t, prec); acb_mul(u, t, t, prec); acb_hypgeom_airy_asymp_sum(want_d0 ? s0even : NULL, want_d0 ? s0odd : NULL, want_d1 ? s1even : NULL, want_d1 ? s1odd : NULL, erru, errv, t, u, n, prec); /* exponentials */ acb_exp_invexp(E2, E1, zeta, prec); /* common prefactor */ acb_const_pi(w, prec); acb_sqrt(w, w, prec); acb_mul_2exp_si(w, w, 1); if (ai != NULL || bi != NULL) { /* t = sum (-1)^k u(k) / (zeta)^k + error */ acb_sub(t, s0even, s0odd, prec); mag_mul(errtmp, err1, erru); acb_add_error_mag(t, errtmp); /* u = sum (-1)^k u(k) / (-zeta)^k = sum u(k) / (zeta)^k + error */ acb_add(u, s0even, s0odd, prec); mag_mul(errtmp, err2, erru); acb_add_error_mag(u, errtmp); if (ai != NULL) { acb_mul(ai, t, E1, prec); } if (bi != NULL) { acb_mul(t, t, E1, prec); acb_mul(u, u, E2, prec); acb_mul_2exp_si(u, u, 1); if (upper) acb_mul_onei(t, t); else acb_div_onei(t, t); acb_add(bi, t, u, prec); } acb_mul(t, w, z_root, prec); acb_inv(t, t, prec); if (ai != NULL) acb_mul(ai, ai, t, prec); if (bi != NULL) acb_mul(bi, bi, t, prec); } if (aip != NULL || bip != NULL) { /* t = sum (-1)^k v(k) / (zeta)^k + error */ acb_sub(t, s1even, s1odd, prec); mag_mul(errtmp, err1, errv); acb_add_error_mag(t, errtmp); /* u = sum (-1)^k v(k) / (-zeta)^k = sum v(k) / (zeta)^k + error */ acb_add(u, s1even, s1odd, prec); mag_mul(errtmp, err2, errv); acb_add_error_mag(u, errtmp); if (aip != NULL) { acb_mul(aip, t, E1, prec); acb_neg(aip, aip); } if (bip != NULL) { acb_mul(t, t, E1, prec); acb_mul(u, u, E2, prec); acb_mul_2exp_si(u, u, 1); if (upper) acb_div_onei(t, t); else acb_mul_onei(t, t); acb_add(bip, t, u, prec); } acb_inv(t, w, prec); acb_mul(t, t, z_root, prec); if (aip != NULL) acb_mul(aip, aip, t, prec); if (bip != NULL) acb_mul(bip, bip, t, prec); } } else { /* z_root = (-z)^(1/4), zeta = 2 (-z)^(3/2) / 3 */ acb_neg(t, z); acb_sqrt(z_root, t, prec); acb_cube(zeta, z_root, prec); acb_sqrt(z_root, z_root, prec); acb_mul_2exp_si(zeta, zeta, 1); acb_div_ui(zeta, zeta, 3, prec); if (arg_lt_2pi3(t, zeta)) { /* compute bound factor for i zeta */ arb_one(acb_realref(w)); arb_sqrt_ui(acb_imagref(w), 3, prec); acb_mul_2exp_si(w, w, -1); acb_mul(t, z, w, prec); acb_neg(t, t); acb_mul_onei(u, zeta); acb_hypgeom_airy_asymp_bound_factor(err1, t, u, n); /* compute bound factor for -i zeta */ acb_conj(w, w); acb_mul(t, z, w, prec); acb_neg(t, t); acb_div_onei(u, zeta); acb_hypgeom_airy_asymp_bound_factor(err2, t, u, n); } else { mag_inf(err1); mag_inf(err2); } /* t = 1/(72 i zeta), u = (1/(72 i zeta))^2 */ acb_mul_onei(t, zeta); acb_mul_ui(t, t, 72, prec); acb_inv(t, t, prec); acb_mul(u, t, t, prec); acb_hypgeom_airy_asymp_sum(want_d0 ? s0even : NULL, want_d0 ? s0odd : NULL, want_d1 ? s1even : NULL, want_d1 ? s1odd : NULL, erru, errv, t, u, n, prec); /* exponentials */ acb_const_pi(t, prec); acb_mul_2exp_si(t, t, -2); acb_sub(t, zeta, t, prec); acb_mul_onei(t, t); acb_exp_invexp(E2, E1, t, prec); /* common prefactor */ acb_const_pi(w, prec); acb_sqrt(w, w, prec); acb_mul_2exp_si(w, w, 1); if (ai != NULL || bi != NULL) { /* t = sum (-1)^k u(k) / (i zeta)^k + error */ acb_sub(t, s0even, s0odd, prec); mag_mul(errtmp, err1, erru); acb_add_error_mag(t, errtmp); /* w = sum (-1)^k u(k) / (-i zeta)^k = sum u(k) / (i zeta)^k + error */ acb_add(u, s0even, s0odd, prec); mag_mul(errtmp, err2, erru); acb_add_error_mag(u, errtmp); if (ai != NULL) { acb_mul(ai, t, E1, prec); acb_addmul(ai, u, E2, prec); } if (bi != NULL) { /* (-i E1) t + (+i E2) u */ acb_mul(bi, u, E2, prec); acb_submul(bi, t, E1, prec); acb_mul_onei(bi, bi); } acb_mul(t, w, z_root, prec); acb_inv(t, t, prec); if (ai != NULL) acb_mul(ai, ai, t, prec); if (bi != NULL) acb_mul(bi, bi, t, prec); } if (aip != NULL || bip != NULL) { /* t = sum (-1)^k v(k) / (i zeta)^k + error */ acb_sub(t, s1even, s1odd, prec); mag_mul(errtmp, err1, errv); acb_add_error_mag(t, errtmp); /* u = sum (-1)^k v(k) / (-i zeta)^k = sum v(k) / (i zeta)^k + error */ acb_add(u, s1even, s1odd, prec); mag_mul(errtmp, err2, errv); acb_add_error_mag(u, errtmp); if (bip != NULL) { acb_mul(bip, t, E1, prec); acb_addmul(bip, u, E2, prec); } if (aip != NULL) { /* i E1 t - i E2 u */ acb_mul(aip, t, E1, prec); acb_submul(aip, u, E2, prec); acb_mul_onei(aip, aip); } acb_inv(t, w, prec); acb_mul(t, t, z_root, prec); if (aip != NULL) acb_mul(aip, aip, t, prec); if (bip != NULL) acb_mul(bip, bip, t, prec); } } if (is_real) { if (ai != NULL) arb_zero(acb_imagref(ai)); if (aip != NULL) arb_zero(acb_imagref(aip)); if (bi != NULL) arb_zero(acb_imagref(bi)); if (bip != NULL) arb_zero(acb_imagref(bip)); } acb_clear(t); acb_clear(u); acb_clear(w); acb_clear(z_root); acb_clear(zeta); acb_clear(s0even); acb_clear(s0odd); acb_clear(s1even); acb_clear(s1odd); acb_clear(E1); acb_clear(E2); mag_clear(err1); mag_clear(err2); mag_clear(errtmp); mag_clear(erru); mag_clear(errv); }