Esempio n. 1
0
void
acb_real_min(acb_t res, const acb_t x, const acb_t y, int analytic, slong prec)
{
    arb_t t;

    if (!acb_is_finite(x) || !acb_is_finite(y))
    {
        acb_indeterminate(res);
        return;
    }

    arb_init(t);
    arb_sub(t, acb_realref(x), acb_realref(y), prec);

    if (arb_is_positive(t))
        acb_set_round(res, y, prec);
    else if (arb_is_negative(t))
        acb_set_round(res, x, prec);
    else if (!analytic)
        acb_union(res, x, y, prec);
    else
        acb_indeterminate(res);

    arb_clear(t);
}
Esempio n. 2
0
void
acb_hypgeom_fresnel(acb_t res1, acb_t res2, const acb_t z, int normalized, slong prec)
{
    slong wp;
    acb_t w;
    arb_t c;

    if (!acb_is_finite(z))
    {
        if (res1 != NULL) acb_indeterminate(res1);
        if (res2 != NULL) acb_indeterminate(res2);
        return;
    }

    acb_init(w);
    arb_init(c);

    wp = prec + 8;

    if (normalized)
    {
        arb_const_pi(c, wp);
        arb_sqrt(c, c, wp);
        arb_mul_2exp_si(c, c, -1);
        acb_mul_arb(w, z, c, wp);
        acb_hypgeom_fresnel_erf_error(res1, res2, w, wp);
    }
    else
    {
        arb_sqrt_ui(c, 2, wp);
        arb_mul_2exp_si(c, c, -1);
        acb_mul_arb(w, z, c, wp);
        acb_hypgeom_fresnel_erf_error(res1, res2, w, wp);
        arb_const_pi(c, wp);
        arb_mul_2exp_si(c, c, -1);
        arb_sqrt(c, c, wp);

        if (res1 != NULL) acb_mul_arb(res1, res1, c, wp);
        if (res2 != NULL) acb_mul_arb(res2, res2, c, wp);
    }

    if (res1 != NULL)
    {
        acb_mul_2exp_si(res1, res1, -2);
        acb_set_round(res1, res1, prec);
    }

    if (res2 != NULL)
    {
        acb_mul_2exp_si(res2, res2, -2);
        acb_set_round(res2, res2, prec);
    }

    acb_clear(w);
    arb_clear(c);
}
Esempio n. 3
0
void
acb_lambertw(acb_t res, const acb_t z, const fmpz_t k, int flags, slong prec)
{
    acb_t ez1;

    if (!acb_is_finite(z))
    {
        acb_indeterminate(res);
        return;
    }

    if (flags == ACB_LAMBERTW_LEFT)
    {
        acb_lambertw_left(res, z, k, prec);
        return;
    }

    if (flags == ACB_LAMBERTW_MIDDLE)
    {
        acb_lambertw_middle(res, z, prec);
        return;
    }

    if (acb_contains_zero(z) && !fmpz_is_zero(k))
    {
        acb_indeterminate(res);
        return;
    }

    acb_init(ez1);

    /* precompute z*e + 1 */
    arb_const_e(acb_realref(ez1), prec);
    acb_mul(ez1, ez1, z, prec);
    acb_add_ui(ez1, ez1, 1, prec);

    /* Compute standard branches */

    /* use real code when possible */
    if (acb_is_real(z) && arb_is_positive(acb_realref(ez1)) &&
        (fmpz_is_zero(k) ||
        (fmpz_equal_si(k, -1) && arb_is_negative(acb_realref(z)))))
    {
        arb_lambertw(acb_realref(res), acb_realref(z), !fmpz_is_zero(k), prec);
        arb_zero(acb_imagref(res));
    }
    else
    {
        _acb_lambertw(res, z, ez1, k, flags, prec);
    }

    acb_clear(ez1);
}
Esempio n. 4
0
void
acb_log_sin_pi(acb_t res, const acb_t z, slong prec)
{
    if (!acb_is_finite(z))
    {
        acb_indeterminate(res);
        return;
    }

    if (arb_is_positive(acb_imagref(z)) ||
        (arb_is_zero(acb_imagref(z)) && arb_is_negative(acb_realref(z))))
    {
        acb_log_sin_pi_half(res, z, prec, 1);
    }
    else if (arb_is_negative(acb_imagref(z)) ||
        (arb_is_zero(acb_imagref(z)) && arb_is_positive(acb_realref(z))))
    {
        acb_log_sin_pi_half(res, z, prec, 0);
    }
    else
    {
        acb_t t;
        acb_init(t);
        acb_log_sin_pi_half(t, z, prec, 1);
        acb_log_sin_pi_half(res, z, prec, 0);
        arb_union(acb_realref(res), acb_realref(res), acb_realref(t), prec);
        arb_union(acb_imagref(res), acb_imagref(res), acb_imagref(t), prec);
        acb_clear(t);
    }
}
Esempio n. 5
0
void
acb_hypgeom_laguerre_l(acb_t res, const acb_t n, const acb_t m, const acb_t z, slong prec)
{
    acb_t t, u, v;

    if (use_recurrence(n, m, prec))
    {
        acb_hypgeom_laguerre_l_ui_recurrence(res,
            arf_get_si(arb_midref(acb_realref(n)), ARF_RND_DOWN), m, z, prec);
        return;
    }

    /* todo: should be a test of whether n contains any negative integer */
    if (acb_contains_int(n) && !arb_is_nonnegative(acb_realref(n)))
    {
        acb_indeterminate(res);
        return;
    }

    acb_init(t);
    acb_init(u);
    acb_init(v);

    acb_neg(t, n);
    acb_add_ui(u, m, 1, prec);
    acb_hypgeom_m(t, t, u, z, 1, prec);
    acb_add_ui(u, n, 1, prec);
    acb_rising(u, u, m, prec);
    acb_mul(res, t, u, prec);

    acb_clear(t);
    acb_clear(u);
    acb_clear(v);
}
Esempio n. 6
0
File: erf.c Progetto: isuruf/arb
void
acb_hypgeom_erf(acb_t res, const acb_t z, slong prec)
{
    double x, y, absz2, logz;
    slong prec2;

    if (!acb_is_finite(z))
    {
        acb_indeterminate(res);
        return;
    }

    if (acb_is_zero(z))
    {
        acb_zero(res);
        return;
    }

    if ((arf_cmpabs_2exp_si(arb_midref(acb_realref(z)), 0) < 0 &&
            arf_cmpabs_2exp_si(arb_midref(acb_imagref(z)), 0) < 0))
    {
        acb_hypgeom_erf_1f1a(res, z, prec);
        return;
    }

    if ((arf_cmpabs_2exp_si(arb_midref(acb_realref(z)), 64) > 0 ||
            arf_cmpabs_2exp_si(arb_midref(acb_imagref(z)), 64) > 0))
    {
        acb_hypgeom_erf_asymp(res, z, prec, prec);
        return;
    }

    x = arf_get_d(arb_midref(acb_realref(z)), ARF_RND_DOWN);
    y = arf_get_d(arb_midref(acb_imagref(z)), ARF_RND_DOWN);

    absz2 = x * x + y * y;
    logz = 0.5 * log(absz2);

    if (logz - absz2 < -(prec + 8) * 0.69314718055994530942)
    {
        /* If the asymptotic term is small, we can
           compute with reduced precision */
        prec2 = FLINT_MIN(prec + 4 + (y*y - x*x - logz) * 1.4426950408889634074, (double) prec);
        prec2 = FLINT_MAX(8, prec2);
        prec2 = FLINT_MIN(prec2, prec);

        acb_hypgeom_erf_asymp(res, z, prec, prec2);
    }
    else if (arf_cmpabs(arb_midref(acb_imagref(z)), arb_midref(acb_realref(z))) > 0)
    {
        acb_hypgeom_erf_1f1a(res, z, prec);
    }
    else
    {
        acb_hypgeom_erf_1f1b(res, z, prec);
    }
}
Esempio n. 7
0
void
acb_lambertw_left(acb_t res, const acb_t z, const fmpz_t k, slong prec)
{
    if (acb_contains_zero(z) && !(fmpz_equal_si(k, -1) && acb_is_real(z)))
    {
        acb_indeterminate(res);
        return;
    }

    if (arb_is_positive(acb_imagref(z)))
    {
        acb_lambertw(res, z, k, 0, prec);
    }
    else if (arb_is_nonpositive(acb_imagref(z)))
    {
        fmpz_t kk;
        fmpz_init(kk);
        fmpz_add_ui(kk, k, 1);
        fmpz_neg(kk, kk);

        acb_conj(res, z);
        acb_lambertw(res, res, kk, 0, prec);
        acb_conj(res, res);

        fmpz_clear(kk);
    }
    else
    {
        acb_t za, zb;
        fmpz_t kk;

        acb_init(za);
        acb_init(zb);
        fmpz_init(kk);

        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));

        fmpz_add_ui(kk, k, 1);
        fmpz_neg(kk, kk);

        acb_lambertw(za, za, k, 0, prec);
        acb_lambertw(zb, zb, kk, 0, prec);
        acb_conj(zb, zb);

        acb_union(res, za, zb, prec);

        acb_clear(za);
        acb_clear(zb);
        fmpz_clear(kk);
    }
}
Esempio n. 8
0
int
f_lambertw(acb_ptr res, const acb_t z, void * param, slong order, slong prec)
{
    acb_t t;

    if (order > 1)
        flint_abort();  /* Would be needed for Taylor method. */

    acb_init(t);

    prec = FLINT_MIN(prec, acb_rel_accuracy_bits(z) + 10);

    if (order != 0)
    {
        /* check for branch cut */
        arb_const_e(acb_realref(t), prec);
        acb_inv(t, t, prec);
        acb_add(t, t, z, prec);

        if (arb_contains_zero(acb_imagref(t)) &&
            arb_contains_nonpositive(acb_realref(t)))
        {
            acb_indeterminate(t);
        }
    }

    if (acb_is_finite(t))
    {
        fmpz_t k;
        fmpz_init(k);
        acb_lambertw(res, z, k, 0, prec);
        fmpz_clear(k);
    }
    else
    {
        acb_indeterminate(res);
    }

    acb_clear(t);

    return 0;
}
Esempio n. 9
0
void
acb_mat_det(acb_t det, const acb_mat_t A, slong prec)
{
    slong n;

    if (!acb_mat_is_square(A))
    {
        flint_printf("acb_mat_det: a square matrix is required!\n");
        flint_abort();
    }

    n = acb_mat_nrows(A);

    if (n == 0)
    {
        acb_one(det);
    }
    else if (n == 1)
    {
        acb_set_round(det, acb_mat_entry(A, 0, 0), prec);
    }
    else if (n == 2)
    {
        _acb_mat_det_cofactor_2x2(det, A, prec);
    }
    else if (!acb_mat_is_finite(A))
    {
        acb_indeterminate(det);
    }
    else if (acb_mat_is_tril(A) || acb_mat_is_triu(A))
    {
        acb_mat_diag_prod(det, A, prec);
    }
    else if (n == 3)
    {
        _acb_mat_det_cofactor_3x3(det, A, prec);
        /* note: 4x4 performs worse than LU */
    }
    else
    {
        if (n <= 14 || prec > 10.0 * n)
            acb_mat_det_lu(det, A, prec);
        else
            acb_mat_det_precond(det, A, prec);
    }
}
Esempio n. 10
0
void
acb_hypgeom_airy(acb_t ai, acb_t aip, acb_t bi, acb_t bip, const acb_t z, slong prec)
{
    arf_srcptr re, im;
    double x, y, t, zmag, z15, term_est, airy_est, abstol;
    slong n, wp;

    if (!acb_is_finite(z))
    {
        if (ai != NULL) acb_indeterminate(ai);
        if (aip != NULL) acb_indeterminate(aip);
        if (bi != NULL) acb_indeterminate(bi);
        if (bip != NULL) acb_indeterminate(bip);
        return;
    }

    re = arb_midref(acb_realref(z));
    im = arb_midref(acb_imagref(z));
    wp = prec * 1.03 + 15;

    /* tiny input -- use direct method and pick n without underflowing */
    if (arf_cmpabs_2exp_si(re, -64) < 0 && arf_cmpabs_2exp_si(im, -64) < 0)
    {
        if (arf_cmpabs_2exp_si(re, -wp) < 0 && arf_cmpabs_2exp_si(im, -wp) < 0)
        {
            n = 1;  /* very tiny input */
        }
        else
        {
            if (arf_cmpabs(re, im) > 0)
                zmag = fmpz_get_d(ARF_EXPREF(re));
            else
                zmag = fmpz_get_d(ARF_EXPREF(im));
            zmag = (zmag + 1) * (1.0 / LOG2);
            n = wp / (-zmag) + 1;
        }

        acb_hypgeom_airy_direct(ai, aip, bi, bip, z, n, wp);
    }  /* huge input -- use asymptotics and pick n without overflowing */
    else if ((arf_cmpabs_2exp_si(re, 64) > 0 || arf_cmpabs_2exp_si(im, 64) > 0))
    {
        if (arf_cmpabs_2exp_si(re, prec) > 0 || arf_cmpabs_2exp_si(im, prec) > 0)
        {
            n = 1;   /* very huge input */
        }
        else
        {
            x = fmpz_get_d(ARF_EXPREF(re));
            y = fmpz_get_d(ARF_EXPREF(im));
            zmag = (FLINT_MAX(x, y) - 2) * (1.0 / LOG2);
            n = asymp_pick_terms(wp, zmag);
            n = FLINT_MAX(n, 1);
        }

        acb_hypgeom_airy_asymp(ai, aip, bi, bip, z, n, wp);
    }
    else /* moderate input */
    {
        x = arf_get_d(re, ARF_RND_DOWN);
        y = arf_get_d(im, ARF_RND_DOWN);

        zmag = sqrt(x * x + y * y);
        z15 = zmag * sqrt(zmag);

        if (zmag >= 4.0 && (n = asymp_pick_terms(wp, log(zmag))) != -1)
        {
            acb_hypgeom_airy_asymp(ai, aip, bi, bip, z, n, wp);
        }
        else if (zmag <= 1.5)
        {
            t = 3 * (wp * LOG2) / (2 * z15 * EXP1);
            t = (wp * LOG2) / (2 * d_lambertw(t));
            n = FLINT_MAX(t + 1, 2);
            acb_hypgeom_airy_direct(ai, aip, bi, bip, z, n, wp);
        }
        else
        {
            /* estimate largest term: log2(exp(2(z^3/9)^(1/2))) */
            term_est = 0.96179669392597560491 * z15;

            /* estimate the smaller of Ai and Bi */
            airy_est = estimate_airy(x, y, (ai != NULL || aip != NULL));

            /* estimate absolute tolerance and necessary working precision */
            abstol = airy_est - wp;
            wp = wp + term_est - airy_est;
            wp = FLINT_MAX(wp, 10);

            t = 3 * (-abstol * LOG2) / (2 * z15 * EXP1);
            t = (-abstol * LOG2) / (2 * d_lambertw(t));
            n = FLINT_MAX(t + 1, 2);

            if (acb_is_exact(z))
                acb_hypgeom_airy_direct(ai, aip, bi, bip, z, n, wp);
            else
                acb_hypgeom_airy_direct_prop(ai, aip, bi, bip, z, n, wp);
        }
    }

    if (ai != NULL) acb_set_round(ai, ai, prec);
    if (aip != NULL) acb_set_round(aip, aip, prec);
    if (bi != NULL) acb_set_round(bi, bi, prec);
    if (bip != NULL) acb_set_round(bip, bip, prec);
}
Esempio n. 11
0
void
acb_hypgeom_bessel_i_asymp(acb_t res, const acb_t nu, const acb_t z, long prec)
{
    acb_t A1, A2, C, U1, U2, s, t, u;
    int is_real, is_imag;

    acb_init(A1);
    acb_init(A2);
    acb_init(C);
    acb_init(U1);
    acb_init(U2);
    acb_init(s);
    acb_init(t);
    acb_init(u);

    is_imag = 0;
    is_real = acb_is_real(nu) && acb_is_real(z)
        && (acb_is_int(nu) || arb_is_positive(acb_realref(z)));

    if (!is_real && arb_is_zero(acb_realref(z)) && acb_is_int(nu))
    {
        acb_mul_2exp_si(t, nu, -1);

        if (acb_is_int(t))
            is_real = 1;
        else
            is_imag = 1;
    }

    acb_hypgeom_bessel_i_asymp_prefactors(A1, A2, C, nu, z, prec);

    /* todo: if Ap ~ 2^a and Am = 2^b and U1 ~ U2 ~ 1, change precision? */

    if (!acb_is_finite(A1) || !acb_is_finite(A2) || !acb_is_finite(C))
    {
        acb_indeterminate(res);
    }
    else
    {
        /* s = 1/2 + nu */
        acb_one(s);
        acb_mul_2exp_si(s, s, -1);
        acb_add(s, s, nu, prec);

        /* t = 1 + 2 nu */
        acb_mul_2exp_si(t, nu, 1);
        acb_add_ui(t, t, 1, prec);

        acb_mul_2exp_si(u, z, 1);
        acb_hypgeom_u_asymp(U1, s, t, u, -1, prec);
        acb_neg(u, u);
        acb_hypgeom_u_asymp(U2, s, t, u, -1, prec);

        acb_mul(res, A1, U1, prec);
        acb_addmul(res, A2, U2, prec);
        acb_mul(res, res, C, prec);

        if (is_real)
            arb_zero(acb_imagref(res));
        if (is_imag)
            arb_zero(acb_realref(res));
    }

    acb_clear(A1);
    acb_clear(A2);
    acb_clear(C);
    acb_clear(U1);
    acb_clear(U2);
    acb_clear(s);
    acb_clear(t);
    acb_clear(u);
}
Esempio n. 12
0
void
_acb_hypgeom_legendre_q_single(acb_t res, const acb_t n, const acb_t m,
    const acb_t z, slong prec)
{
    acb_t a, b, c, z2, t, u;

    acb_init(a);
    acb_init(b);
    acb_init(c);
    acb_init(z2);
    acb_init(t);
    acb_init(u);

    /* invalid in (-1,0) */
    if (!_acb_hypgeom_legendre_q_single_valid(z))
    {
        acb_indeterminate(res);
        return;
    }

    acb_pow_si(z2, z, -2, prec); /* z2 = 1/z^2 */

    /* t = 2F1r((m+n+1)/2, (m+n)/2+1, n+3/2, 1/z^2) */
    acb_add(b, m, n, prec);
    acb_add_ui(a, b, 1, prec);
    acb_mul_2exp_si(a, a, -1);
    acb_mul_2exp_si(b, b, -1);
    acb_add_ui(b, b, 1, prec);
    acb_set_ui(c, 3);
    acb_mul_2exp_si(c, c, -1);
    acb_add(c, c, n, prec);
    acb_hypgeom_2f1(t, a, b, c, z2, 1, prec);

    /* prefactor sqrt(pi) 2^-n (z+1)^(m/2) (z-1)^(m/2) exp(i pi m) */
    /*           (1/2) gamma(m+n+1) z^(-m-n-1) */
    if (!acb_is_zero(m))
    {
        acb_add_ui(z2, z, 1, prec);
        acb_mul_2exp_si(c, m, -1);
        acb_pow(z2, z2, c, prec);
        acb_mul(t, t, z2, prec);

        acb_sub_ui(z2, z, 1, prec);
        acb_mul_2exp_si(c, m, -1);
        acb_pow(z2, z2, c, prec);
        acb_mul(t, t, z2, prec);

        acb_exp_pi_i(z2, m, prec);
        acb_mul(t, t, z2, prec);
    }

    acb_set_ui(z2, 2);
    acb_neg(c, n);
    acb_pow(z2, z2, c, prec);
    acb_mul(t, t, z2, prec);

    acb_add(c, m, n, prec);
    acb_add_ui(c, c, 1, prec);
    acb_gamma(z2, c, prec);
    acb_mul(t, t, z2, prec);

    acb_neg(c, c);
    acb_pow(z2, z, c, prec);
    acb_mul(t, t, z2, prec);

    acb_mul_2exp_si(t, t, -1);

    arb_const_sqrt_pi(acb_realref(u), prec);
    acb_mul_arb(t, t, acb_realref(u), prec);

    acb_set(res, t);

    acb_clear(a);
    acb_clear(b);
    acb_clear(c);
    acb_clear(z2);
    acb_clear(t);
    acb_clear(u);
}
Esempio n. 13
0
void
acb_hypgeom_erf(acb_t res, const acb_t z, slong prec)
{
    double x, y, abs_z2, log_z, log_erf_z_asymp;
    slong prec2, wp;
    int more_imaginary;

    if (!acb_is_finite(z))
    {
        acb_indeterminate(res);
        return;
    }

    if (acb_is_zero(z))
    {
        acb_zero(res);
        return;
    }

    if ((arf_cmpabs_2exp_si(arb_midref(acb_realref(z)), -64) < 0 &&
         arf_cmpabs_2exp_si(arb_midref(acb_imagref(z)), -64) < 0))
    {
        acb_hypgeom_erf_1f1(res, z, prec, prec, 1);
        return;
    }

    if ((arf_cmpabs_2exp_si(arb_midref(acb_realref(z)), 64) > 0 ||
         arf_cmpabs_2exp_si(arb_midref(acb_imagref(z)), 64) > 0))
    {
        acb_hypgeom_erf_asymp(res, z, 0, prec, prec);
        return;
    }

    x = arf_get_d(arb_midref(acb_realref(z)), ARF_RND_DOWN);
    y = arf_get_d(arb_midref(acb_imagref(z)), ARF_RND_DOWN);

    abs_z2 = x * x + y * y;
    log_z = 0.5 * log(abs_z2);
    /* estimate of log(erf(z)), disregarding csgn term */
    log_erf_z_asymp = y*y - x*x - log_z;

    if (log_z - abs_z2 < -(prec + 8) * 0.69314718055994530942)
    {
        /* If the asymptotic term is small, we can
           compute with reduced precision. */
        prec2 = FLINT_MIN(prec + 4 + log_erf_z_asymp * 1.4426950408889634074, (double) prec);
        prec2 = FLINT_MAX(8, prec2);
        prec2 = FLINT_MIN(prec2, prec);

        acb_hypgeom_erf_asymp(res, z, 0, prec, prec2);
    }
    else
    {
        more_imaginary = arf_cmpabs(arb_midref(acb_imagref(z)),
                                    arb_midref(acb_realref(z))) > 0;

        /* Worst case: exp(|x|^2), computed: exp(x^2).
           (x^2+y^2) - (x^2-y^2) = 2y^2, etc. */
        if (more_imaginary)
            wp = prec + FLINT_MAX(2 * x * x, 0.0) * 1.4426950408889634074 + 5;
        else
            wp = prec + FLINT_MAX(2 * y * y, 0.0) * 1.4426950408889634074 + 5;

        acb_hypgeom_erf_1f1(res, z, prec, wp, more_imaginary);
    }
}
Esempio n. 14
0
void
_acb_poly_zeta_cpx_series(acb_ptr z, const acb_t s, const acb_t a, int deflate, slong d, slong prec)
{
    ulong M, N;
    slong i, bound_prec;
    mag_t bound;
    arb_ptr vb;
    int is_real, const_is_real;

    if (d < 1)
        return;

    if (!acb_is_finite(s) || !acb_is_finite(a))
    {
        _acb_vec_indeterminate(z, d);
        return;
    }

    if (acb_is_one(s) && deflate && d == 1)
    {
        acb_digamma(z, a, prec);
        acb_neg(z, z);
        if (!acb_is_finite(z))  /* todo: in digamma */
            acb_indeterminate(z);
        return;
    }

    is_real = const_is_real = 0;

    if (acb_is_real(s) && acb_is_real(a))
    {
        if (arb_is_positive(acb_realref(a)))
        {
            is_real = const_is_real = 1;
        }
        else if (arb_is_int(acb_realref(a)) &&
             arb_is_int(acb_realref(s)) &&
             arb_is_nonpositive(acb_realref(s)))
        {
            const_is_real = 1;
        }
    }

    mag_init(bound);
    vb = _arb_vec_init(d);

    bound_prec = 40 + prec / 20;

    _acb_poly_zeta_em_choose_param(bound, &N, &M, s, a, FLINT_MIN(d, 2), prec, bound_prec);
    _acb_poly_zeta_em_bound(vb, s, a, N, M, d, bound_prec);

    _acb_poly_zeta_em_sum(z, s, a, deflate, N, M, d, prec);

    for (i = 0; i < d; i++)
    {
        arb_get_mag(bound, vb + i);
        arb_add_error_mag(acb_realref(z + i), bound);

        if (!is_real && !(i == 0 && const_is_real))
            arb_add_error_mag(acb_imagref(z + i), bound);
    }

    mag_clear(bound);
    _arb_vec_clear(vb, d);
}
Esempio n. 15
0
int main()
{
    long iter;
    flint_rand_t state;

    printf("legendre_q....");
    fflush(stdout);

    flint_randinit(state);

    for (iter = 0; iter < 1000; iter++)
    {
        acb_t n, m, z, res1, res2;
        long prec1, prec2, ebits;

        acb_init(n);
        acb_init(m);
        acb_init(z);
        acb_init(res1);
        acb_init(res2);

        prec1 = 2 + n_randint(state, 300);
        prec2 = 2 + n_randint(state, 300);
        ebits = 1 + n_randint(state, 10);

        if (n_randint(state, 2))
        {
            acb_set_si(m, n_randint(state, 20) - 10);
            acb_set_si(n, n_randint(state, 20) - 10);
        }
        else
        {
            acb_randtest_param(n, state, 1 + n_randint(state, 400), ebits);
            acb_randtest_param(m, state, 1 + n_randint(state, 400), ebits);
        }

        acb_randtest_param(z, state, 1 + n_randint(state, 400), ebits);

        _acb_hypgeom_legendre_q_single(res1, n, m, z, prec1);
        _acb_hypgeom_legendre_q_double(res2, n, m, z, prec2);

        if (!acb_overlaps(res1, res2))
        {
            printf("FAIL: consistency 1\n\n");
            printf("iter = %ld, prec1 = %ld, prec2 = %ld\n\n", iter, prec1, prec2);
            printf("m = "); acb_printd(m, 30); printf("\n\n");
            printf("n = "); acb_printd(n, 30); printf("\n\n");
            printf("z = "); acb_printd(z, 30); printf("\n\n");
            printf("res1 = "); acb_printd(res1, 30); printf("\n\n");
            printf("res2 = "); acb_printd(res2, 30); printf("\n\n");
            abort();
        }

        acb_clear(n);
        acb_clear(m);
        acb_clear(z);
        acb_clear(res1);
        acb_clear(res2);
    }

    for (iter = 0; iter < 2000; iter++)
    {
        acb_t n, m, z, res1, res2, t, u;
        long prec1, prec2, ebits;
        int type;

        acb_init(n);
        acb_init(m);
        acb_init(z);
        acb_init(res1);
        acb_init(res2);
        acb_init(t);
        acb_init(u);

        prec1 = 2 + n_randint(state, 300);
        prec2 = 2 + n_randint(state, 300);
        ebits = 1 + n_randint(state, 10);

        if (n_randint(state, 2))
        {
            acb_set_si(m, n_randint(state, 20) - 10);
            acb_set_si(n, n_randint(state, 20) - 10);
        }
        else
        {
            acb_randtest_param(n, state, 1 + n_randint(state, 400), ebits);
            acb_randtest_param(m, state, 1 + n_randint(state, 400), ebits);
        }

        acb_randtest_param(z, state, 1 + n_randint(state, 400), ebits);

        type = n_randint(state, 2);

        acb_hypgeom_legendre_q(res1, n, m, z, type, prec1);

        acb_neg(t, m);
        acb_hypgeom_legendre_p(res2, n, t, z, type, prec2);
        acb_add(u, m, n, prec2);
        acb_add_ui(u, u, 1, prec2);
        acb_gamma(u, u, prec2);
        acb_mul(res2, res2, u, prec2);
        acb_sub(u, n, m, prec2);
        acb_add_ui(u, u, 1, prec2);
        acb_rgamma(u, u, prec2);
        acb_mul(res2, res2, u, prec2);

        acb_hypgeom_legendre_p(t, n, m, z, type, prec2);

        if (type == 0)
        {
            acb_cos_pi(u, m, prec2);
            acb_mul(t, t, u, prec2);
        }
        acb_sub(res2, t, res2, prec2);

        if (type == 1)
        {
            acb_exp_pi_i(t, m, prec2);
            acb_mul(res2, res2, t, prec2);
        }

        acb_sin_pi(t, m, prec2);

        if (acb_contains_zero(t))
            acb_indeterminate(res2);
        else
            acb_div(res2, res2, t, prec2);

        acb_const_pi(t, prec2);
        acb_mul(res2, res2, t, prec2);
        acb_mul_2exp_si(res2, res2, -1);

        if (!acb_overlaps(res1, res2))
        {
            printf("FAIL: consistency 2\n\n");
            printf("iter = %ld, prec1 = %ld, prec2 = %ld\n\n", iter, prec1, prec2);
            printf("type = %d\n\n", type);
            printf("m = "); acb_printd(m, 30); printf("\n\n");
            printf("n = "); acb_printd(n, 30); printf("\n\n");
            printf("z = "); acb_printd(z, 30); printf("\n\n");
            printf("res1 = "); acb_printd(res1, 30); printf("\n\n");
            printf("res2 = "); acb_printd(res2, 30); printf("\n\n");
            abort();
        }

        acb_clear(n);
        acb_clear(m);
        acb_clear(z);
        acb_clear(res1);
        acb_clear(res2);
        acb_clear(t);
        acb_clear(u);
    }

    flint_randclear(state);
    flint_cleanup();
    printf("PASS\n");
    return EXIT_SUCCESS;
}
Esempio n. 16
0
void
acb_hypgeom_2f1_transform_nolimit(acb_t res, const acb_t a, const acb_t b,
    const acb_t c, const acb_t z, int regularized, int which, slong prec)
{
    acb_t ba, ca, cb, cab, ac1, bc1, ab1, ba1, w, t, u, v, s;

    if (acb_contains_zero(z) || !acb_is_finite(z))
    {
        acb_indeterminate(res);
        return;
    }

    if (arb_contains_si(acb_realref(z), 1) && arb_contains_zero(acb_imagref(z)))
    {
        acb_indeterminate(res);
        return;
    }

    if (!regularized)
    {
        acb_init(t);
        acb_gamma(t, c, prec);
        acb_hypgeom_2f1_transform_nolimit(res, a, b, c, z, 1, which, prec);
        acb_mul(res, res, t, prec);
        acb_clear(t);
        return;
    }

    acb_init(ba);
    acb_init(ca); acb_init(cb); acb_init(cab);
    acb_init(ac1); acb_init(bc1);
    acb_init(ab1); acb_init(ba1);
    acb_init(w); acb_init(t);
    acb_init(u); acb_init(v);
    acb_init(s);

    acb_add_si(s, z, -1, prec);   /* s = 1 - z */
    acb_neg(s, s);

    acb_sub(ba, b, a, prec);      /* ba = b - a */
    acb_sub(ca, c, a, prec);      /* ca = c - a */
    acb_sub(cb, c, b, prec);      /* cb = c - b */
    acb_sub(cab, ca, b, prec);    /* cab = c - a - b */

    acb_add_si(ac1, ca, -1, prec); acb_neg(ac1, ac1); /* ac1 = a - c + 1 */
    acb_add_si(bc1, cb, -1, prec); acb_neg(bc1, bc1); /* bc1 = b - c + 1 */
    acb_add_si(ab1, ba, -1, prec); acb_neg(ab1, ab1); /* ab1 = a - b + 1 */
    acb_add_si(ba1, ba, 1, prec);                     /* ba1 = b - a + 1 */

    /* t = left term, u = right term (DLMF 15.8.1 - 15.8.5) */
    if (which == 2)
    {
        acb_inv(w, z, prec);  /* w = 1/z */
        acb_hypgeom_2f1_direct(t, a, ac1, ab1, w, 1, prec);
        acb_hypgeom_2f1_direct(u, b, bc1, ba1, w, 1, prec);
    }
    else if (which == 3)
    {
        acb_inv(w, s, prec);  /* w = 1/(1-z) */
        acb_hypgeom_2f1_direct(t, a, cb, ab1, w, 1, prec);
        acb_hypgeom_2f1_direct(u, b, ca, ba1, w, 1, prec);
    }
    else if (which == 4)
    {
        acb_set(w, s);                  /* w = 1-z */
        acb_add(v, ac1, b, prec);       /* v = a+b-c+1 */
        acb_hypgeom_2f1_direct(t, a, b, v, w, 1, prec);
        acb_add_si(v, cab, 1, prec);    /* v = c-a-b+1 */
        acb_hypgeom_2f1_direct(u, ca, cb, v, w, 1, prec);
    }
    else if (which == 5)
    {
        acb_inv(w, z, prec);  /* w = 1-1/z */
        acb_neg(w, w);
        acb_add_si(w, w, 1, prec);
        acb_add(v, ac1, b, prec);       /* v = a+b-c+1 */
        acb_hypgeom_2f1_direct(t, a, ac1, v, w, 1, prec);
        acb_add_si(v, cab, 1, prec);    /* v = c-a-b+1 */
        acb_add_si(u, a, -1, prec);     /* u = 1-a */
        acb_neg(u, u);
        acb_hypgeom_2f1_direct(u, ca, u, v, w, 1, prec);
    }
    else
    {
        flint_printf("invalid transformation!\n");
        flint_abort();
    }

    /* gamma factors */
    acb_rgamma(v, a, prec);
    acb_mul(u, u, v, prec);
    acb_rgamma(v, ca, prec);
    acb_mul(t, t, v, prec);

    acb_rgamma(v, b, prec);
    if (which == 2 || which == 3)
        acb_mul(t, t, v, prec);
    else
        acb_mul(u, u, v, prec);

    acb_rgamma(v, cb, prec);
    if (which == 2 || which == 3)
        acb_mul(u, u, v, prec);
    else
        acb_mul(t, t, v, prec);

    if (which == 2 || which == 3)
    {
        if (which == 2)
            acb_neg(s, z);  /* -z, otherwise 1-z since before */

        acb_neg(v, a);
        acb_pow(v, s, v, prec);
        acb_mul(t, t, v, prec);

        acb_neg(v, b);
        acb_pow(v, s, v, prec);
        acb_mul(u, u, v, prec);
    }
    else
    {
        acb_pow(v, s, cab, prec);
        acb_mul(u, u, v, prec);

        if (which == 5)
        {
            acb_neg(v, a);
            acb_pow(v, z, v, prec);
            acb_mul(t, t, v, prec);

            acb_neg(v, ca);
            acb_pow(v, z, v, prec);
            acb_mul(u, u, v, prec);
        }
    }

    acb_sub(t, t, u, prec);

    if (which == 2 || which == 3)
        acb_sin_pi(v, ba, prec);
    else
        acb_sin_pi(v, cab, prec);

    acb_div(t, t, v, prec);
    acb_const_pi(v, prec);
    acb_mul(t, t, v, prec);
    acb_set(res, t);

    acb_clear(ba);
    acb_clear(ca); acb_clear(cb); acb_clear(cab);
    acb_clear(ac1); acb_clear(bc1);
    acb_clear(ab1); acb_clear(ba1);
    acb_clear(w); acb_clear(t);
    acb_clear(u); acb_clear(v);
    acb_clear(s);
}
Esempio n. 17
0
void
acb_dirichlet_l(acb_t res, const acb_t s,
    const dirichlet_group_t G, const dirichlet_char_t chi, slong prec)
{
    if (!acb_is_finite(s))
    {
        acb_indeterminate(res);
    }
    else if (G == NULL || G->q == 1)
    {
        acb_dirichlet_zeta(res, s, prec);
    }
    else if (dirichlet_char_is_primitive(G, chi) &&
        (arf_cmp_d(arb_midref(acb_realref(s)), -0.5) < 0 ||
            (G->q != 1 && dirichlet_parity_char(G, chi) == 0 &&
                arf_cmpabs_d(arb_midref(acb_imagref(s)), 0.125) < 0 &&
                arf_cmp_d(arb_midref(acb_realref(s)), 0.125) < 0)))
    {
        /* use functional equation */
        acb_t t, u, v;
        int parity;
        ulong q;

        parity = dirichlet_parity_char(G, chi);
        q = G->q;

        acb_init(t);
        acb_init(u);
        acb_init(v);

        /* gamma((1-s+p)/2) / gamma((s+p)/2) */
        acb_add_ui(t, s, parity, prec);
        acb_mul_2exp_si(t, t, -1);
        acb_rgamma(t, t, prec);

        if (!acb_is_zero(t))  /* assumes q != 1 when s = 0 */
        {
            acb_neg(u, s);
            acb_add_ui(u, u, 1 + parity, prec);
            acb_mul_2exp_si(u, u, -1);
            acb_gamma(u, u, prec);
            acb_mul(t, t, u, prec);

            /* epsilon */
            acb_dirichlet_root_number(u, G, chi, prec);
            acb_mul(t, t, u, prec);

            /* (pi/q)^(s-1/2) */
            acb_const_pi(u, prec);
            acb_div_ui(u, u, q, prec);
            acb_set_d(v, -0.5);
            acb_add(v, v, s, prec);
            acb_pow(u, u, v, prec);
            acb_mul(t, t, u, prec);

            acb_sub_ui(u, s, 1, prec);
            acb_neg(u, u);
            acb_conj(u, u);
            acb_dirichlet_l_general(u, u, G, chi, prec);
            acb_conj(u, u);
            acb_mul(t, t, u, prec);

            if (dirichlet_char_is_real(G, chi) && acb_is_real(s))
                arb_zero(acb_imagref(t));
        }

        acb_set(res, t);

        acb_clear(t);
        acb_clear(u);
        acb_clear(v);
    }
    else
    {
        acb_dirichlet_l_general(res, s, G, chi, prec);
    }
}
Esempio n. 18
0
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
}
Esempio n. 19
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);
}
Esempio n. 20
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);
}
Esempio n. 21
0
void
acb_lambertw_middle(acb_t res, const acb_t z, slong prec)
{
    fmpz_t k;

    if (acb_contains_zero(z))
    {
        acb_indeterminate(res);
        return;
    }

    fmpz_init(k);
    fmpz_set_si(k, -1);

    if (arb_is_positive(acb_imagref(z)))
    {
        acb_lambertw(res, z, k, 0, prec);
    }
    else if (arb_is_negative(acb_imagref(z)))
    {
        acb_conj(res, z);
        acb_lambertw(res, res, k, 0, prec);
        acb_conj(res, res);
    }
    else if (arb_is_negative(acb_realref(z)))
    {
        if (arb_is_nonnegative(acb_imagref(z)))
        {
            acb_lambertw(res, z, k, 0, prec);
        }
        else if (arb_is_negative(acb_imagref(z)))
        {
            acb_conj(res, z);
            acb_lambertw(res, res, k, 0, prec);
            acb_conj(res, res);
        }
        else
        {
            acb_t za, zb;
            acb_init(za);
            acb_init(zb);
            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_lambertw(za, za, k, 0, prec);
            acb_lambertw(zb, zb, k, 0, prec);
            acb_conj(zb, zb);
            acb_union(res, za, zb, prec);
            acb_clear(za);
            acb_clear(zb);
        }
    }
    else /* re is positive */
    {
        if (arb_is_positive(acb_imagref(z)))
        {
            acb_lambertw(res, z, k, 0, prec);
        }
        else if (arb_is_nonpositive(acb_imagref(z)))
        {
            acb_conj(res, z);
            acb_lambertw(res, res, k, 0, prec);
            acb_conj(res, res);
        }
        else
        {
            acb_t za, zb;
            acb_init(za);
            acb_init(zb);
            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_lambertw(za, za, k, 0, prec);
            acb_lambertw(zb, zb, k, 0, prec);
            acb_conj(zb, zb);
            acb_union(res, za, zb, prec);
            acb_clear(za);
            acb_clear(zb);
        }
    }

    fmpz_clear(k);
}
Esempio n. 22
0
void
acb_hypgeom_2f1_transform(acb_t res, const acb_t a, const acb_t b,
    const acb_t c, const acb_t z, int flags, int which, slong prec)
{
    int regularized;

    regularized = flags & ACB_HYPGEOM_2F1_REGULARIZED;

    if (which == 1)
    {
        acb_t t, u, v;

        acb_init(t);
        acb_init(u);
        acb_init(v);

        acb_sub_ui(t, z, 1, prec); /* t = z-1 */
        acb_div(u, z, t, prec); /* u = z/(z-1) */
        acb_neg(t, t);
        acb_neg(v, a);
        acb_pow(t, t, v, prec); /* t = (1-z)^-a */
        acb_sub(v, c, b, prec); /* v = c-b */

        /* We cannot use regularized=1 directly, since if c is a nonnegative
           integer, the transformation formula reads (lhs) * 0 = (rhs) * 0. */
        acb_hypgeom_2f1_direct(u, a, v, c, u, 1, prec);

        if (!regularized)
        {
            acb_gamma(v, c, prec);
            acb_mul(u, u, v, prec);
        }

        acb_mul(res, u, t, prec);


        acb_clear(t);
        acb_clear(u);
        acb_clear(v);
    }
    else
    {
        acb_t d;
        int limit;

        acb_init(d);

        if (which == 2 || which == 3)
        {
            if (flags & ACB_HYPGEOM_2F1_AB)
            {
                limit = 1;
            }
            else
            {
                acb_sub(d, b, a, prec);
                limit = acb_is_int(d);
            }
        }
        else
        {
            if (flags & ACB_HYPGEOM_2F1_ABC)
            {
                limit = 1;
            }
            else
            {
                acb_sub(d, c, a, prec);
                acb_sub(d, d, b, prec);
                limit = acb_is_int(d);
            }
        }

        if (limit)
            acb_hypgeom_2f1_transform_limit(res, a, b, c, z, regularized, which, prec);
        else
            acb_hypgeom_2f1_transform_nolimit(res, a, b, c, z, regularized, which, prec);

        acb_clear(d);
    }

    if (!acb_is_finite(res))
        acb_indeterminate(res);
}
Esempio n. 23
0
/* 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);
}
Esempio n. 24
0
File: 2f1.c Progetto: argriffing/arb
void
acb_hypgeom_2f1(acb_t res, const acb_t a, const acb_t b,
        const acb_t c, const acb_t z, int flags, slong prec)
{
    int algorithm, regularized;

    regularized = flags & ACB_HYPGEOM_2F1_REGULARIZED;

    if (!acb_is_finite(a) || !acb_is_finite(b) || !acb_is_finite(c) || !acb_is_finite(z))
    {
        acb_indeterminate(res);
        return;
    }

    if (acb_is_zero(z))
    {
        if (regularized)
            acb_rgamma(res, c, prec);
        else
            acb_one(res);
        return;
    }

    if (regularized && acb_is_int(c) && arb_is_nonpositive(acb_realref(c)))
    {
        if ((acb_is_int(a) && arb_is_nonpositive(acb_realref(a)) &&
            arf_cmp(arb_midref(acb_realref(a)), arb_midref(acb_realref(c))) >= 0) ||
            (acb_is_int(b) && arb_is_nonpositive(acb_realref(b)) &&
            arf_cmp(arb_midref(acb_realref(b)), arb_midref(acb_realref(c))) >= 0))
        {
            acb_zero(res);
            return;
        }
    }

    if (regularized && acb_eq(a, c))
    {
        _acb_hypgeom_2f1r_reduced(res, b, c, z, prec);
        return;
    }

    if (regularized && acb_eq(b, c))
    {
        _acb_hypgeom_2f1r_reduced(res, a, c, z, prec);
        return;
    }

    /* polynomial */
    if (acb_is_int(a) && arf_sgn(arb_midref(acb_realref(a))) <= 0 &&
         arf_cmpabs_ui(arb_midref(acb_realref(a)), prec) < 0)
    {
        acb_hypgeom_2f1_direct(res, a, b, c, z, regularized, prec);
        return;
    }

    /* polynomial */
    if (acb_is_int(b) && arf_sgn(arb_midref(acb_realref(b))) <= 0 &&
         arf_cmpabs_ui(arb_midref(acb_realref(b)), prec) < 0)
    {
        acb_hypgeom_2f1_direct(res, a, b, c, z, regularized, prec);
        return;
    }

    /* Try to reduce to a polynomial case using the Pfaff transformation */
    /* TODO: look at flags for integer c-b, c-a here, even when c is nonexact */
    if (acb_is_exact(c))
    {
        acb_t t;
        acb_init(t);

        acb_sub(t, c, b, prec);

        if (acb_is_int(t) && arb_is_nonpositive(acb_realref(t)))
        {
            acb_hypgeom_2f1_transform(res, a, b, c, z, flags, 1, prec);
            acb_clear(t);
            return;
        }

        acb_sub(t, c, a, prec);

        if (acb_is_int(t) && arb_is_nonpositive(acb_realref(t)))
        {
            int f1, f2;

            /* When swapping a, b, also swap the flags. */
            f1 = flags & ACB_HYPGEOM_2F1_AC;
            f2 = flags & ACB_HYPGEOM_2F1_BC;

            flags &= ~ACB_HYPGEOM_2F1_AC;
            flags &= ~ACB_HYPGEOM_2F1_BC;

            if (f1) flags |= ACB_HYPGEOM_2F1_BC;
            if (f2) flags |= ACB_HYPGEOM_2F1_AC;

            acb_hypgeom_2f1_transform(res, b, a, c, z, flags, 1, prec);
            acb_clear(t);
            return;
        }

        acb_clear(t);
    }

    /* special value at z = 1 */
    if (acb_is_one(z))
    {
        acb_t t, u, v;

        acb_init(t);
        acb_init(u);
        acb_init(v);

        acb_sub(t, c, a, prec);
        acb_sub(u, c, b, prec);
        acb_sub(v, t, b, prec);

        if (arb_is_positive(acb_realref(v)))
        {
            acb_rgamma(t, t, prec);
            acb_rgamma(u, u, prec);
            acb_mul(t, t, u, prec);
            acb_gamma(v, v, prec);
            acb_mul(t, t, v, prec);

            if (!regularized)
            {
                acb_gamma(v, c, prec);
                acb_mul(t, t, v, prec);
            }

            acb_set(res, t);
        }
        else
        {
            acb_indeterminate(res);
        }

        acb_clear(t);
        acb_clear(u);
        acb_clear(v);

        return;
    }

    algorithm = acb_hypgeom_2f1_choose(z);

    if (algorithm == 0)
    {
        acb_hypgeom_2f1_direct(res, a, b, c, z, regularized, prec);
    }
    else if (algorithm >= 1 && algorithm <= 5)
    {
        acb_hypgeom_2f1_transform(res, a, b, c, z, flags, algorithm, prec);
    }
    else
    {
        acb_hypgeom_2f1_corner(res, a, b, c, z, regularized, prec);
    }
}
Esempio n. 25
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);
}
Esempio n. 26
0
void
acb_hypgeom_2f1_transform_limit(acb_t res, const acb_t a, const acb_t b,
    const acb_t c, const acb_t z, int regularized, int which, slong prec)
{
    acb_poly_t aa, bb, cc, zz;
    acb_t t;

    if (acb_contains_zero(z) || !acb_is_finite(z))
    {
        acb_indeterminate(res);
        return;
    }

    if (arb_contains_si(acb_realref(z), 1) && arb_contains_zero(acb_imagref(z)))
    {
        acb_indeterminate(res);
        return;
    }

    if (!regularized)
    {
        acb_init(t);
        acb_gamma(t, c, prec);
        acb_hypgeom_2f1_transform_limit(res, a, b, c, z, 1, which, prec);
        acb_mul(res, res, t, prec);
        acb_clear(t);
        return;
    }

    acb_poly_init(aa);
    acb_poly_init(bb);
    acb_poly_init(cc);
    acb_poly_init(zz);
    acb_init(t);

    acb_poly_set_acb(aa, a);
    acb_poly_set_acb(bb, b);
    acb_poly_set_acb(cc, c);
    acb_poly_set_acb(zz, z);

    if (which == 2 || which == 3)
    {
        acb_sub(t, b, a, prec);
        acb_poly_set_coeff_si(aa, 1, 1);

        /* prefer b-a nonnegative (either is correct) to avoid
           expensive operations in the hypergeometric series */
        if (arb_is_nonnegative(acb_realref(t)))
            _acb_hypgeom_2f1_transform_limit(res, aa, bb, cc, zz, which, prec);
        else
            _acb_hypgeom_2f1_transform_limit(res, bb, aa, cc, zz, which, prec);
    }
    else
    {
        acb_poly_set_coeff_si(aa, 1, 1);
        _acb_hypgeom_2f1_transform_limit(res, aa, bb, cc, zz, which, prec);
    }

    acb_poly_clear(aa);
    acb_poly_clear(bb);
    acb_poly_clear(cc);
    acb_poly_clear(zz);
    acb_clear(t);
}