/* Differential equation for F(a,b,c,y+z):
(y+z)(y-1+z) F''(z) + ((y+z)(a+b+1) - c) F'(z) + a b F(z) = 0
Coefficients in the Taylor series are bounded by
A * binomial(N+k, k) * nu^k
using the Cauchy-Kovalevskaya majorant method.
See J. van der Hoeven, "Fast evaluation of holonomic functions near
and in regular singularities"
*/
static void
bound(mag_t A, mag_t nu, mag_t N,
const acb_t a, const acb_t b, const acb_t c, const acb_t y,
const acb_t f0, const acb_t f1)
{
mag_t M0, M1, t, u;
acb_t d;
acb_init(d);
mag_init(M0);
mag_init(M1);
mag_init(t);
mag_init(u);
/* nu = max(1/|y-1|, 1/|y|) = 1/min(|y-1|, |y|) */
acb_get_mag_lower(t, y);
acb_sub_ui(d, y, 1, MAG_BITS);
acb_get_mag_lower(u, d);
mag_min(t, t, u);
mag_one(u);
mag_div(nu, u, t);
/* M0 = 2 nu |ab| */
acb_get_mag(t, a);
acb_get_mag(u, b);
mag_mul(M0, t, u);
mag_mul(M0, M0, nu);
mag_mul_2exp_si(M0, M0, 1);
/* M1 = 2 nu |(a+b+1)y-c| + 2|a+b+1| */
acb_add(d, a, b, MAG_BITS);
acb_add_ui(d, d, 1, MAG_BITS);
acb_get_mag(t, d);
acb_mul(d, d, y, MAG_BITS);
acb_sub(d, d, c, MAG_BITS);
acb_get_mag(u, d);
mag_mul(u, u, nu);
mag_add(M1, t, u);
mag_mul_2exp_si(M1, M1, 1);
/* N = max(sqrt(2 M0), 2 M1) / nu */
mag_mul_2exp_si(M0, M0, 1);
mag_sqrt(M0, M0);
mag_mul_2exp_si(M1, M1, 1);
mag_max(N, M0, M1);
mag_div(N, N, nu);
/* A = max(|f0|, |f1| / (nu (N+1)) */
acb_get_mag(t, f0);
acb_get_mag(u, f1);
mag_div(u, u, nu);
mag_div(u, u, N); /* upper bound for dividing by N+1 */
mag_max(A, t, u);
acb_clear(d);
mag_clear(M0);
mag_clear(M1);
mag_clear(t);
mag_clear(u);
}
static void
acb_hypgeom_mag_Cn(mag_t Cn, int R, const mag_t nu, const mag_t sigma, ulong n)
{
if (R == 1)
{
mag_one(Cn);
}
else
{
acb_hypgeom_mag_chi(Cn, n);
if (R == 3)
{
mag_t tmp;
mag_init(tmp);
mag_mul(tmp, nu, nu);
mag_mul(tmp, tmp, sigma);
if (n != 1)
mag_mul_ui(tmp, tmp, n);
mag_add(Cn, Cn, tmp);
mag_pow_ui(tmp, nu, n);
mag_mul(Cn, Cn, tmp);
mag_clear(tmp);
}
}
}
static void
acb_rising_get_mag2_right(mag_t bound, const arb_t a, const arb_t b, ulong n)
{
mag_t t, u;
ulong k;
mag_init(t);
mag_init(u);
arb_get_mag(t, a);
arb_get_mag(u, b);
mag_mul(bound, t, t);
mag_addmul(bound, u, u);
mag_set(u, bound);
mag_mul_2exp_si(t, t, 1);
for (k = 1; k < n; k++)
{
mag_add_ui_2exp_si(u, u, 2 * k - 1, 0);
mag_add(u, u, t);
mag_mul(bound, bound, u);
}
mag_clear(t);
mag_clear(u);
}
void
acb_hypgeom_erf_propagated_error(mag_t re, mag_t im, const acb_t z)
{
mag_t x, y;
mag_init(x);
mag_init(y);
/* |exp(-(x+y)^2)| = exp(y^2-x^2) */
arb_get_mag(y, acb_imagref(z));
mag_mul(y, y, y);
arb_get_mag_lower(x, acb_realref(z));
mag_mul_lower(x, x, x);
if (mag_cmp(y, x) >= 0)
{
mag_sub(re, y, x);
mag_exp(re, re);
}
else
{
mag_sub_lower(re, x, y);
mag_expinv(re, re);
}
/* Radius. */
mag_hypot(x, arb_radref(acb_realref(z)), arb_radref(acb_imagref(z)));
mag_mul(re, re, x);
/* 2/sqrt(pi) < 289/256 */
mag_mul_ui(re, re, 289);
mag_mul_2exp_si(re, re, -8);
if (arb_is_zero(acb_imagref(z)))
{
/* todo: could bound magnitude even for complex numbers */
mag_set_ui(y, 2);
mag_min(re, re, y);
mag_zero(im);
}
else if (arb_is_zero(acb_realref(z)))
{
mag_swap(im, re);
mag_zero(re);
}
else
{
mag_set(im, re);
}
mag_clear(x);
mag_clear(y);
}
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;
}
/* bound (1 + 1/m)^n, m > 0, n >= 0 */
void
mag_binpow_uiui(mag_t b, ulong m, ulong n)
{
mag_t t;
if (m == 0)
{
mag_inf(b);
return;
}
mag_init(t);
/* bound by exp(n/m) <= 1 + (n/m) + (n/m)^2 */
if (m > n)
{
mag_set_ui(t, n); /* x = n/m */
mag_div_ui(t, t, m);
mag_mul(b, t, t); /* x^2 */
mag_add(b, b, t); /* x */
mag_one(t);
mag_add(b, b, t); /* 1 */
}
else
{
mag_one(b);
mag_div_ui(b, b, m);
mag_one(t);
mag_add(t, t, b);
mag_pow_ui(b, t, n);
}
mag_clear(t);
}
void
mag_exp_tail(mag_t z, const mag_t x, ulong N)
{
if (N == 0 || mag_is_inf(x))
{
mag_exp(z, x);
}
else if (mag_is_zero(x))
{
mag_zero(z);
}
else
{
mag_t t;
mag_init(t);
mag_set_ui_2exp_si(t, N, -1);
/* bound by geometric series when N >= 2*x <=> N/2 >= x */
if (mag_cmp(t, x) >= 0)
{
/* 2 c^N / N! */
mag_pow_ui(t, x, N);
mag_rfac_ui(z, N);
mag_mul(z, z, t);
mag_mul_2exp_si(z, z, 1);
}
else
{
mag_exp(z, x);
}
mag_clear(t);
}
}
void
acb_get_mag(mag_t u, const acb_t z)
{
if (arb_is_zero(acb_imagref(z)))
{
arb_get_mag(u, acb_realref(z));
}
else if (arb_is_zero(acb_realref(z)))
{
arb_get_mag(u, acb_imagref(z));
}
else
{
mag_t v;
mag_init(v);
arb_get_mag(u, acb_realref(z));
arb_get_mag(v, acb_imagref(z));
mag_mul(u, u, u);
mag_addmul(u, v, v);
mag_sqrt(u, u);
mag_clear(v);
}
}
void arb_square(arb_t out, const arb_t in, slong prec) {
mag_mul(arb_radref(out), arb_radref(in), arb_radref(in));
int inexact = arf_mul(arb_midref(out), arb_midref(in), arb_midref(in), ARB_RND, prec);
if (inexact)
arf_mag_add_ulp(arb_radref(out), arb_radref(out), arb_midref(out), prec);
}
void
arb_sinc(arb_t z, const arb_t x, slong prec)
{
mag_t c, r;
mag_init(c);
mag_init(r);
mag_set_ui_2exp_si(c, 5, -1);
arb_get_mag_lower(r, x);
if (mag_cmp(c, r) < 0)
{
/* x is not near the origin */
_arb_sinc_direct(z, x, prec);
}
else if (mag_cmp_2exp_si(arb_radref(x), 1) < 0)
{
/* determine error magnitude using the derivative bound */
if (arb_is_exact(x))
{
mag_zero(c);
}
else
{
_arb_sinc_derivative_bound(r, x);
mag_mul(c, arb_radref(x), r);
}
/* evaluate sinc at the midpoint of x */
if (arf_is_zero(arb_midref(x)))
{
arb_one(z);
}
else
{
arb_get_mid_arb(z, x);
_arb_sinc_direct(z, z, prec);
}
/* add the error */
mag_add(arb_radref(z), arb_radref(z), c);
}
else
{
/* x has a large radius and includes points near the origin */
arf_zero(arb_midref(z));
mag_one(arb_radref(z));
}
mag_clear(c);
mag_clear(r);
}
void
arb_root_ui_algebraic(arb_t res, const arb_t x, ulong k, slong prec)
{
mag_t r, msubr, m1k, t;
if (arb_is_exact(x))
{
arb_root_arf(res, arb_midref(x), k, prec);
return;
}
if (!arb_is_nonnegative(x))
{
arb_indeterminate(res);
return;
}
mag_init(r);
mag_init(msubr);
mag_init(m1k);
mag_init(t);
/* x = [m-r, m+r] */
mag_set(r, arb_radref(x));
/* m - r */
arb_get_mag_lower(msubr, x);
/* m^(1/k) */
arb_root_arf(res, arb_midref(x), k, prec);
/* bound for m^(1/k) */
arb_get_mag(m1k, res);
/* C = min(1, log(1+r/(m-r))/k) */
mag_div(t, r, msubr);
mag_log1p(t, t);
mag_div_ui(t, t, k);
if (mag_cmp_2exp_si(t, 0) > 0)
mag_one(t);
/* C m^(1/k) */
mag_mul(t, m1k, t);
mag_add(arb_radref(res), arb_radref(res), t);
mag_clear(r);
mag_clear(msubr);
mag_clear(m1k);
mag_clear(t);
}
void
mag_pow_ui(mag_t z, const mag_t x, ulong e)
{
if (mag_is_inf(x))
{
mag_inf(z);
}
else if (e <= 2)
{
if (e == 0)
mag_one(z);
else if (e == 1)
mag_set(z, x);
else
mag_mul(z, x, x);
}
else
{
mag_t y;
int i, bits;
mag_init_set(y, x);
bits = FLINT_BIT_COUNT(e);
for (i = bits - 2; i >= 0; i--)
{
mag_mul(y, y, y);
if (e & (1UL << i))
mag_mul(y, y, x);
}
mag_swap(z, y);
mag_clear(y);
}
}
void
arb_div(arb_t z, const arb_t x, const arb_t y, long prec)
{
mag_t zr, xm, ym, yl, yw;
int inexact;
if (arb_is_exact(y))
{
arb_div_arf(z, x, arb_midref(y), prec);
}
else if (mag_is_inf(arb_radref(x)) || mag_is_inf(arb_radref(y)))
{
arf_div(arb_midref(z), arb_midref(x), arb_midref(y), prec, ARB_RND);
mag_inf(arb_radref(z));
}
else
{
mag_init_set_arf(xm, arb_midref(x));
mag_init_set_arf(ym, arb_midref(y));
mag_init(zr);
mag_init(yl);
mag_init(yw);
/* (|x|*yrad + |y|*xrad)/(y*(|y|-yrad)) */
mag_mul(zr, xm, arb_radref(y));
mag_addmul(zr, ym, arb_radref(x));
arb_get_mag_lower(yw, y);
arf_get_mag_lower(yl, arb_midref(y));
mag_mul_lower(yl, yl, yw);
mag_div(zr, zr, yl);
inexact = arf_div(arb_midref(z), arb_midref(x), arb_midref(y), prec, ARB_RND);
if (inexact)
arf_mag_add_ulp(arb_radref(z), zr, arb_midref(z), prec);
else
mag_swap(arb_radref(z), zr);
mag_clear(xm);
mag_clear(ym);
mag_clear(zr);
mag_clear(yl);
mag_clear(yw);
}
}
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_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);
}
void
arb_hypgeom_infsum(arb_t P, arb_t Q, hypgeom_t hyp, long target_prec, long prec)
{
mag_t err, z;
long n;
mag_init(err);
mag_init(z);
mag_set_fmpz(z, hyp->P->coeffs + hyp->P->length - 1);
mag_div_fmpz(z, z, hyp->Q->coeffs + hyp->Q->length - 1);
if (!hyp->have_precomputed)
{
hypgeom_precompute(hyp);
hyp->have_precomputed = 1;
}
n = hypgeom_bound(err, hyp->r, hyp->boundC, hyp->boundD,
hyp->boundK, hyp->MK, z, target_prec);
arb_hypgeom_sum(P, Q, hyp, n, prec);
if (arf_sgn(arb_midref(Q)) < 0)
{
arb_neg(P, P);
arb_neg(Q, Q);
}
/* We have p/q = s + err i.e. (p + q*err)/q = s */
{
mag_t u;
mag_init(u);
arb_get_mag(u, Q);
mag_mul(u, u, err);
mag_add(arb_radref(P), arb_radref(P), u);
mag_clear(u);
}
mag_clear(z);
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);
}
/* 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);
}
/* computes the factors that are independent of n (all are upper bounds) */
void
acb_hypgeom_u_asymp_bound_factors(int * R, mag_t alpha,
mag_t nu, mag_t sigma, mag_t rho, mag_t zinv,
const acb_t a, const acb_t b, const acb_t z)
{
mag_t r, u, zre, zim, zlo, sigma_prime;
acb_t t;
mag_init(r);
mag_init(u);
mag_init(zre);
mag_init(zim);
mag_init(zlo);
mag_init(sigma_prime);
acb_init(t);
/* lower bounds for |re(z)|, |im(z)|, |z| */
arb_get_mag_lower(zre, acb_realref(z));
arb_get_mag_lower(zim, acb_imagref(z));
acb_get_mag_lower(zlo, z); /* todo: hypot */
/* upper bound for 1/|z| */
mag_one(u);
mag_div(zinv, u, zlo);
/* upper bound for r = |b - 2a| */
acb_mul_2exp_si(t, a, 1);
acb_sub(t, b, t, MAG_BITS);
acb_get_mag(r, t);
/* determine region */
*R = 0;
if (mag_cmp(zlo, r) >= 0)
{
int znonneg = arb_is_nonnegative(acb_realref(z));
if (znonneg && mag_cmp(zre, r) >= 0)
{
*R = 1;
}
else if (mag_cmp(zim, r) >= 0 || znonneg)
{
*R = 2;
}
else
{
mag_mul_2exp_si(u, r, 1);
if (mag_cmp(zlo, u) >= 0)
*R = 3;
}
}
if (R == 0)
{
mag_inf(alpha);
mag_inf(nu);
mag_inf(sigma);
mag_inf(rho);
}
else
{
/* sigma = |(b-2a)/z| */
mag_mul(sigma, r, zinv);
/* nu = (1/2 + 1/2 sqrt(1-4 sigma^2))^(-1/2) <= 1 + 2 sigma^2 */
if (mag_cmp_2exp_si(sigma, -1) <= 0)
{
mag_mul(nu, sigma, sigma);
mag_mul_2exp_si(nu, nu, 1);
mag_one(u);
mag_add(nu, nu, u);
}
else
{
mag_inf(nu);
}
/* modified sigma for alpha, beta, rho when in R3 */
if (*R == 3)
mag_mul(sigma_prime, sigma, nu);
else
mag_set(sigma_prime, sigma);
/* alpha = 1/(1-sigma') */
mag_one(alpha);
mag_sub_lower(alpha, alpha, sigma_prime);
mag_one(u);
mag_div(alpha, u, alpha);
/* rho = |2a^2-2ab+b|/2 + sigma'*(1+sigma'/4)/(1-sigma')^2 */
mag_mul_2exp_si(rho, sigma_prime, -2);
mag_one(u);
mag_add(rho, rho, u);
mag_mul(rho, rho, sigma_prime);
mag_mul(rho, rho, alpha);
mag_mul(rho, rho, alpha);
acb_sub(t, a, b, MAG_BITS);
acb_mul(t, t, a, MAG_BITS);
acb_mul_2exp_si(t, t, 1);
acb_add(t, t, b, MAG_BITS);
acb_get_mag(u, t);
mag_mul_2exp_si(u, u, -1);
mag_add(rho, rho, u);
}
mag_clear(r);
mag_clear(u);
mag_clear(zre);
mag_clear(zim);
mag_clear(zlo);
mag_clear(sigma_prime);
acb_clear(t);
}
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);
}
/*
Given T(K), compute bound for T(n) z^n.
We need to multiply by
z^n * 1/rf(K+1,m)^r * (rf(K+1,m)/rf(K+1-A,m)) * (rf(K+1-B,m)/rf(K+1-2B,m))
where m = n - K. This is equal to
z^n *
(K+A)! (K-2B)! (K-B+m)!
----------------------- * ((K+m)! / K!)^(1-r)
(K-B)! (K-A+m)! (K-2B+m)!
*/
void
hypgeom_term_bound(mag_t Tn, const mag_t TK, slong K, slong A, slong B, int r, const mag_t z, slong n)
{
mag_t t, u, num;
slong m;
mag_init(t);
mag_init(u);
mag_init(num);
m = n - K;
if (m < 0)
{
flint_printf("hypgeom term bound\n");
abort();
}
/* TK * z^n */
mag_pow_ui(t, z, n);
mag_mul(num, TK, t);
/* numerator: (K+A)! (K-2B)! (K-B+m)! */
mag_fac_ui(t, K+A);
mag_mul(num, num, t);
mag_fac_ui(t, K-2*B);
mag_mul(num, num, t);
mag_fac_ui(t, K-B+m);
mag_mul(num, num, t);
/* denominator: (K-B)! (K-A+m)! (K-2B+m)! */
mag_rfac_ui(t, K-B);
mag_mul(num, num, t);
mag_rfac_ui(t, K-A+m);
mag_mul(num, num, t);
mag_rfac_ui(t, K-2*B+m);
mag_mul(num, num, t);
/* ((K+m)! / K!)^(1-r) */
if (r == 0)
{
mag_fac_ui(t, K+m);
mag_mul(num, num, t);
mag_rfac_ui(t, K);
mag_mul(num, num, t);
}
else if (r != 1)
{
mag_fac_ui(t, K);
mag_rfac_ui(u, K+m);
mag_mul(t, t, u);
mag_pow_ui(t, t, r-1);
mag_mul(num, num, t);
}
mag_set(Tn, num);
mag_clear(t);
mag_clear(u);
mag_clear(num);
}
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);
}
/* 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);
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("frobenius_norm....");
fflush(stdout);
flint_randinit(state);
/* compare to the exact rational norm */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
fmpq_mat_t Q;
fmpq_t q;
arb_mat_t A;
slong n, qbits, prec;
n = n_randint(state, 8);
qbits = 1 + n_randint(state, 100);
prec = 2 + n_randint(state, 200);
fmpq_mat_init(Q, n, n);
fmpq_init(q);
arb_mat_init(A, n, n);
fmpq_mat_randtest(Q, state, qbits);
_fmpq_mat_sum_of_squares(q, Q);
arb_mat_set_fmpq_mat(A, Q, prec);
/* check that the arb interval contains the exact value */
{
arb_t a;
arb_init(a);
arb_mat_frobenius_norm(a, A, prec);
arb_mul(a, a, a, prec);
if (!arb_contains_fmpq(a, q))
{
flint_printf("FAIL (containment, iter = %wd)\n", iter);
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n");
fmpq_mat_print(Q);
flint_printf("\n\n");
flint_printf("frobenius_norm(Q)^2 = \n");
fmpq_print(q);
flint_printf("\n\n");
flint_printf("A = \n");
arb_mat_printd(A, 15);
flint_printf("\n\n");
flint_printf("frobenius_norm(A)^2 = \n");
arb_printd(a, 15);
flint_printf("\n\n");
flint_printf("frobenius_norm(A)^2 = \n");
arb_print(a);
flint_printf("\n\n");
abort();
}
arb_clear(a);
}
/* check that the upper bound is not less than the exact value */
{
mag_t b;
fmpq_t y;
mag_init(b);
fmpq_init(y);
arb_mat_bound_frobenius_norm(b, A);
mag_mul(b, b, b);
mag_get_fmpq(y, b);
if (fmpq_cmp(q, y) > 0)
{
flint_printf("FAIL (bound, iter = %wd)\n", iter);
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n");
fmpq_mat_print(Q);
flint_printf("\n\n");
flint_printf("frobenius_norm(Q)^2 = \n");
fmpq_print(q);
flint_printf("\n\n");
flint_printf("A = \n");
arb_mat_printd(A, 15);
flint_printf("\n\n");
flint_printf("bound_frobenius_norm(A)^2 = \n");
mag_printd(b, 15);
flint_printf("\n\n");
flint_printf("bound_frobenius_norm(A)^2 = \n");
mag_print(b);
flint_printf("\n\n");
abort();
}
mag_clear(b);
fmpq_clear(y);
}
fmpq_mat_clear(Q);
fmpq_clear(q);
arb_mat_clear(A);
}
/* check trace(A^T A) = frobenius_norm(A)^2 */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
slong m, n, prec;
arb_mat_t A, AT, ATA;
arb_t t;
prec = 2 + n_randint(state, 200);
m = n_randint(state, 10);
n = n_randint(state, 10);
arb_mat_init(A, m, n);
arb_mat_init(AT, n, m);
arb_mat_init(ATA, n, n);
arb_init(t);
arb_mat_randtest(A, state, 2 + n_randint(state, 100), 10);
arb_mat_transpose(AT, A);
arb_mat_mul(ATA, AT, A, prec);
arb_mat_trace(t, ATA, prec);
arb_sqrt(t, t, prec);
/* check the norm bound */
{
mag_t low, frobenius;
mag_init(low);
arb_get_mag_lower(low, t);
mag_init(frobenius);
arb_mat_bound_frobenius_norm(frobenius, A);
if (mag_cmp(low, frobenius) > 0)
{
flint_printf("FAIL (bound)\n", iter);
flint_printf("m = %wd, n = %wd, prec = %wd\n", m, n, prec);
flint_printf("\n");
flint_printf("A = \n");
arb_mat_printd(A, 15);
flint_printf("\n\n");
flint_printf("lower(sqrt(trace(A^T A))) = \n");
mag_printd(low, 15);
flint_printf("\n\n");
flint_printf("bound_frobenius_norm(A) = \n");
mag_printd(frobenius, 15);
flint_printf("\n\n");
abort();
}
mag_clear(low);
mag_clear(frobenius);
}
/* check the norm interval */
{
arb_t frobenius;
arb_init(frobenius);
arb_mat_frobenius_norm(frobenius, A, prec);
if (!arb_overlaps(t, frobenius))
{
flint_printf("FAIL (overlap)\n", iter);
flint_printf("m = %wd, n = %wd, prec = %wd\n", m, n, prec);
flint_printf("\n");
flint_printf("A = \n");
arb_mat_printd(A, 15);
flint_printf("\n\n");
flint_printf("sqrt(trace(A^T A)) = \n");
arb_printd(t, 15);
flint_printf("\n\n");
flint_printf("frobenius_norm(A) = \n");
arb_printd(frobenius, 15);
flint_printf("\n\n");
abort();
}
arb_clear(frobenius);
}
arb_mat_clear(A);
arb_mat_clear(AT);
arb_mat_clear(ATA);
arb_clear(t);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
/* 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);
}
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);
}
}
void
mag_polylog_tail(mag_t u, const mag_t z, long sigma, ulong d, ulong N)
{
mag_t TN, UN, t;
if (N < 2)
{
mag_inf(u);
return;
}
mag_init(TN);
mag_init(UN);
mag_init(t);
if (mag_cmp_2exp_si(z, 0) >= 0)
{
mag_inf(u);
}
else
{
/* Bound T(N) */
mag_pow_ui(TN, z, N);
/* multiply by log(N)^d */
if (d > 0)
{
mag_log_ui(t, N);
mag_pow_ui(t, t, d);
mag_mul(TN, TN, t);
}
/* multiply by 1/k^s */
if (sigma > 0)
{
mag_set_ui_lower(t, N);
mag_pow_ui_lower(t, t, sigma);
mag_div(TN, TN, t);
}
else if (sigma < 0)
{
mag_set_ui(t, N);
mag_pow_ui(t, t, -sigma);
mag_mul(TN, TN, t);
}
/* Bound U(N) */
mag_set(UN, z);
/* multiply by (1 + 1/N)**S */
if (sigma < 0)
{
mag_binpow_uiui(t, N, -sigma);
mag_mul(UN, UN, t);
}
/* multiply by (1 + 1/(N log(N)))^d */
if (d > 0)
{
ulong nl;
/* rounds down */
nl = mag_d_log_lower_bound(N) * N * (1 - 1e-13);
mag_binpow_uiui(t, nl, d);
mag_mul(UN, UN, t);
}
/* T(N) / (1 - U(N)) */
if (mag_cmp_2exp_si(UN, 0) >= 0)
{
mag_inf(u);
}
else
{
mag_one(t);
mag_sub_lower(t, t, UN);
mag_div(u, TN, t);
}
}
mag_clear(TN);
mag_clear(UN);
mag_clear(t);
}
slong
hypgeom_bound(mag_t error, int r,
slong A, slong B, slong K, const mag_t TK, const mag_t z, slong tol_2exp)
{
mag_t Tn, t, u, one, tol, num, den;
slong n, m;
mag_init(Tn);
mag_init(t);
mag_init(u);
mag_init(one);
mag_init(tol);
mag_init(num);
mag_init(den);
mag_one(one);
mag_set_ui_2exp_si(tol, UWORD(1), -tol_2exp);
/* approximate number of needed terms */
n = hypgeom_estimate_terms(z, r, tol_2exp);
/* required for 1 + O(1/k) part to be decreasing */
n = FLINT_MAX(n, K + 1);
/* required for z^k / (k!)^r to be decreasing */
m = hypgeom_root_bound(z, r);
n = FLINT_MAX(n, m);
/* We now have |R(k)| <= G(k) where G(k) is monotonically decreasing,
and can bound the tail using a geometric series as soon
as soon as G(k) < 1. */
/* bound T(n-1) */
hypgeom_term_bound(Tn, TK, K, A, B, r, z, n-1);
while (1)
{
/* bound R(n) */
mag_mul_ui(num, z, n);
mag_mul_ui(num, num, n - B);
mag_set_ui_lower(den, n - A);
mag_mul_ui_lower(den, den, n - 2*B);
if (r != 0)
{
mag_set_ui_lower(u, n);
mag_pow_ui_lower(u, u, r);
mag_mul_lower(den, den, u);
}
mag_div(t, num, den);
/* multiply bound for T(n-1) by bound for R(n) to bound T(n) */
mag_mul(Tn, Tn, t);
/* geometric series termination check */
/* u = max(1-t, 0), rounding down [lower bound] */
mag_sub_lower(u, one, t);
if (!mag_is_zero(u))
{
mag_div(u, Tn, u);
if (mag_cmp(u, tol) < 0)
{
mag_set(error, u);
break;
}
}
/* move on to next term */
n++;
}
mag_clear(Tn);
mag_clear(t);
mag_clear(u);
mag_clear(one);
mag_clear(tol);
mag_clear(num);
mag_clear(den);
return n;
}
void
_arb_bell_sum_taylor(arb_t res, const fmpz_t n,
const fmpz_t a, const fmpz_t b, const fmpz_t mmag, long tol)
{
fmpz_t m, r, R, tmp;
mag_t B, C, D, bound;
arb_t t, u;
long wp, k, N;
if (_fmpz_sub_small(b, a) < 5)
{
arb_bell_sum_bsplit(res, n, a, b, mmag, tol);
return;
}
fmpz_init(m);
fmpz_init(r);
fmpz_init(R);
fmpz_init(tmp);
/* r = max(m - a, b - m) */
/* m = a + (b - a) / 2 */
fmpz_sub(r, b, a);
fmpz_cdiv_q_2exp(r, r, 1);
fmpz_add(m, a, r);
fmpz_mul_2exp(R, r, RADIUS_BITS);
mag_init(B);
mag_init(C);
mag_init(D);
mag_init(bound);
arb_init(t);
arb_init(u);
if (fmpz_cmp(R, m) >= 0)
{
mag_inf(C);
mag_inf(D);
}
else
{
/* C = exp(R * |F'(m)| + (1/2) R^2 * (n/(m-R)^2 + 1/(m-R))) */
/* C = exp(R * (|F'(m)| + (1/2) R * (n/(m-R) + 1)/(m-R))) */
/* D = (1/2) R * (n/(m-R) + 1)/(m-R) */
fmpz_sub(tmp, m, R);
mag_set_fmpz(D, n);
mag_div_fmpz(D, D, tmp);
mag_one(C);
mag_add(D, D, C);
mag_div_fmpz(D, D, tmp);
mag_mul_fmpz(D, D, R);
mag_mul_2exp_si(D, D, -1);
/* C = |F'(m)| */
wp = 20 + 1.05 * fmpz_bits(n);
arb_set_fmpz(t, n);
arb_div_fmpz(t, t, m, wp);
fmpz_add_ui(tmp, m, 1);
arb_set_fmpz(u, tmp);
arb_digamma(u, u, wp);
arb_sub(t, t, u, wp);
arb_get_mag(C, t);
/* C = exp(R * (C + D)) */
mag_add(C, C, D);
mag_mul_fmpz(C, C, R);
mag_exp(C, C);
}
if (mag_cmp_2exp_si(C, tol / 4 + 2) > 0)
{
_arb_bell_sum_taylor(res, n, a, m, mmag, tol);
_arb_bell_sum_taylor(t, n, m, b, mmag, tol);
arb_add(res, res, t, 2 * tol);
}
else
{
arb_ptr mx, ser1, ser2, ser3;
/* D = T(m) */
wp = 20 + 1.05 * fmpz_bits(n);
arb_set_fmpz(t, m);
arb_pow_fmpz(t, t, n, wp);
fmpz_add_ui(tmp, m, 1);
arb_gamma_fmpz(u, tmp, wp);
arb_div(t, t, u, wp);
arb_get_mag(D, t);
/* error bound: (b-a) * C * D * B^N / (1 - B), B = r/R */
/* ((b-a) * C * D * 2) * 2^(-N*RADIUS_BITS) */
/* ((b-a) * C * D * 2) */
mag_mul(bound, C, D);
mag_mul_2exp_si(bound, bound, 1);
fmpz_sub(tmp, b, a);
mag_mul_fmpz(bound, bound, tmp);
/* N = (tol + log2((b-a)*C*D*2) - mmag) / RADIUS_BITS */
if (mmag == NULL)
{
/* estimate D ~= 2^mmag */
fmpz_add_ui(tmp, MAG_EXPREF(C), tol);
fmpz_cdiv_q_ui(tmp, tmp, RADIUS_BITS);
}
else
{
fmpz_sub(tmp, MAG_EXPREF(bound), mmag);
fmpz_add_ui(tmp, tmp, tol);
fmpz_cdiv_q_ui(tmp, tmp, RADIUS_BITS);
}
if (fmpz_cmp_ui(tmp, 5 * tol / 4) > 0)
N = 5 * tol / 4;
else if (fmpz_cmp_ui(tmp, 2) < 0)
N = 2;
else
N = fmpz_get_ui(tmp);
/* multiply by 2^(-N*RADIUS_BITS) */
mag_mul_2exp_si(bound, bound, -N * RADIUS_BITS);
mx = _arb_vec_init(2);
ser1 = _arb_vec_init(N);
ser2 = _arb_vec_init(N);
ser3 = _arb_vec_init(N);
/* estimate (this should work for moderate n and tol) */
wp = 1.1 * tol + 1.05 * fmpz_bits(n) + 5;
/* increase precision until convergence */
while (1)
{
/* (m+x)^n / gamma(m+1+x) */
arb_set_fmpz(mx, m);
arb_one(mx + 1);
_arb_poly_log_series(ser1, mx, 2, N, wp);
for (k = 0; k < N; k++)
arb_mul_fmpz(ser1 + k, ser1 + k, n, wp);
arb_add_ui(mx, mx, 1, wp);
_arb_poly_lgamma_series(ser2, mx, 2, N, wp);
_arb_vec_sub(ser1, ser1, ser2, N, wp);
_arb_poly_exp_series(ser3, ser1, N, N, wp);
/* t = a - m, u = b - m */
arb_set_fmpz(t, a);
arb_sub_fmpz(t, t, m, wp);
arb_set_fmpz(u, b);
arb_sub_fmpz(u, u, m, wp);
arb_power_sum_vec(ser1, t, u, N, wp);
arb_zero(res);
for (k = 0; k < N; k++)
arb_addmul(res, ser3 + k, ser1 + k, wp);
if (mmag != NULL)
{
if (_fmpz_sub_small(MAG_EXPREF(arb_radref(res)), mmag) <= -tol)
break;
}
else
{
if (arb_rel_accuracy_bits(res) >= tol)
break;
}
wp = 2 * wp;
}
/* add the series truncation bound */
arb_add_error_mag(res, bound);
_arb_vec_clear(mx, 2);
_arb_vec_clear(ser1, N);
_arb_vec_clear(ser2, N);
_arb_vec_clear(ser3, N);
}
mag_clear(B);
mag_clear(C);
mag_clear(D);
mag_clear(bound);
arb_clear(t);
arb_clear(u);
fmpz_clear(m);
fmpz_clear(r);
fmpz_clear(R);
fmpz_clear(tmp);
}
void
acb_inv(acb_t res, const acb_t z, slong prec)
{
mag_t am, bm;
slong hprec;
#define a arb_midref(acb_realref(z))
#define b arb_midref(acb_imagref(z))
#define x arb_radref(acb_realref(z))
#define y arb_radref(acb_imagref(z))
/* choose precision for the floating-point approximation of a^2+b^2 so
that the double rounding result in less than
2 ulp error; also use at least MAG_BITS bits since the
value will be recycled for error bounds */
hprec = FLINT_MAX(prec + 3, MAG_BITS);
if (arb_is_zero(acb_imagref(z)))
{
arb_inv(acb_realref(res), acb_realref(z), prec);
arb_zero(acb_imagref(res));
return;
}
if (arb_is_zero(acb_realref(z)))
{
arb_inv(acb_imagref(res), acb_imagref(z), prec);
arb_neg(acb_imagref(res), acb_imagref(res));
arb_zero(acb_realref(res));
return;
}
if (!acb_is_finite(z))
{
acb_indeterminate(res);
return;
}
if (mag_is_zero(x) && mag_is_zero(y))
{
int inexact;
arf_t a2b2;
arf_init(a2b2);
inexact = arf_sosq(a2b2, a, b, hprec, ARF_RND_DOWN);
if (arf_is_special(a2b2))
{
acb_indeterminate(res);
}
else
{
_arb_arf_div_rounded_den(acb_realref(res), a, a2b2, inexact, prec);
_arb_arf_div_rounded_den(acb_imagref(res), b, a2b2, inexact, prec);
arf_neg(arb_midref(acb_imagref(res)), arb_midref(acb_imagref(res)));
}
arf_clear(a2b2);
return;
}
mag_init(am);
mag_init(bm);
/* first bound |a|-x, |b|-y */
arb_get_mag_lower(am, acb_realref(z));
arb_get_mag_lower(bm, acb_imagref(z));
if ((mag_is_zero(am) && mag_is_zero(bm)))
{
acb_indeterminate(res);
}
else
{
/*
The propagated error in the real part is given exactly by
(a+x')/((a+x')^2+(b+y'))^2 - a/(a^2+b^2) = P / Q,
P = [(b^2-a^2) x' - a (x'^2+y'^2 + 2y'b)]
Q = [(a^2+b^2)((a+x')^2+(b+y')^2)]
where |x'| <= x and |y'| <= y, and analogously for the imaginary part.
*/
mag_t t, u, v, w;
arf_t a2b2;
int inexact;
mag_init(t);
mag_init(u);
mag_init(v);
mag_init(w);
arf_init(a2b2);
inexact = arf_sosq(a2b2, a, b, hprec, ARF_RND_DOWN);
/* compute denominator */
/* t = (|a|-x)^2 + (|b|-x)^2 (lower bound) */
mag_mul_lower(t, am, am);
mag_mul_lower(u, bm, bm);
mag_add_lower(t, t, u);
/* u = a^2 + b^2 (lower bound) */
arf_get_mag_lower(u, a2b2);
/* t = ((|a|-x)^2 + (|b|-x)^2)(a^2 + b^2) (lower bound) */
mag_mul_lower(t, t, u);
/* compute numerator */
/* real: |a^2-b^2| x + |a| ((x^2 + y^2) + 2 |b| y)) */
/* imag: |a^2-b^2| y + |b| ((x^2 + y^2) + 2 |a| x)) */
/* am, bm = upper bounds for a, b */
arf_get_mag(am, a);
arf_get_mag(bm, b);
/* v = x^2 + y^2 */
mag_mul(v, x, x);
mag_addmul(v, y, y);
/* u = |a| ((x^2 + y^2) + 2 |b| y) */
mag_mul_2exp_si(u, bm, 1);
mag_mul(u, u, y);
mag_add(u, u, v);
mag_mul(u, u, am);
/* v = |b| ((x^2 + y^2) + 2 |a| x) */
mag_mul_2exp_si(w, am, 1);
mag_addmul(v, w, x);
mag_mul(v, v, bm);
/* w = |b^2 - a^2| (upper bound) */
if (arf_cmpabs(a, b) >= 0)
mag_mul(w, am, am);
else
mag_mul(w, bm, bm);
mag_addmul(u, w, x);
mag_addmul(v, w, y);
mag_div(arb_radref(acb_realref(res)), u, t);
mag_div(arb_radref(acb_imagref(res)), v, t);
_arb_arf_div_rounded_den_add_err(acb_realref(res), a, a2b2, inexact, prec);
_arb_arf_div_rounded_den_add_err(acb_imagref(res), b, a2b2, inexact, prec);
arf_neg(arb_midref(acb_imagref(res)), arb_midref(acb_imagref(res)));
mag_clear(t);
mag_clear(u);
mag_clear(v);
mag_clear(w);
arf_clear(a2b2);
}
mag_clear(am);
mag_clear(bm);
#undef a
#undef b
#undef x
#undef y
}