/* assumes no aliasing of w and p */
void
acb_lambertw_branchpoint_series(acb_t w, const acb_t t, int bound, slong prec)
{
slong i;
static const int coeffs[] = {-130636800,130636800,-43545600,19958400,
-10402560,5813640,-3394560,2042589,-1256320};
acb_zero(w);
for (i = 8; i >= 0; i--)
{
acb_mul(w, w, t, prec);
acb_add_si(w, w, coeffs[i], prec);
}
acb_div_si(w, w, -coeffs[0], prec);
if (bound)
{
mag_t err;
mag_init(err);
acb_get_mag(err, t);
mag_geom_series(err, err, 9);
if (acb_is_real(t))
arb_add_error_mag(acb_realref(w), err);
else
acb_add_error_mag(w, err);
mag_clear(err);
}
}
static void
acb_log1p_tiny(acb_t r, const acb_t z, slong prec)
{
mag_t b, c;
acb_t t;
int real;
mag_init(b);
mag_init(c);
acb_init(t);
real = acb_is_real(z);
/* if |z| < 1, then |log(1+z) - [z - z^2/2]| <= |z|^3/(1-|z|) */
acb_get_mag(b, z);
mag_one(c);
mag_sub_lower(c, c, b);
mag_pow_ui(b, b, 3);
mag_div(b, b, c);
acb_mul(t, z, z, prec);
acb_mul_2exp_si(t, t, -1);
acb_sub(r, z, t, prec);
if (real && mag_is_finite(b))
arb_add_error_mag(acb_realref(r), b);
else
acb_add_error_mag(r, b);
mag_clear(b);
mag_clear(c);
acb_clear(t);
}
void
acb_dirichlet_zeta_rs(acb_t res, const acb_t s, slong K, slong prec)
{
if (acb_is_exact(s))
{
acb_dirichlet_zeta_rs_mid(res, s, K, prec);
}
else
{
acb_t t;
mag_t rad, err, err2;
slong acc;
acc = acb_rel_accuracy_bits(s);
acc = FLINT_MAX(acc, 0);
acc = FLINT_MIN(acc, prec);
prec = FLINT_MIN(prec, acc + 20);
acb_init(t);
mag_init(rad);
mag_init(err);
mag_init(err2);
/* rad = rad(s) */
mag_hypot(rad, arb_radref(acb_realref(s)), arb_radref(acb_imagref(s)));
/* bound |zeta'(s)| */
acb_dirichlet_zeta_deriv_bound(err, err2, s);
/* error <= |zeta'(s)| * rad(s) */
mag_mul(err, err, rad);
/* evaluate at midpoint */
acb_get_mid(t, s);
acb_dirichlet_zeta_rs_mid(res, t, K, prec);
acb_add_error_mag(res, err);
acb_clear(t);
mag_clear(rad);
mag_clear(err);
mag_clear(err2);
}
}
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);
}
void
acb_lambertw_cleared_cut(acb_t res, const acb_t z, const fmpz_t k, int flags, slong prec)
{
acb_t ez1;
acb_init(ez1);
/* compute e*z + 1 */
arb_const_e(acb_realref(ez1), prec);
acb_mul(ez1, ez1, z, prec);
acb_add_ui(ez1, ez1, 1, prec);
if (acb_is_exact(z))
{
acb_lambertw_main(res, z, ez1, k, flags, prec);
}
else
{
acb_t zz;
mag_t err, rad;
mag_init(err);
mag_init(rad);
acb_init(zz);
acb_lambertw_bound_deriv(err, z, ez1, k);
mag_hypot(rad, arb_radref(acb_realref(z)), arb_radref(acb_imagref(z)));
mag_mul(err, err, rad);
acb_set(zz, z);
mag_zero(arb_radref(acb_realref(zz)));
mag_zero(arb_radref(acb_imagref(zz))); /* todo: recompute ez1? */
acb_lambertw_main(res, zz, ez1, k, flags, prec);
acb_add_error_mag(res, err);
mag_clear(err);
mag_clear(rad);
acb_clear(zz);
}
acb_clear(ez1);
}
/* todo: use log(1-z) when this is better? would also need to
adjust strategy in the main function */
void
acb_hypgeom_dilog_bernoulli(acb_t res, const acb_t z, slong prec)
{
acb_t s, w, w2;
slong n, k;
fmpz_t c, d;
mag_t m, err;
double lm;
int real;
acb_init(s);
acb_init(w);
acb_init(w2);
fmpz_init(c);
fmpz_init(d);
mag_init(m);
mag_init(err);
real = 0;
if (acb_is_real(z))
{
arb_sub_ui(acb_realref(w), acb_realref(z), 1, 30);
real = arb_is_nonpositive(acb_realref(w));
}
acb_log(w, z, prec);
acb_get_mag(m, w);
/* for k >= 4, the terms are bounded by (|w| / (2 pi))^k */
mag_set_ui_2exp_si(err, 2670177, -24); /* upper bound for 1/(2pi) */
mag_mul(err, err, m);
lm = mag_get_d_log2_approx(err);
if (lm < -0.25)
{
n = prec / (-lm) + 1;
n = FLINT_MAX(n, 4);
mag_geom_series(err, err, n);
BERNOULLI_ENSURE_CACHED(n)
acb_mul(w2, w, w, prec);
for (k = n - (n % 2 == 0); k >= 3; k -= 2)
{
fmpz_mul_ui(c, fmpq_denref(bernoulli_cache + k - 1), k - 1);
fmpz_mul_ui(d, c, (k + 1) * (k + 2));
acb_mul(s, s, w2, prec);
acb_mul_fmpz(s, s, c, prec);
fmpz_mul_ui(c, fmpq_numref(bernoulli_cache + k - 1), (k + 1) * (k + 2));
acb_sub_fmpz(s, s, c, prec);
acb_div_fmpz(s, s, d, prec);
}
acb_mul(s, s, w, prec);
acb_mul_2exp_si(s, s, 1);
acb_sub_ui(s, s, 3, prec);
acb_mul(s, s, w2, prec);
acb_mul_2exp_si(s, s, -1);
acb_const_pi(w2, prec);
acb_addmul(s, w2, w2, prec);
acb_div_ui(s, s, 6, prec);
acb_neg(w2, w);
acb_log(w2, w2, prec);
acb_submul(s, w2, w, prec);
acb_add(res, s, w, prec);
acb_add_error_mag(res, err);
if (real)
arb_zero(acb_imagref(res));
}
else
{
acb_indeterminate(res);
}
acb_clear(s);
acb_clear(w);
acb_clear(w2);
fmpz_clear(c);
fmpz_clear(d);
mag_clear(m);
mag_clear(err);
}
/* 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);
}
void
acb_modular_theta_const_sum(acb_t theta2, acb_t theta3, acb_t theta4,
const acb_t q, long prec)
{
mag_t qmag, err;
double log2q_approx;
int is_real, is_real_or_imag;
long N;
mag_init(qmag);
mag_init(err);
acb_get_mag(qmag, q);
log2q_approx = mag_get_log2_d_approx(qmag);
is_real = arb_is_zero(acb_imagref(q));
is_real_or_imag = is_real || arb_is_zero(acb_realref(q));
if (log2q_approx >= 0.0)
{
N = 1;
mag_inf(err);
}
else
{
N = 0;
while (0.05 * N * N < prec)
{
if (log2q_approx * ((N+2)*(N+2)/4) < -prec - 2)
break;
N++;
}
N = (N+2)*(N+2)/4;
mag_geom_series(err, qmag, N);
mag_mul_2exp_si(err, err, 1); /* each term is taken twice */
if (mag_is_inf(err))
N = 1;
}
if (N < 1800)
acb_modular_theta_const_sum_basecase(theta2, theta3, theta4, q, N, prec);
else
acb_modular_theta_const_sum_rs(theta2, theta3, theta4, q, N, prec);
if (is_real_or_imag)
arb_add_error_mag(acb_realref(theta2), err);
else
acb_add_error_mag(theta2, err);
if (is_real)
{
arb_add_error_mag(acb_realref(theta3), err);
arb_add_error_mag(acb_realref(theta4), err);
}
else
{
acb_add_error_mag(theta3, err);
acb_add_error_mag(theta4, err);
}
mag_clear(qmag);
mag_clear(err);
}
void
acb_hypgeom_pfq_sum_rs(acb_t res, acb_t term, acb_srcptr a, slong p,
acb_srcptr b, slong q, const acb_t z, slong n, slong prec)
{
acb_ptr zpow;
acb_t s, t, u;
slong i, j, k, m;
mag_t B, C;
if (n == 0)
{
acb_zero(res);
acb_one(term);
return;
}
if (n < 0)
abort();
m = n_sqrt(n);
m = FLINT_MIN(m, 150);
mag_init(B);
mag_init(C);
acb_init(s);
acb_init(t);
acb_init(u);
zpow = _acb_vec_init(m + 1);
_acb_vec_set_powers(zpow, z, m + 1, prec);
mag_one(B);
for (k = n; k >= 0; k--)
{
j = k % m;
if (k < n)
acb_add(s, s, zpow + j, prec);
if (k > 0)
{
if (p > 0)
{
acb_add_ui(u, a, k - 1, prec);
for (i = 1; i < p; i++)
{
acb_add_ui(t, a + i, k - 1, prec);
acb_mul(u, u, t, prec);
}
if (k < n)
acb_mul(s, s, u, prec);
acb_get_mag(C, u);
mag_mul(B, B, C);
}
if (q > 0)
{
acb_add_ui(u, b, k - 1, prec);
for (i = 1; i < q; i++)
{
acb_add_ui(t, b + i, k - 1, prec);
acb_mul(u, u, t, prec);
}
if (k < n)
acb_div(s, s, u, prec);
acb_get_mag_lower(C, u);
mag_div(B, B, C);
}
if (j == 0 && k < n)
{
acb_mul(s, s, zpow + m, prec);
}
}
}
acb_get_mag(C, z);
mag_pow_ui(C, C, n);
mag_mul(B, B, C);
acb_zero(term);
if (_acb_vec_is_real(a, p) && _acb_vec_is_real(b, q) && acb_is_real(z))
arb_add_error_mag(acb_realref(term), B);
else
acb_add_error_mag(term, B);
acb_set(res, s);
mag_clear(B);
mag_clear(C);
acb_clear(s);
acb_clear(t);
acb_clear(u);
_acb_vec_clear(zpow, m + 1);
}
void acb_hypgeom_u_asymp(acb_t res, const acb_t a, const acb_t b,
const acb_t z, slong n, slong prec)
{
acb_struct aa[3];
acb_t s, t, w, winv;
int R, p, q, is_real, is_terminating;
slong n_terminating;
if (!acb_is_finite(a) || !acb_is_finite(b) || !acb_is_finite(z))
{
acb_indeterminate(res);
return;
}
acb_init(aa);
acb_init(aa + 1);
acb_init(aa + 2);
acb_init(s);
acb_init(t);
acb_init(w);
acb_init(winv);
is_terminating = 0;
n_terminating = WORD_MAX;
/* special case, for incomplete gamma
[todo: also when they happen to be exact and with difference 1...] */
if (a == b)
{
acb_set(aa, a);
p = 1;
q = 0;
}
else
{
acb_set(aa, a);
acb_sub(aa + 1, a, b, prec);
acb_add_ui(aa + 1, aa + 1, 1, prec);
acb_one(aa + 2);
p = 2;
q = 1;
}
if (acb_is_nonpositive_int(aa))
{
is_terminating = 1;
if (arf_cmpabs_ui(arb_midref(acb_realref(aa)), prec) < 0)
n_terminating = 1 - arf_get_si(arb_midref(acb_realref(aa)), ARF_RND_DOWN);
}
if (p == 2 && acb_is_nonpositive_int(aa + 1))
{
is_terminating = 1;
if (arf_cmpabs_ui(arb_midref(acb_realref(aa + 1)), n_terminating) < 0)
n_terminating = 1 - arf_get_si(arb_midref(acb_realref(aa + 1)), ARF_RND_DOWN);
}
acb_neg(w, z);
acb_inv(w, w, prec);
acb_neg(winv, z);
/* low degree polynomial -- no need to try to terminate sooner */
if (is_terminating && n_terminating < 8)
{
acb_hypgeom_pfq_sum_invz(s, t, aa, p, aa + p, q, w, winv,
n_terminating, prec);
acb_set(res, s);
}
else
{
mag_t C1, Cn, alpha, nu, sigma, rho, zinv, tmp, err;
mag_init(C1);
mag_init(Cn);
mag_init(alpha);
mag_init(nu);
mag_init(sigma);
mag_init(rho);
mag_init(zinv);
mag_init(tmp);
mag_init(err);
acb_hypgeom_u_asymp_bound_factors(&R, alpha, nu,
sigma, rho, zinv, a, b, z);
is_real = acb_is_real(a) && acb_is_real(b) && acb_is_real(z) &&
(is_terminating || arb_is_positive(acb_realref(z)));
if (R == 0)
{
/* if R == 0, the error bound is infinite unless terminating */
if (is_terminating && n_terminating < prec)
{
acb_hypgeom_pfq_sum_invz(s, t, aa, p, aa + p, q, w, winv,
n_terminating, prec);
acb_set(res, s);
}
else
{
acb_indeterminate(res);
}
}
else
{
/* C1 */
acb_hypgeom_mag_Cn(C1, R, nu, sigma, 1);
/* err = 2 * alpha * exp(...) */
mag_mul(tmp, C1, rho);
mag_mul(tmp, tmp, alpha);
mag_mul(tmp, tmp, zinv);
mag_mul_2exp_si(tmp, tmp, 1);
mag_exp(err, tmp);
mag_mul(err, err, alpha);
mag_mul_2exp_si(err, err, 1);
/* choose n automatically */
if (n < 0)
{
slong moreprec;
/* take err into account when finding truncation point */
/* we should take Cn into account as well, but this depends
on n which is to be determined; it's easier to look
only at exp(...) which should be larger anyway */
if (mag_cmp_2exp_si(err, 10 * prec) > 0)
moreprec = 10 * prec;
else if (mag_cmp_2exp_si(err, 0) < 0)
moreprec = 0;
else
moreprec = MAG_EXP(err);
n = acb_hypgeom_pfq_choose_n_max(aa, p, aa + p, q, w,
prec + moreprec, FLINT_MIN(WORD_MAX / 2, 50 + 10.0 * prec));
}
acb_hypgeom_pfq_sum_invz(s, t, aa, p, aa + p, q, w, winv, n, prec);
/* add error bound, if not terminating */
if (!(is_terminating && n == n_terminating))
{
acb_hypgeom_mag_Cn(Cn, R, nu, sigma, n);
mag_mul(err, err, Cn);
/* nth term * factor */
acb_get_mag(tmp, t);
mag_mul(err, err, tmp);
if (is_real)
arb_add_error_mag(acb_realref(s), err);
else
acb_add_error_mag(s, err);
}
acb_set(res, s);
}
mag_clear(C1);
mag_clear(Cn);
mag_clear(alpha);
mag_clear(nu);
mag_clear(sigma);
mag_clear(rho);
mag_clear(zinv);
mag_clear(tmp);
mag_clear(err);
}
acb_clear(aa);
acb_clear(aa + 1);
acb_clear(aa + 2);
acb_clear(s);
acb_clear(t);
acb_clear(w);
acb_clear(winv);
}
void
_acb_lambertw(acb_t res, const acb_t z, const acb_t ez1, const fmpz_t k, int flags, slong prec)
{
slong goal, ebits, ebits2, ls, lt;
const fmpz * expo;
/* Estimated accuracy goal. */
/* todo: account for exponent bits and bits in k. */
goal = acb_rel_accuracy_bits(z);
goal = FLINT_MAX(goal, 10);
goal = FLINT_MIN(goal, prec);
/* Handle tiny z directly. For k >= 2, |c_k| <= 4^k / 16. */
if (fmpz_is_zero(k)
&& arf_cmpabs_2exp_si(arb_midref(acb_realref(z)), -goal / 2) < 0
&& arf_cmpabs_2exp_si(arb_midref(acb_imagref(z)), -goal / 2) < 0)
{
mag_t err;
mag_init(err);
acb_get_mag(err, z);
mag_mul_2exp_si(err, err, 2);
acb_set(res, z);
acb_submul(res, res, res, prec);
mag_geom_series(err, err, 3);
mag_mul_2exp_si(err, err, -4);
acb_add_error_mag(res, err);
mag_clear(err);
return;
}
if (arf_cmpabs(arb_midref(acb_realref(z)), arb_midref(acb_imagref(z))) >= 0)
expo = ARF_EXPREF(arb_midref(acb_realref(z)));
else
expo = ARF_EXPREF(arb_midref(acb_imagref(z)));
ebits = fmpz_bits(expo);
/* ebits ~= log2(|log(z) + 2 pi i k|) */
/* ebits2 ~= log2(log(log(z))) */
ebits = FLINT_MAX(ebits, fmpz_bits(k));
ebits = FLINT_MAX(ebits, 1) - 1;
ebits2 = FLINT_BIT_COUNT(ebits);
ebits2 = FLINT_MAX(ebits2, 1) - 1;
/* We gain accuracy from the exponent when W ~ log - log log */
if (fmpz_sgn(expo) > 0 || (fmpz_sgn(expo) < 0 && !fmpz_is_zero(k)))
{
goal += ebits - ebits2;
goal = FLINT_MAX(goal, 10);
goal = FLINT_MIN(goal, prec);
/* The asymptotic series with truncation L, M gives us about
t - max(2+lt+L*(2+ls), M*(2+lt)) bits of accuracy where
ls = -ebits, lt = ebits2 - ebits. */
ls = 2 - ebits;
lt = 2 + ebits2 - ebits;
if (ebits - FLINT_MAX(lt + 1*ls, 1*lt) > goal)
{
acb_lambertw_asymp(res, z, k, 1, 1, goal);
acb_set_round(res, res, prec);
return;
}
else if (ebits - FLINT_MAX(lt + 3*ls, 5*lt) > goal)
{
acb_lambertw_asymp(res, z, k, 3, 5, goal);
acb_set_round(res, res, prec);
return;
}
}
/* Extremely close to the branch point at -1/e, use the series expansion directly. */
if (acb_lambertw_try_near_branch_point(res, z, ez1, k, flags, goal))
{
acb_set_round(res, res, prec);
return;
}
/* compute union of both sides */
if (acb_lambertw_branch_crossing(z, ez1, k))
{
acb_t za, zb, eza1, ezb1;
fmpz_t kk;
acb_init(za);
acb_init(zb);
acb_init(eza1);
acb_init(ezb1);
fmpz_init(kk);
fmpz_neg(kk, k);
acb_set(za, z);
acb_conj(zb, z);
arb_nonnegative_part(acb_imagref(za), acb_imagref(za));
arb_nonnegative_part(acb_imagref(zb), acb_imagref(zb));
acb_set(eza1, ez1);
acb_conj(ezb1, ez1);
arb_nonnegative_part(acb_imagref(eza1), acb_imagref(eza1));
arb_nonnegative_part(acb_imagref(ezb1), acb_imagref(ezb1));
/* Check series expansion again, because now there is no crossing. */
if (!acb_lambertw_try_near_branch_point(res, za, eza1, k, flags, goal))
acb_lambertw_cleared_cut_fix_small(za, za, eza1, k, flags, goal);
if (!acb_lambertw_try_near_branch_point(res, zb, ezb1, kk, flags, goal))
acb_lambertw_cleared_cut_fix_small(zb, zb, ezb1, kk, flags, goal);
acb_conj(zb, zb);
acb_union(res, za, zb, prec);
acb_clear(za);
acb_clear(zb);
acb_clear(eza1);
acb_clear(ezb1);
fmpz_clear(kk);
}
else
{
acb_lambertw_cleared_cut_fix_small(res, z, ez1, k, flags, goal);
acb_set_round(res, res, prec);
}
}
/* note: z should be exact here */
void acb_lambertw_main(acb_t res, const acb_t z,
const acb_t ez1, const fmpz_t k, int flags, slong prec)
{
acb_t w, t, oldw, ew;
mag_t err;
slong i, wp, accuracy, ebits, kbits, mbits, wp_initial, extraprec;
int have_ew;
acb_init(t);
acb_init(w);
acb_init(oldw);
acb_init(ew);
mag_init(err);
/* We need higher precision for large k, large exponents, or very close
to the branch point at -1/e. todo: we should be recomputing
ez1 to higher precision when close... */
acb_get_mag(err, z);
if (fmpz_is_zero(k) && mag_cmp_2exp_si(err, 0) < 0)
ebits = 0;
else
ebits = fmpz_bits(MAG_EXPREF(err));
if (fmpz_is_zero(k) || (fmpz_is_one(k) && arb_is_negative(acb_imagref(z)))
|| (fmpz_equal_si(k, -1) && arb_is_nonnegative(acb_imagref(z))))
{
acb_get_mag(err, ez1);
mbits = -MAG_EXP(err);
mbits = FLINT_MAX(mbits, 0);
mbits = FLINT_MIN(mbits, prec);
}
else
{
mbits = 0;
}
kbits = fmpz_bits(k);
extraprec = FLINT_MAX(ebits, kbits);
extraprec = FLINT_MAX(extraprec, mbits);
wp = wp_initial = 40 + extraprec;
accuracy = acb_lambertw_initial(w, z, ez1, k, wp_initial);
mag_zero(arb_radref(acb_realref(w)));
mag_zero(arb_radref(acb_imagref(w)));
/* We should be able to compute e^w for the final certification
during the Halley iteration. */
have_ew = 0;
for (i = 0; i < 5 + FLINT_BIT_COUNT(prec + extraprec); i++)
{
/* todo: should we restart? */
if (!acb_is_finite(w))
break;
wp = FLINT_MIN(3 * accuracy, 1.1 * prec + 10);
wp = FLINT_MAX(wp, 40);
wp += extraprec;
acb_set(oldw, w);
acb_lambertw_halley_step(t, ew, z, w, wp);
/* estimate the error (conservatively) */
acb_sub(w, w, t, wp);
acb_get_mag(err, w);
acb_set(w, t);
acb_add_error_mag(t, err);
accuracy = acb_rel_accuracy_bits(t);
if (accuracy > 2 * extraprec)
accuracy *= 2.9; /* less conservatively */
accuracy = FLINT_MIN(accuracy, wp);
accuracy = FLINT_MAX(accuracy, 0);
if (accuracy > prec + extraprec)
{
/* e^w = e^oldw * e^(w-oldw) */
acb_sub(t, w, oldw, wp);
acb_exp(t, t, wp);
acb_mul(ew, ew, t, wp);
have_ew = 1;
break;
}
mag_zero(arb_radref(acb_realref(w)));
mag_zero(arb_radref(acb_imagref(w)));
}
wp = FLINT_MIN(3 * accuracy, 1.1 * prec + 10);
wp = FLINT_MAX(wp, 40);
wp += extraprec;
if (acb_lambertw_check_branch(w, k, wp))
{
acb_t u, r, eu1;
mag_t err, rad;
acb_init(u);
acb_init(r);
acb_init(eu1);
mag_init(err);
mag_init(rad);
if (have_ew)
acb_set(t, ew);
else
acb_exp(t, w, wp);
/* t = w e^w */
acb_mul(t, t, w, wp);
acb_sub(r, t, z, wp);
/* Bound W' on the straight line path between t and z */
acb_union(u, t, z, wp);
arb_const_e(acb_realref(eu1), wp);
arb_zero(acb_imagref(eu1));
acb_mul(eu1, eu1, u, wp);
acb_add_ui(eu1, eu1, 1, wp);
if (acb_lambertw_branch_crossing(u, eu1, k))
{
mag_inf(err);
}
else
{
acb_lambertw_bound_deriv(err, u, eu1, k);
acb_get_mag(rad, r);
mag_mul(err, err, rad);
}
acb_add_error_mag(w, err);
acb_set(res, w);
acb_clear(u);
acb_clear(r);
acb_clear(eu1);
mag_clear(err);
mag_clear(rad);
}
else
{
acb_indeterminate(res);
}
acb_clear(t);
acb_clear(w);
acb_clear(oldw);
acb_clear(ew);
mag_clear(err);
}
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
acb_hypgeom_2f1_continuation(acb_t res, acb_t res1,
const acb_t a, const acb_t b, const acb_t c, const acb_t y,
const acb_t z, const acb_t f0, const acb_t f1, long prec)
{
mag_t A, nu, N, w, err, err1, R, T, goal;
acb_t x;
long j, k;
mag_init(A);
mag_init(nu);
mag_init(N);
mag_init(err);
mag_init(err1);
mag_init(w);
mag_init(R);
mag_init(T);
mag_init(goal);
acb_init(x);
bound(A, nu, N, a, b, c, y, f0, f1);
acb_sub(x, z, y, prec);
/* |T(k)| <= A * binomial(N+k, k) * nu^k * |x|^k */
acb_get_mag(w, x);
mag_mul(w, w, nu); /* w = nu |x| */
mag_mul_2exp_si(goal, A, -prec-2);
/* bound for T(0) */
mag_set(T, A);
mag_inf(R);
for (k = 1; k < 100 * prec; k++)
{
/* T(k) = T(k) * R(k), R(k) = (N+k)/k * w = (1 + N/k) w */
mag_div_ui(R, N, k);
mag_add_ui(R, R, 1);
mag_mul(R, R, w);
/* T(k) */
mag_mul(T, T, R);
if (mag_cmp(T, goal) <= 0 && mag_cmp_2exp_si(R, 0) < 0)
break;
}
/* T(k) [1 + R + R^2 + R^3 + ...] */
mag_geom_series(err, R, 0);
mag_mul(err, T, err);
/* Now compute T, R for the derivative */
/* Coefficients are A * (k+1) * binomial(N+k+1, k+1) */
mag_add_ui(T, N, 1);
mag_mul(T, T, A);
mag_inf(R);
for (j = 1; j <= k; j++)
{
mag_add_ui(R, N, k + 1);
mag_div_ui(R, R, k);
mag_mul(R, R, w);
mag_mul(T, T, R);
}
mag_geom_series(err1, R, 0);
mag_mul(err1, T, err1);
if (mag_is_inf(err))
{
acb_indeterminate(res);
acb_indeterminate(res1);
}
else
{
evaluate_sum(res, res1, a, b, c, y, x, f0, f1, k, prec);
acb_add_error_mag(res, err);
acb_add_error_mag(res1, err1);
}
mag_clear(A);
mag_clear(nu);
mag_clear(N);
mag_clear(err);
mag_clear(err1);
mag_clear(w);
mag_clear(R);
mag_clear(T);
mag_clear(goal);
acb_clear(x);
}
