Beispiel #1
0
int check_accuracy(acb_ptr vec, slong len, slong prec)
{
    slong i;

    for (i = 0; i < len; i++)
    {
        if (mag_cmp_2exp_si(arb_radref(acb_realref(vec + i)), -prec) >= 0
                || mag_cmp_2exp_si(arb_radref(acb_imagref(vec + i)), -prec) >= 0)
            return 0;
    }

    return 1;
}
Beispiel #2
0
void
acb_hypgeom_bessel_k(acb_t res, const acb_t nu, const acb_t z, slong prec)
{
    mag_t zmag;

    mag_init(zmag);
    acb_get_mag(zmag, z);

    if (mag_cmp_2exp_si(zmag, 4) < 0 ||
        (mag_cmp_2exp_si(zmag, 64) < 0 && 2 * mag_get_d(zmag) < prec))
        acb_hypgeom_bessel_k_0f1(res, nu, z, prec);
    else
        acb_hypgeom_bessel_k_asymp(res, nu, z, prec);

    mag_clear(zmag);
}
Beispiel #3
0
void
acb_sinc_pi(acb_t res, const acb_t x, slong prec)
{
    mag_t m;
    acb_t t;

    if (acb_is_zero(x))
    {
        acb_one(res);
        return;
    }

    mag_init(m);
    acb_init(t);

    acb_get_mag_lower(m, x);

    if (mag_cmp_2exp_si(m, -1) > 0)
    {
        acb_const_pi(t, prec + 4);
        acb_mul(t, t, x, prec + 4);
        acb_sin_pi(res, x, prec + 4);
        acb_div(res, res, t, prec);
    }
    else
    {
        acb_const_pi(t, prec + 4);
        acb_mul(t, t, x, prec + 4);
        acb_sinc(res, t, prec);
    }

    mag_clear(m);
    acb_clear(t);
}
Beispiel #4
0
Datei: exp.c Projekt: wbhart/arb
slong
_arb_mat_exp_choose_N(const mag_t norm, slong prec)
{
    if (mag_is_special(norm) || mag_cmp_2exp_si(norm, 30) > 0 ||
        mag_cmp_2exp_si(norm, -prec) < 0)
    {
        return 1;
    }
    else if (mag_cmp_2exp_si(norm, -300) < 0)
    {
        slong N = -MAG_EXP(norm);
        return (prec + N - 1) / N;
    }
    else
    {
        double c, t;

        c = mag_get_d(norm);
        t = d_lambertw(prec * LOG2_OVER_E / c);
        t = c * exp(t + 1.0);
        return FLINT_MIN((slong) (t + 1.0), 2 * prec);
    }
}
Beispiel #5
0
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);
}
Beispiel #6
0
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);
}
Beispiel #7
0
void
arb_atan(arb_t z, const arb_t x, slong prec)
{
    if (arb_is_exact(x))
    {
        arb_atan_arf(z, arb_midref(x), prec);
    }
    else
    {
        mag_t t, u;

        mag_init(t);
        mag_init(u);

        arb_get_mag_lower(t, x);

        if (mag_is_zero(t))
        {
            mag_set(t, arb_radref(x));
        }
        else
        {
            mag_mul_lower(t, t, t);
            mag_one(u);
            mag_add_lower(t, t, u);
            mag_div(t, arb_radref(x), t);
        }

        if (mag_cmp_2exp_si(t, 0) > 0)
        {
            mag_const_pi(u);
            mag_min(t, t, u);
        }

        arb_atan_arf(z, arb_midref(x), prec);
        mag_add(arb_radref(z), arb_radref(z), t);

        mag_clear(t);
        mag_clear(u);
    }
}
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);
}
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);
    }
}
Beispiel #10
0
Datei: exp.c Projekt: wbhart/arb
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);
}
Beispiel #11
0
int
arb_get_unique_fmpz(fmpz_t z, const arb_t x)
{
    if (!arb_is_finite(x))
    {
        return 0;
    }
    else if (arb_is_exact(x))
    {
        /* x = b*2^e, e >= 0 */
        if (arf_is_int(arb_midref(x)))
        {
            /* arf_get_fmpz aborts on overflow */
            arf_get_fmpz(z, arb_midref(x), ARF_RND_DOWN);
            return 1;
        }
        else
        {
            return 0;
        }
    }
    /* if the radius is >= 1, there are at least two integers */
    else if (mag_cmp_2exp_si(arb_radref(x), 0) >= 0)
    {
        return 0;
    }
    /* there are 0 or 1 integers if the radius is < 1 */
    else
    {
        fmpz_t a, b, exp;
        int res;

        /* if the midpoint is exactly an integer, it is what we want */
        if (arf_is_int(arb_midref(x)))
        {
            /* arf_get_fmpz aborts on overflow */
            arf_get_fmpz(z, arb_midref(x), ARF_RND_DOWN);
            return 1;
        }

        fmpz_init(a);
        fmpz_init(b);
        fmpz_init(exp);

        /* if the radius is tiny, it can't be an integer */
        arf_bot(a, arb_midref(x));

        if (fmpz_cmp(a, MAG_EXPREF(arb_radref(x))) > 0)
        {
            res = 0;
        }
        else
        {
            arb_get_interval_fmpz_2exp(a, b, exp, x);

            if (COEFF_IS_MPZ(*exp))
            {
                flint_printf("arb_get_unique_fmpz: input too large\n");
                abort();
            }

            if (*exp >= 0)
            {
                res = fmpz_equal(a, b);

                if (res)
                {
                    fmpz_mul_2exp(a, a, *exp);
                    fmpz_mul_2exp(b, b, *exp);
                }
            }
            else
            {
                fmpz_cdiv_q_2exp(a, a, -(*exp));
                fmpz_fdiv_q_2exp(b, b, -(*exp));
                res = fmpz_equal(a, b);
            }

            if (res)
                fmpz_set(z, a);
        }

        fmpz_clear(a);
        fmpz_clear(b);
        fmpz_clear(exp);

        return res;
    }
}
Beispiel #12
0
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);
}
Beispiel #13
0
/* 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);
}
Beispiel #14
0
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);
}
Beispiel #15
0
/* 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);
}
Beispiel #16
0
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);
}