636 changes: 636 additions & 0 deletions arb_hypgeom/erf.c
View file

Large diffs are not rendered by default.

145 changes: 145 additions & 0 deletions arb_hypgeom/gamma_lower_sum_rs.c
View file
@@ -0,0 +1,145 @@
/*
Copyright (C) 2021 Fredrik Johansson
This file is part of Arb.
Arb is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License (LGPL) as published
by the Free Software Foundation; either version 2.1 of the License, or
(at your option) any later version. See <http://www.gnu.org/licenses/>.
*/

#include "arb_hypgeom.h"

static slong
exp_series_prec(slong k, double dz, double logdz, slong prec)
{
double gain;

if (prec <= 128)
return prec;

if (k <= dz + 5 || k <= 5)
return prec;

gain = (dz - k * logdz + k * (log(k) - 1.0)) * 1.4426950408889634;
gain = FLINT_MAX(gain, 0);

prec = prec - gain;
prec = FLINT_MAX(prec, 32);
return prec;
}

void
_arb_hypgeom_gamma_lower_sum_rs_1(arb_t res, ulong p, ulong q, const arb_t z, slong N, slong prec)
{
slong m, j, k, jlen, jbot, wp;
double dz, logdz;
mp_limb_t c, chi, clo;
arb_t s;
arb_ptr zpow;
mp_ptr cs;

m = n_sqrt(N);
m = FLINT_MAX(m, 2);
k = N - 1;
j = k % m;
jlen = 0;
jbot = j;
c = 1;

dz = arf_get_d(arb_midref(z), ARF_RND_UP);
dz = fabs(dz);

if (arf_cmpabs_2exp_si(arb_midref(z), prec) >= 0)
{
dz = ldexp(1.0, prec);
logdz = ARF_EXP(arb_midref(z)) * log(2);
}
else if (arf_cmpabs_2exp_si(arb_midref(z), -32) >= 0)
{
logdz = log(dz);
}
else if (arf_cmpabs_2exp_si(arb_midref(z), -prec) <= 0)
{
logdz = -prec * log(2);
}
else
{
logdz = ARF_EXP(arb_midref(z)) * log(2);
}

arb_init(s);
zpow = _arb_vec_init(m + 1);
cs = flint_malloc(sizeof(mp_limb_t) * (m + 1));
arb_mul_ui(zpow + m, z, q, prec);
_arb_vec_set_powers(zpow, zpow + m, m + 1, prec);

while (k >= 0)
{
if (k != 0)
{
/* Check if new coefficient will overflow limb */
umul_ppmm(chi, clo, c, p + (k - 1) * q);

if (chi != 0)
{
wp = exp_series_prec(k, dz, logdz, prec);

/* Denominator will change, so evaluate current dot product */
if (jlen != 0)
{
arb_dot_ui(s, s, 0, zpow + jbot, 1, cs + jbot, 1, jlen, wp);
jlen = 0;
}

arb_div_ui(s, s, c, wp);
c = 1;
}
}

/* Update dot product */
cs[j] = c;
jlen++;
jbot = j;

if (k != 0)
{
c = c * (p + (k - 1) * q);

/* Giant-step time. */
if (j == 0)
{
wp = exp_series_prec(k, dz, logdz, prec);

/* Evaluate current dot product */
if (jlen != 0)
{
arb_dot_ui(s, s, 0, zpow + jbot, 1, cs + jbot, 1, jlen, wp);
jlen = 0;
}

arb_mul(s, s, zpow + m, wp);
j = m - 1;
}
else
{
j--;
}
}

k--;
}

if (jlen != 0)
{
arb_dot_ui(s, s, 0, zpow + jbot, 1, cs + jbot, 1, jlen, prec);
jlen = 0;
}

arb_div_ui(res, s, c, prec);

_arb_vec_clear(zpow, m + 1);
arb_clear(s);
flint_free(cs);
}
45 changes: 26 additions & 19 deletions arb_hypgeom/gamma_upper_fmpq.c
View file
Expand Up @@ -78,30 +78,37 @@ _arb_hypgeom_gamma_upper_fmpq_inf_choose_N(mag_t err, const fmpq_t a, const arb_
mag_pow_fmpq_fast(u, u, a1);
mag_mul(err, t, u);

arb_get_mag_lower(t, z);
mag_inv(t, t);

for (N = 1; ; N++)
if (mag_is_inf(err))
{
N = -1;
}
else
{
mag_mul_ui(u, err, FLINT_MAX(FLINT_ABS(aa - N), FLINT_ABS(ab - N)));
mag_mul(u, u, t);
arb_get_mag_lower(t, z);
mag_inv(t, t);

if (N >= ab - 1 && mag_cmp(u, abs_tol) < 0)
for (N = 1; ; N++)
{
mag_swap(err, u);
break;
}
mag_mul_ui(u, err, FLINT_MAX(FLINT_ABS(aa - N), FLINT_ABS(ab - N)));
mag_mul(u, u, t);

/* Stop if terms are increasing, unless a is a positive integer in
which case the series will terminate eventually. */
if (mag_cmp(u, err) > 0 && !(aa == ab && aa >= 1))
{
mag_inf(err);
N = -1;
break;
}
if (N >= ab - 1 && mag_cmp(u, abs_tol) < 0)
{
mag_swap(err, u);
break;
}

mag_swap(err, u);
/* Stop if terms are increasing, unless a is a positive integer in
which case the series will terminate eventually. */
if (mag_cmp(u, err) > 0 && !(aa == ab && aa >= 1))
{
mag_inf(err);
N = -1;
break;
}

mag_swap(err, u);
}
}
}

Expand Down
13 changes: 13 additions & 0 deletions arb_hypgeom/gamma_upper_fmpq_step_bsplit.c
View file
Expand Up @@ -279,6 +279,19 @@ _arb_gamma_upper_fmpq_step_bsplit(arb_t Gz1, const fmpq_t a, const arb_t z0, con
slong N;
fmpq_t a1;

if (arb_is_zero(z0))
{
mag_init(err);
arb_init(x);
N = _arb_hypgeom_gamma_lower_fmpq_0_choose_N(err, a, z1, abs_tol);
_arb_hypgeom_gamma_lower_fmpq_0_bsplit(Gz1, a, z1, N, prec);
arb_add_error_mag(Gz1, err);
arb_sub(Gz1, Gz0, Gz1, prec);
arb_clear(x);
mag_clear(err);
return;
}

mag_init(xmag);
mag_init(err);
arb_init(x);
Expand Down
143 changes: 143 additions & 0 deletions arb_hypgeom/gamma_upper_sum_rs.c
View file
@@ -0,0 +1,143 @@
/*
Copyright (C) 2021 Fredrik Johansson
This file is part of Arb.
Arb is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License (LGPL) as published
by the Free Software Foundation; either version 2.1 of the License, or
(at your option) any later version. See <http://www.gnu.org/licenses/>.
*/

#include "arb_hypgeom.h"

static slong
asymp_prec(slong k, double logdz, slong prec)
{
double gain;

if (prec <= 128)
return prec;

if (k <= 5)
return prec;

gain = (k * logdz - (k * (log(k) - 1.0))) * 1.4426950408889634 - 4;
gain = FLINT_MAX(gain, 0);

prec = prec - gain;
prec = FLINT_MAX(prec, 32);
return prec;
}

void
_arb_hypgeom_gamma_upper_sum_rs_1(arb_t res, ulong p, ulong q, const arb_t z, slong N, slong prec)
{
slong m, i, j, k, jlen, jbot, jtop, wp;
double dz, logdz;
mp_limb_t c, chi, clo;
arb_t s, t;
arb_ptr zpow;
mp_ptr cs;

m = n_sqrt(N);
m = FLINT_MAX(m, 2);
k = N - 1;
j = k % m;
jlen = 0;
jbot = j;

if (arf_cmpabs_2exp_si(arb_midref(z), prec) >= 0)
{
logdz = ARF_EXP(arb_midref(z)) * log(2);
}
else if (arf_cmpabs_2exp_si(arb_midref(z), -32) >= 0)
{
dz = arf_get_d(arb_midref(z), ARF_RND_UP);
dz = fabs(dz);
logdz = log(dz);
}
else if (arf_cmpabs_2exp_si(arb_midref(z), -prec) <= 0)
{
logdz = -prec * log(2);
}
else
{
logdz = ARF_EXP(arb_midref(z)) * log(2);
}

arb_init(s);
arb_init(t);
zpow = _arb_vec_init(m + 1);
cs = flint_malloc(sizeof(mp_limb_t) * (m + 1));
arb_mul_ui(zpow + m, z, q, prec);
arb_inv(zpow + m, zpow + m, prec);
_arb_vec_set_powers(zpow, zpow + m, m + 1, prec);

while (k >= 0)
{
/* Find run of coefficients whose product fits in a limb */
jlen = 1;
jtop = jbot = k;

if (jtop > 0)
{
c = p + q * (jtop - 1);
while (jlen <= j)
{
if (jbot >= 2)
{
umul_ppmm(chi, clo, c, p + q * (jbot - 2));

if (chi != 0)
break;

c = clo;
}

jbot--;
jlen++;
}
}

if (jbot != jtop - jlen + 1)
abort();

/* Factors between jbot and jtop inclusive */
if (jbot == 0)
cs[0] = 1;
else
cs[0] = p + q * (jbot - 1);

for (i = 1; i < jlen; i++)
cs[i] = cs[i - 1] * (p + q * (jbot + i - 1));

wp = asymp_prec(k - jlen, logdz, prec);

/* todo: special case jlen == 1 */
arb_add(t, s, zpow + j, wp);
arb_swap(zpow + j, t);
arb_dot_ui(s, NULL, 0, zpow + j - jlen + 1, 1, cs, 1, jlen, wp);
arb_swap(zpow + j, t);

k -= jlen;
j -= (jlen - 1);

if (j == 0 && k >= 1)
{
arb_mul(s, s, zpow + m, wp);
j = m - 1;
}
else
{
j--;
}
}

arb_swap(res, s);

_arb_vec_clear(zpow, m + 1);
arb_clear(s);
arb_clear(t);
flint_free(cs);
}
225 changes: 225 additions & 0 deletions arb_hypgeom/test/t-erf.c
View file
@@ -0,0 +1,225 @@
/*
Copyright (C) 2021 Fredrik Johansson
This file is part of Arb.
Arb is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License (LGPL) as published
by the Free Software Foundation; either version 2.1 of the License, or
(at your option) any later version. See <http://www.gnu.org/licenses/>.
*/

#include "arb_hypgeom.h"

int main()
{
slong iter;
flint_rand_t state;

flint_printf("erf....");
fflush(stdout);

flint_randinit(state);

for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t a, b, c;
slong prec1, prec2;

prec1 = 2 + n_randint(state, 1000);
prec2 = 2 + n_randint(state, 1000);

arb_init(a);
arb_init(b);
arb_init(c);

arb_randtest_special(a, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));
arb_randtest_special(b, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));
arb_randtest_special(c, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));

switch (n_randint(state, 2))
{
case 0:
if (!arb_hypgeom_erf_bb(b, a, 0, prec1))
arb_hypgeom_erf(b, a, prec1);
break;
default:
arb_hypgeom_erf(b, a, prec1);
break;
}

switch (n_randint(state, 2))
{
case 0:
if (!arb_hypgeom_erf_bb(c, a, 0, prec2))
arb_hypgeom_erf(c, a, prec2);
break;
default:
arb_hypgeom_erf(c, a, prec2);
break;
}

if (!arb_overlaps(b, c))
{
flint_printf("FAIL: overlap\n\n");
flint_printf("a = "); arb_printd(a, 30); flint_printf("\n\n");
flint_printf("b = "); arb_printd(b, 30); flint_printf("\n\n");
flint_printf("c = "); arb_printd(c, 30); flint_printf("\n\n");
flint_abort();
}

arb_clear(a);
arb_clear(b);
arb_clear(c);
}

for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t a, b, c;
slong prec1, prec2;

prec1 = 2 + n_randint(state, 1000);
prec2 = 2 + n_randint(state, 1000);

arb_init(a);
arb_init(b);
arb_init(c);

arb_randtest_special(a, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));
arb_randtest_special(b, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));
arb_randtest_special(c, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));

switch (n_randint(state, 2))
{
case 0:
if (!arb_hypgeom_erf_bb(b, a, 1, prec1))
arb_hypgeom_erfc(b, a, prec1);
break;
default:
arb_hypgeom_erfc(b, a, prec1);
break;
}

switch (n_randint(state, 2))
{
case 0:
if (!arb_hypgeom_erf_bb(c, a, 1, prec2))
arb_hypgeom_erfc(c, a, prec2);
break;
default:
arb_hypgeom_erfc(c, a, prec2);
break;
}

if (!arb_overlaps(b, c))
{
flint_printf("FAIL: overlap\n\n");
flint_printf("a = "); arb_printd(a, 30); flint_printf("\n\n");
flint_printf("b = "); arb_printd(b, 30); flint_printf("\n\n");
flint_printf("c = "); arb_printd(c, 30); flint_printf("\n\n");
flint_abort();
}

arb_clear(a);
arb_clear(b);
arb_clear(c);
}

#if 0
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t a, b, c;
slong prec1;

prec1 = 2 + n_randint(state, 5000);

arb_init(a);
arb_init(b);
arb_init(c);

arb_randtest_special(a, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));
arb_randtest_special(b, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));
arb_randtest_special(c, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));

arb_hypgeom_erfc(b, a, prec1 + 100);
arb_set_round(b, b, prec1);
arb_div_ui(b, b, 3, prec1);
arb_mul_ui(b, b, 3, prec1);

if (n_randint(state, 2))
{
if (!arb_hypgeom_erf_bb(c, a, 1, prec1))
arb_hypgeom_erfc(c, a, prec1);
}
else
arb_hypgeom_erfc(c, a, prec1);

if (arb_is_finite(b) && (arb_rel_accuracy_bits(c) < arb_rel_accuracy_bits(b) - 4.0))
{
flint_printf("ACCURACY (erfc)\n\n");
flint_printf("prec = %wd\n\n", prec1);
flint_printf("a = "); arb_printd(a, 200); flint_printf("\n");
flint_printf("b = "); arb_printd(b, 200); flint_printf("\n");
flint_printf("c = "); arb_printd(c, 200); flint_printf("\n\n");
}

arb_clear(a);
arb_clear(b);
arb_clear(c);
}

#endif


#if 0
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arb_t a, b, c;
slong prec1;

prec1 = 2 + n_randint(state, 5000);

arb_init(a);
arb_init(b);
arb_init(c);

arb_randtest_special(a, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));
arb_randtest_special(b, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));
arb_randtest_special(c, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 100));

arb_hypgeom_erf(b, a, prec1 + 100);
arb_set_round(b, b, prec1);

arb_div_ui(b, b, 3, prec1);
arb_mul_ui(b, b, 3, prec1);

if (n_randint(state, 2))
{
if (!arb_hypgeom_erf_bb(c, a, 0, prec1))
arb_hypgeom_erf(c, a, prec1);
}
else
arb_hypgeom_erf(c, a, prec1);

if (arb_is_finite(b) && (arb_rel_accuracy_bits(c) < arb_rel_accuracy_bits(b) - 4.0))
{
flint_printf("ACCURACY (erf)\n\n");
flint_printf("prec = %wd\n\n", prec1);
flint_printf("a = "); arb_printd(a, 200); flint_printf("\n");
flint_printf("b = "); arb_printd(b, 200); flint_printf("\n");
flint_printf("c = "); arb_printd(c, 200); flint_printf("\n\n");
}

arb_clear(a);
arb_clear(b);
arb_clear(c);
}

#endif

flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}

86 changes: 86 additions & 0 deletions arb_hypgeom/test/t-gamma_lower_sum_rs.c
View file
@@ -0,0 +1,86 @@
/*
Copyright (C) 2021 Fredrik Johansson
This file is part of Arb.
Arb is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License (LGPL) as published
by the Free Software Foundation; either version 2.1 of the License, or
(at your option) any later version. See <http://www.gnu.org/licenses/>.
*/

#include "arb_hypgeom.h"

int main()
{
slong iter;
flint_rand_t state;

flint_printf("gamma_lower_sum_rs....");
fflush(stdout);

flint_randinit(state);

for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
fmpq_t a;
ulong p, q;
arb_t z, r1, r2, s, t, u;
slong k, N, prec;

p = n_randint(state, 1000);
q = 1 + n_randint(state, 1000);

N = n_randint(state, 100);
prec = 2 + n_randint(state, 500);

fmpq_init(a);
fmpq_set_si(a, p, q);
arb_init(z);
arb_init(r1);
arb_init(r2);
arb_init(s);
arb_init(t);
arb_init(u);

arb_randtest(z, state, prec, 10);

_arb_hypgeom_gamma_lower_sum_rs_1(r1, p, q, z, N, prec);

arb_zero(s);
arb_one(t);
arb_set_fmpq(u, a, prec);
for (k = 0; k < N; k++)
{
arb_add(s, s, t, prec);
arb_mul(t, t, z, prec);
arb_div(t, t, u, prec);
arb_add_ui(u, u, 1, prec);
}
arb_set(r2, s);

if (!arb_overlaps(r1, r2))
{
flint_printf("FAIL: overlap\n\n");
flint_printf("N = %wd\n\n", N);
flint_printf("a = "); fmpq_print(a); flint_printf("\n\n");
flint_printf("z = "); arb_printn(z, 100, 0); flint_printf("\n\n");
flint_printf("r1 = "); arb_printn(r1, 100, 0); flint_printf("\n\n");
flint_printf("r2 = "); arb_printn(r2, 100, 0); flint_printf("\n\n");
flint_abort();
}

fmpq_clear(a);
arb_clear(z);
arb_clear(r1);
arb_clear(r2);
arb_clear(s);
arb_clear(t);
arb_clear(u);
}

flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
86 changes: 86 additions & 0 deletions arb_hypgeom/test/t-gamma_upper_sum_rs.c
View file
@@ -0,0 +1,86 @@
/*
Copyright (C) 2021 Fredrik Johansson
This file is part of Arb.
Arb is free software: you can redistribute it and/or modify it under
the terms of the GNU Lesser General Public License (LGPL) as published
by the Free Software Foundation; either version 2.1 of the License, or
(at your option) any later version. See <http://www.gnu.org/licenses/>.
*/

#include "arb_hypgeom.h"

int main()
{
slong iter;
flint_rand_t state;

flint_printf("gamma_upper_sum_rs....");
fflush(stdout);

flint_randinit(state);

for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
fmpq_t a;
ulong p, q;
arb_t z, r1, r2, s, t, u;
slong k, N, prec;

p = n_randint(state, 1000);
q = 1 + n_randint(state, 1000);

N = n_randint(state, 100);
prec = 2 + n_randint(state, 500);

fmpq_init(a);
fmpq_set_si(a, p, q);
arb_init(z);
arb_init(r1);
arb_init(r2);
arb_init(s);
arb_init(t);
arb_init(u);

arb_randtest(z, state, prec, 10);

_arb_hypgeom_gamma_upper_sum_rs_1(r1, p, q, z, N, prec);

arb_zero(s);
arb_one(t);
arb_set_fmpq(u, a, prec);
for (k = 0; k < N; k++)
{
arb_add(s, s, t, prec);
arb_div(t, t, z, prec);
arb_mul(t, t, u, prec);
arb_add_ui(u, u, 1, prec);
}
arb_set(r2, s);

if (!arb_overlaps(r1, r2))
{
flint_printf("FAIL: overlap\n\n");
flint_printf("N = %wd\n\n", N);
flint_printf("a = "); fmpq_print(a); flint_printf("\n\n");
flint_printf("z = "); arb_printn(z, 100, 0); flint_printf("\n\n");
flint_printf("r1 = "); arb_printn(r1, 100, 0); flint_printf("\n\n");
flint_printf("r2 = "); arb_printn(r2, 100, 0); flint_printf("\n\n");
flint_abort();
}

fmpq_clear(a);
arb_clear(z);
arb_clear(r1);
arb_clear(r2);
arb_clear(s);
arb_clear(t);
arb_clear(u);
}

flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
36 changes: 0 additions & 36 deletions arb_hypgeom/wrappers.c
View file
Expand Up @@ -12,42 +12,6 @@
#include "arb_hypgeom.h"
#include "acb_hypgeom.h"

void
arb_hypgeom_erf(arb_t res, const arb_t z, slong prec)
{
if (!arb_is_finite(z))
{
arb_indeterminate(res);
}
else
{
acb_t t;
acb_init(t);
arb_set(acb_realref(t), z);
acb_hypgeom_erf(t, t, prec);
arb_swap(res, acb_realref(t));
acb_clear(t);
}
}

void
arb_hypgeom_erfc(arb_t res, const arb_t z, slong prec)
{
if (!arb_is_finite(z))
{
arb_indeterminate(res);
}
else
{
acb_t t;
acb_init(t);
arb_set(acb_realref(t), z);
acb_hypgeom_erfc(t, t, prec);
arb_swap(res, acb_realref(t));
acb_clear(t);
}
}

void
arb_hypgeom_erfi(arb_t res, const arb_t z, slong prec)
{
Expand Down
10 changes: 10 additions & 0 deletions doc/source/arb_hypgeom.rst
View file
Expand Up @@ -288,6 +288,16 @@ Incomplete gamma and beta functions
Internal evaluation functions
................................................................................

.. function:: void _arb_hypgeom_gamma_lower_sum_rs_1(arb_t res, ulong p, ulong q, const arb_t z, slong N, slong prec)

Computes `\sum_{k=0}^{N-1} z^k / (a)_k` where `a = p/q` using
rectangular splitting. It is assumed that `p + qN` fits in a limb.

.. function:: void _arb_hypgeom_gamma_upper_sum_rs_1(arb_t res, ulong p, ulong q, const arb_t z, slong N, slong prec)

Computes `\sum_{k=0}^{N-1} (a)_k / z^k` where `a = p/q` using
rectangular splitting. It is assumed that `p + qN` fits in a limb.

.. function:: slong _arb_hypgeom_gamma_upper_fmpq_inf_choose_N(mag_t err, const fmpq_t a, const arb_t z, const mag_t abs_tol)

Returns number of terms *N* and sets *err* to the truncation error for evaluating
Expand Down