void mpfr_taylor_nat_log(mpfr_t R, mpfr_t x, mpz_t n)
{
assert(mpz_cmp_ui(n, 0) > 0);
assert(mpfr_cmp_ui(x, 0) > 0);
mpfr_t a, t, tt;
mpfr_exp_t b;
mpz_t k;
unsigned int f = 1000, F = 1000;
mpfr_init(a);
mpfr_frexp(&b, a, x, MPFR_RNDN);
mpfr_ui_sub(a, 1, a, MPFR_RNDN);
mpfr_init_set(t, a, MPFR_RNDN);
mpfr_init(tt);
mpfr_set(R, a, MPFR_RNDN);
for(mpz_init_set_ui(k, 2); mpz_cmp(k, n) < 0; mpz_add_ui(k, k, 1))
{
mpfr_mul(t, t, a, MPFR_RNDN);
mpfr_div_z(tt, t, k, MPFR_RNDN);
mpfr_add(R, R, tt, MPFR_RNDN);
}
mpfr_mul_si(a, MPFR_NAT_LOG_2, b, MPFR_RNDN);
mpfr_sub(R, a, R, MPFR_RNDN);
}
/* compute in s an approximation of S1 = sum((n-k)!/k!*y^k,k=0..n)
return e >= 0 the exponent difference between the maximal value of |s|
during the for loop and the final value of |s|.
*/
static mpfr_exp_t
mpfr_yn_s1 (mpfr_ptr s, mpfr_srcptr y, unsigned long n)
{
unsigned long k;
mpz_t f;
mpfr_exp_t e, emax;
mpz_init_set_ui (f, 1);
/* we compute n!*S1 = sum(a[k]*y^k,k=0..n) where a[k] = n!*(n-k)!/k!,
a[0] = (n!)^2, a[1] = n!*(n-1)!, ..., a[n-1] = n, a[n] = 1 */
mpfr_set_ui (s, 1, MPFR_RNDN); /* a[n] */
emax = MPFR_EXP(s);
for (k = n; k-- > 0;)
{
/* a[k]/a[k+1] = (n-k)!/k!/(n-(k+1))!*(k+1)! = (k+1)*(n-k) */
mpfr_mul (s, s, y, MPFR_RNDN);
mpz_mul_ui (f, f, n - k);
mpz_mul_ui (f, f, k + 1);
/* invariant: f = a[k] */
mpfr_add_z (s, s, f, MPFR_RNDN);
e = MPFR_EXP(s);
if (e > emax)
emax = e;
}
/* now we have f = (n!)^2 */
mpz_sqrt (f, f);
mpfr_div_z (s, s, f, MPFR_RNDN);
mpz_clear (f);
return emax - MPFR_EXP(s);
}
static void
_taylor_mpfr (gulong l, mpq_t q, mpfr_ptr res, mp_rnd_t rnd)
{
NcmBinSplit **bs_ptr = _ncm_mpsf_sbessel_get_bs ();
NcmBinSplit *bs = *bs_ptr;
_binsplit_spherical_bessel *data = (_binsplit_spherical_bessel *) bs->userdata;
gulong n;
data->l = l;
mpq_mul (data->mq2_2, q, q);
mpq_neg (data->mq2_2, data->mq2_2);
mpq_div_2exp (data->mq2_2, data->mq2_2, 1);
//mpfr_printf ("# Taylor %ld %Qd | %Qd\n", l, q, data->mq2_2);
ncm_binsplit_eval_prec (bs, binsplit_spherical_bessel_taylor, 10, mpfr_get_prec (res));
//mpfr_printf ("# Taylor %ld %Qd | %Zd %Zd\n", l, q, bs->T, bs->Q);
mpfr_set_q (res, q, rnd);
mpfr_pow_ui (res, res, l, rnd);
mpfr_mul_z (res, res, bs->T, rnd);
mpfr_div_z (res, res, bs->Q, rnd);
for (n = 1; n <= l; n++)
mpfr_div_ui (res, res, 2L * n + 1, rnd);
ncm_memory_pool_return (bs_ptr);
return;
}
/* computes S(n) = sum(n^k*(-1)^(k-1)/k!/k, k=1..ceil(4.319136566 * n))
using binary splitting.
We have S(n) = sum(f(k), k=1..N) with N=ceil(4.319136566 * n)
and f(k) = n^k*(-1)*(k-1)/k!/k,
thus f(k)/f(k-1) = -n*(k-1)/k^2
*/
static void
mpfr_const_euler_S2 (mpfr_t x, unsigned long n)
{
mpz_t P, Q, T;
unsigned long N = (unsigned long) (ALPHA * (double) n + 1.0);
mpz_init (P);
mpz_init (Q);
mpz_init (T);
mpfr_const_euler_S2_aux (P, Q, T, n, 1, N + 1, 0);
mpfr_set_z (x, T, MPFR_RNDN);
mpfr_div_z (x, x, Q, MPFR_RNDN);
mpz_clear (P);
mpz_clear (Q);
mpz_clear (T);
}
void mpfr_taylor_exp(mpfr_t R, mpfr_t x, mpz_t n)
{
assert(mpz_cmp_ui(n, 0) >= 0);
mpfr_t t;
mpz_t k;
mpfr_init_set_ui(t, 1, MPFR_RNDN);
mpfr_set_ui(R, 1, MPFR_RNDN);
for(mpz_init_set_ui(k, 1); mpz_cmp(k, n) < 0; mpz_add_ui(k, k, 1))
{
mpfr_mul(t, t, x, MPFR_RNDN);
mpfr_div_z(t, t, k, MPFR_RNDN);
mpfr_add(R, R, t, MPFR_RNDN);
}
}
void mpfr_naive_exp(mpfr_t R, mpfr_t x, mpz_t n)
{
assert(mpz_cmp_ui(n, 0) >= 0);
mpfr_t z;
mpfr_init_set(z, x, MPFR_RNDN);
mpfr_div_z(z, z, n, MPFR_RNDN);
mpfr_add_ui(z, z, 1, MPFR_RNDN);
if(mpfr_cmp_ui(z, 0) > 0)
mpfr_squaring_int_exp(R, z, n);
else
{
mpfr_neg(z, z, MPFR_RNDN);
mpfr_squaring_int_exp(R, z, n);
if(mpz_odd_p(n))
mpfr_neg(R, R, MPFR_RNDN);
}
}
static PyObject *
GMPy_Real_FloorDiv(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPFR_Object *result;
CHECK_CONTEXT(context);
if (!(result = GMPy_MPFR_New(0, context))) {
/* LCOV_EXCL_START */
return NULL;
/* LCOV_EXCL_STOP */
}
if (MPFR_Check(x)) {
if (MPFR_Check(y)) {
mpfr_clear_flags();
result->rc = mpfr_div(result->f, MPFR(x), MPFR(y), GET_MPFR_ROUND(context));
result->rc = mpfr_floor(result->f, result->f);
goto done;
}
if (PyIntOrLong_Check(y)) {
int error;
long tempi = GMPy_Integer_AsLongAndError(y, &error);
if (!error) {
mpfr_clear_flags();
result->rc = mpfr_div_si(result->f, MPFR(x), tempi, GET_MPFR_ROUND(context));
result->rc = mpfr_floor(result->f, result->f);
goto done;
}
else {
mpz_set_PyIntOrLong(global.tempz, y);
mpfr_clear_flags();
result->rc = mpfr_div_z(result->f, MPFR(x), global.tempz, GET_MPFR_ROUND(context));
result->rc = mpfr_floor(result->f, result->f);
goto done;
}
}
if (CHECK_MPZANY(y)) {
mpfr_clear_flags();
result->rc = mpfr_div_z(result->f, MPFR(x), MPZ(y), GET_MPFR_ROUND(context));
result->rc = mpfr_floor(result->f, result->f);
goto done;
}
if (IS_RATIONAL(y)) {
MPQ_Object *tempy;
if (!(tempy = GMPy_MPQ_From_Number(y, context))) {
Py_DECREF((PyObject*)result);
return NULL;
}
mpfr_clear_flags();
result->rc = mpfr_div_q(result->f, MPFR(x), tempy->q, GET_MPFR_ROUND(context));
result->rc = mpfr_floor(result->f, result->f);
Py_DECREF((PyObject*)tempy);
goto done;
}
if (PyFloat_Check(y)) {
mpfr_clear_flags();
result->rc = mpfr_div_d(result->f, MPFR(x), PyFloat_AS_DOUBLE(y), GET_MPFR_ROUND(context));
result->rc = mpfr_floor(result->f, result->f);
goto done;
}
}
if (MPFR_Check(y)) {
if (PyIntOrLong_Check(x)) {
int error;
long tempi = GMPy_Integer_AsLongAndError(x, &error);
if (!error) {
mpfr_clear_flags();
result->rc = mpfr_si_div(result->f, tempi, MPFR(y), GET_MPFR_ROUND(context));
result->rc = mpfr_floor(result->f, result->f);
goto done;
}
}
/* Since mpfr_z_div does not exist, this combination is handled at the
* end by converting x to an mpfr. Ditto for rational.*/
if (PyFloat_Check(x)) {
mpfr_clear_flags();
result->rc = mpfr_d_div(result->f, PyFloat_AS_DOUBLE(x), MPFR(y), GET_MPFR_ROUND(context));
result->rc = mpfr_floor(result->f, result->f);
goto done;
}
}
/* Handle the remaining cases.
* Note: verify that MPZ if converted at full precision! */
if (IS_REAL(x) && IS_REAL(y)) {
MPFR_Object *tempx, *tempy;
tempx = GMPy_MPFR_From_Real(x, 1, context);
tempy = GMPy_MPFR_From_Real(y, 1, context);
if (!tempx || !tempy) {
Py_XDECREF((PyObject*)tempx);
Py_XDECREF((PyObject*)tempy);
Py_DECREF((PyObject*)result);
return NULL;
}
mpfr_clear_flags();
result->rc = mpfr_div(result->f, MPFR(tempx), MPFR(tempy), GET_MPFR_ROUND(context));
result->rc = mpfr_floor(result->f, result->f);
Py_DECREF((PyObject*)tempx);
Py_DECREF((PyObject*)tempy);
goto done;
}
Py_DECREF((PyObject*)result);
Py_RETURN_NOTIMPLEMENTED;
done:
_GMPy_MPFR_Cleanup(&result, context);
return (PyObject*)result;
}
static void
special (void)
{
mpfr_t x, y;
mpq_t q;
mpz_t z;
int res = 0;
mpfr_init (x);
mpfr_init (y);
mpq_init (q);
mpz_init (z);
/* cancellation in mpfr_add_q */
mpfr_set_prec (x, 60);
mpfr_set_prec (y, 20);
mpz_set_str (mpq_numref (q), "-187207494", 10);
mpz_set_str (mpq_denref (q), "5721", 10);
mpfr_set_str_binary (x, "11111111101001011011100101100011011110010011100010000100001E-44");
mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("cancelation in add_q", mpfr_cmp_ui_2exp (y, 256783, -64) == 0);
mpfr_set_prec (x, 19);
mpfr_set_str_binary (x, "0.1011110101110011100E0");
mpz_set_str (mpq_numref (q), "187207494", 10);
mpz_set_str (mpq_denref (q), "5721", 10);
mpfr_set_prec (y, 29);
mpfr_add_q (y, x, q, MPFR_RNDD);
mpfr_set_prec (x, 29);
mpfr_set_str_binary (x, "11111111101001110011010001001E-14");
CHECK_FOR ("cancelation in add_q", mpfr_cmp (x,y) == 0);
/* Inf */
mpfr_set_inf (x, 1);
mpz_set_str (mpq_numref (q), "395877315", 10);
mpz_set_str (mpq_denref (q), "3508975966", 10);
mpfr_set_prec (y, 118);
mpfr_add_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("inf", mpfr_inf_p (y) && mpfr_sgn (y) > 0);
mpfr_sub_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("inf", mpfr_inf_p (y) && mpfr_sgn (y) > 0);
/* Nan */
MPFR_SET_NAN (x);
mpfr_add_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("nan", mpfr_nan_p (y));
mpfr_sub_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("nan", mpfr_nan_p (y));
/* Exact value */
mpfr_set_prec (x, 60);
mpfr_set_prec (y, 60);
mpfr_set_str1 (x, "0.5");
mpz_set_str (mpq_numref (q), "3", 10);
mpz_set_str (mpq_denref (q), "2", 10);
res = mpfr_add_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("0.5+3/2", mpfr_cmp_ui(y, 2)==0 && res==0);
res = mpfr_sub_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("0.5-3/2", mpfr_cmp_si(y, -1)==0 && res==0);
/* Inf Rationnal */
mpq_set_ui (q, 1, 0);
mpfr_set_str1 (x, "0.5");
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5+1/0", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5-1/0", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0);
mpq_set_si (q, -1, 0);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5+ -1/0", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5- -1/0", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0);
res = mpfr_div_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5 / (-1/0)", mpfr_zero_p (y) && MPFR_IS_NEG (y) && res == 0);
mpq_set_ui (q, 1, 0);
mpfr_set_inf (x, 1);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("+Inf + +Inf", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("+Inf - +Inf", MPFR_IS_NAN (y) && res == 0);
mpfr_set_inf (x, -1);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("-Inf + +Inf", MPFR_IS_NAN (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("-Inf - +Inf", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0);
mpq_set_si (q, -1, 0);
mpfr_set_inf (x, 1);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("+Inf + -Inf", MPFR_IS_NAN (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("+Inf - -Inf", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0);
mpfr_set_inf (x, -1);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("-Inf + -Inf", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("-Inf - -Inf", MPFR_IS_NAN (y) && res == 0);
/* 0 */
mpq_set_ui (q, 0, 1);
mpfr_set_ui (x, 42, MPFR_RNDN);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("42+0/1", mpfr_cmp_ui (y, 42) == 0 && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("42-0/1", mpfr_cmp_ui (y, 42) == 0 && res == 0);
res = mpfr_mul_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("42*0/1", mpfr_zero_p (y) && MPFR_IS_POS (y) && res == 0);
mpfr_clear_flags ();
res = mpfr_div_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("42/(0/1)", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0
&& mpfr_divby0_p ());
mpz_set_ui (z, 0);
mpfr_clear_flags ();
res = mpfr_div_z (y, x, z, MPFR_RNDN);
CHECK_FORZ ("42/0", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0
&& mpfr_divby0_p ());
mpz_clear (z);
mpq_clear (q);
mpfr_clear (x);
mpfr_clear (y);
}
static void
reduced_expo_range (void)
{
mpfr_t x;
mpz_t z;
mpq_t q;
mpfr_exp_t emin;
int inex;
emin = mpfr_get_emin ();
set_emin (4);
mpfr_init2 (x, 32);
mpz_init (z);
mpfr_clear_flags ();
inex = mpfr_set_ui (x, 17, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
mpz_set_ui (z, 3);
inex = mpfr_mul_z (x, x, z, MPFR_RNDN);
if (inex != 0 || MPFR_IS_NAN (x) || mpfr_cmp_ui (x, 51) != 0)
{
printf ("Error 1 in reduce_expo_range: expected 51 with inex = 0,"
" got\n");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf ("with inex = %d\n", inex);
exit (1);
}
inex = mpfr_div_z (x, x, z, MPFR_RNDN);
if (inex != 0 || MPFR_IS_NAN (x) || mpfr_cmp_ui (x, 17) != 0)
{
printf ("Error 2 in reduce_expo_range: expected 17 with inex = 0,"
" got\n");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf ("with inex = %d\n", inex);
exit (1);
}
inex = mpfr_add_z (x, x, z, MPFR_RNDN);
if (inex != 0 || MPFR_IS_NAN (x) || mpfr_cmp_ui (x, 20) != 0)
{
printf ("Error 3 in reduce_expo_range: expected 20 with inex = 0,"
" got\n");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf ("with inex = %d\n", inex);
exit (1);
}
inex = mpfr_sub_z (x, x, z, MPFR_RNDN);
if (inex != 0 || MPFR_IS_NAN (x) || mpfr_cmp_ui (x, 17) != 0)
{
printf ("Error 4 in reduce_expo_range: expected 17 with inex = 0,"
" got\n");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf ("with inex = %d\n", inex);
exit (1);
}
MPFR_ASSERTN (__gmpfr_flags == 0);
if (mpfr_cmp_z (x, z) <= 0)
{
printf ("Error 5 in reduce_expo_range: expected a positive value.\n");
exit (1);
}
mpz_clear (z);
mpq_init (q);
mpq_set_ui (q, 1, 1);
mpfr_set_ui (x, 16, MPFR_RNDN);
inex = mpfr_add_q (x, x, q, MPFR_RNDN);
if (inex != 0 || MPFR_IS_NAN (x) || mpfr_cmp_ui (x, 17) != 0)
{
printf ("Error in reduce_expo_range for 16 + 1/1,"
" got inex = %d and\nx = ", inex);
mpfr_dump (x);
exit (1);
}
inex = mpfr_sub_q (x, x, q, MPFR_RNDN);
if (inex != 0 || MPFR_IS_NAN (x) || mpfr_cmp_ui (x, 16) != 0)
{
printf ("Error in reduce_expo_range for 17 - 1/1,"
" got inex = %d and\nx = ", inex);
mpfr_dump (x);
exit (1);
}
mpq_clear (q);
mpfr_clear (x);
set_emin (emin);
}
/* compute in s an approximation of
S3 = c*sum((h(k)+h(n+k))*y^k/k!/(n+k)!,k=0..infinity)
where h(k) = 1 + 1/2 + ... + 1/k
k=0: h(n)
k=1: 1+h(n+1)
k=2: 3/2+h(n+2)
Returns e such that the error is bounded by 2^e ulp(s).
*/
static mpfr_exp_t
mpfr_yn_s3 (mpfr_ptr s, mpfr_srcptr y, mpfr_srcptr c, unsigned long n)
{
unsigned long k, zz;
mpfr_t t, u;
mpz_t p, q; /* p/q will store h(k)+h(n+k) */
mpfr_exp_t exps, expU;
zz = mpfr_get_ui (y, MPFR_RNDU); /* y = z^2/4 */
MPFR_ASSERTN (zz < ULONG_MAX - 2);
zz += 2; /* z^2 <= 2^zz */
mpz_init_set_ui (p, 0);
mpz_init_set_ui (q, 1);
/* initialize p/q to h(n) */
for (k = 1; k <= n; k++)
{
/* p/q + 1/k = (k*p+q)/(q*k) */
mpz_mul_ui (p, p, k);
mpz_add (p, p, q);
mpz_mul_ui (q, q, k);
}
mpfr_init2 (t, MPFR_PREC(s));
mpfr_init2 (u, MPFR_PREC(s));
mpfr_fac_ui (t, n, MPFR_RNDN);
mpfr_div (t, c, t, MPFR_RNDN); /* c/n! */
mpfr_mul_z (u, t, p, MPFR_RNDN);
mpfr_div_z (s, u, q, MPFR_RNDN);
exps = MPFR_EXP (s);
expU = exps;
for (k = 1; ;k ++)
{
/* update t */
mpfr_mul (t, t, y, MPFR_RNDN);
mpfr_div_ui (t, t, k, MPFR_RNDN);
mpfr_div_ui (t, t, n + k, MPFR_RNDN);
/* update p/q:
p/q + 1/k + 1/(n+k) = [p*k*(n+k) + q*(n+k) + q*k]/(q*k*(n+k)) */
mpz_mul_ui (p, p, k);
mpz_mul_ui (p, p, n + k);
mpz_addmul_ui (p, q, n + 2 * k);
mpz_mul_ui (q, q, k);
mpz_mul_ui (q, q, n + k);
mpfr_mul_z (u, t, p, MPFR_RNDN);
mpfr_div_z (u, u, q, MPFR_RNDN);
exps = MPFR_EXP (u);
if (exps > expU)
expU = exps;
mpfr_add (s, s, u, MPFR_RNDN);
exps = MPFR_EXP (s);
if (exps > expU)
expU = exps;
if (MPFR_EXP (u) + (mpfr_exp_t) MPFR_PREC (u) < MPFR_EXP (s) &&
zz / (2 * k) < k + n)
break;
}
mpfr_clear (t);
mpfr_clear (u);
mpz_clear (p);
mpz_clear (q);
exps = expU - MPFR_EXP (s);
/* the error is bounded by (6k^2+33/2k+11) 2^exps ulps
<= 8*(k+2)^2 2^exps ulps */
return 3 + 2 * MPFR_INT_CEIL_LOG2(k + 2) + exps;
}
/*------------------------------------------------------------------------*/
int my_mpfr_beta (mpfr_t R, mpfr_t a, mpfr_t b, mpfr_rnd_t RND)
{
mpfr_prec_t p_a = mpfr_get_prec(a), p_b = mpfr_get_prec(b);
if(p_a < p_b) p_a = p_b;// p_a := max(p_a, p_b)
if(mpfr_get_prec(R) < p_a)
mpfr_prec_round(R, p_a, RND);// so prec(R) = max( prec(a), prec(b) )
int ans;
mpfr_t s; mpfr_init2(s, p_a);
#ifdef DEBUG_Rmpfr
R_CheckUserInterrupt();
int cc = 0;
#endif
/* "FIXME": check each 'ans' below, and return when not ok ... */
ans = mpfr_add(s, a, b, RND);
if(mpfr_integer_p(s) && mpfr_sgn(s) <= 0) { // (a + b) is integer <= 0
if(!mpfr_integer_p(a) && !mpfr_integer_p(b)) {
// but a,b not integer ==> R = finite / +-Inf = 0 :
mpfr_set_zero (R, +1);
mpfr_clear (s);
return ans;
}// else: sum is integer; at least one {a,b} integer ==> both integer
int sX = mpfr_sgn(a), sY = mpfr_sgn(b);
if(sX * sY < 0) { // one negative, one positive integer
// ==> special treatment here :
if(sY < 0) // ==> sX > 0; swap the two
mpfr_swap(a, b);
// now have --- a < 0 < b <= |a| integer ------------------
/* ================ and in this case:
B(a,b) = (-1)^b B(1-a-b, b) = (-1)^b B(1-s, b)
= (1*2*..*b) / (-s-1)*(-s-2)*...*(-s-b)
*/
/* where in the 2nd form, both numerator and denominator have exactly
* b integer factors. This is attractive {numerically & speed wise}
* for 'small' b */
#define b_large 100
#ifdef DEBUG_Rmpfr
Rprintf(" my_mpfr_beta(<neg int>): s = a+b= "); R_PRT(s);
Rprintf("\n a = "); R_PRT(a);
Rprintf("\n b = "); R_PRT(b); Rprintf("\n");
if(cc++ > 999) { mpfr_set_zero (R, +1); mpfr_clear (s); return ans; }
#endif
unsigned long b_ = 0;// -Wall
Rboolean
b_fits_ulong = mpfr_fits_ulong_p(b, RND),
small_b = b_fits_ulong && (b_ = mpfr_get_ui(b, RND)) < b_large;
if(small_b) {
#ifdef DEBUG_Rmpfr
Rprintf(" b <= b_large = %d...\n", b_large);
#endif
//----------------- small b ------------------
// use GMP big integer arithmetic:
mpz_t S; mpz_init(S); mpfr_get_z(S, s, RND); // S := s
mpz_sub_ui (S, S, (unsigned long) 1); // S = s - 1 = (a+b-1)
/* binomial coefficient choose(N, k) requires k a 'long int';
* here, b must fit into a long: */
mpz_bin_ui (S, S, b_); // S = choose(S, b) = choose(a+b-1, b)
mpz_mul_ui (S, S, b_); // S = S*b = b * choose(a+b-1, b)
// back to mpfr: R = 1 / S = 1 / (b * choose(a+b-1, b))
mpfr_set_ui(s, (unsigned long) 1, RND);
mpfr_div_z(R, s, S, RND);
mpz_clear(S);
}
else { // b is "large", use direct B(.,.) formula
#ifdef DEBUG_Rmpfr
Rprintf(" b > b_large = %d...\n", b_large);
#endif
// a := (-1)^b :
// there is no mpfr_si_pow(a, -1, b, RND);
int neg; // := 1 ("TRUE") if (-1)^b = -1, i.e. iff b is odd
if(b_fits_ulong) { // (i.e. not very large)
neg = (b_ % 2); // 1 iff b_ is odd, 0 otherwise
} else { // really large b; as we know it is integer, can still..
// b2 := b / 2
mpfr_t b2; mpfr_init2(b2, p_a);
mpfr_div_2ui(b2, b, 1, RND);
neg = !mpfr_integer_p(b2); // b is odd, if b/2 is *not* integer
#ifdef DEBUG_Rmpfr
Rprintf(" really large b; neg = ('b is odd') = %d\n", neg);
#endif
}
// s' := 1-s = 1-a-b
mpfr_ui_sub(s, 1, s, RND);
#ifdef DEBUG_Rmpfr
Rprintf(" neg = %d\n", neg);
Rprintf(" s' = 1-a-b = "); R_PRT(s);
Rprintf("\n -> calling B(s',b)\n");
#endif
// R := B(1-a-b, b) = B(s', b)
if(small_b) {
my_mpfr_beta (R, s, b, RND);
} else {
my_mpfr_lbeta (R, s, b, RND);
mpfr_exp(R, R, RND); // correct *if* beta() >= 0
}
#ifdef DEBUG_Rmpfr
Rprintf(" R' = beta(s',b) = "); R_PRT(R); Rprintf("\n");
#endif
// Result = (-1)^b B(1-a-b, b) = +/- s'
if(neg) mpfr_neg(R, R, RND);
}
mpfr_clear(s);
return ans;
}
}
ans = mpfr_gamma(s, s, RND); /* s = gamma(a + b) */
#ifdef DEBUG_Rmpfr
Rprintf("my_mpfr_beta(): s = gamma(a+b)= "); R_PRT(s);
Rprintf("\n a = "); R_PRT(a);
Rprintf("\n b = "); R_PRT(b);
#endif
ans = mpfr_gamma(a, a, RND);
ans = mpfr_gamma(b, b, RND);
ans = mpfr_mul(b, b, a, RND); /* b' = gamma(a) * gamma(b) */
#ifdef DEBUG_Rmpfr
Rprintf("\n G(a) * G(b) = "); R_PRT(b); Rprintf("\n");
#endif
ans = mpfr_div(R, b, s, RND);
mpfr_clear (s);
/* mpfr_free_cache() must be called in the caller !*/
return ans;
}
static void
_assympt_mpfr (gulong l, mpq_t q, mpfr_ptr res, mp_rnd_t rnd)
{
NcmBinSplit **bs_ptr = _ncm_mpsf_sbessel_get_bs ();
NcmBinSplit *bs = *bs_ptr;
_binsplit_spherical_bessel *data = (_binsplit_spherical_bessel *) bs->userdata;
gulong prec = mpfr_get_prec (res);
#define sin_x data->sin
#define cos_x data->cos
mpfr_set_prec (sin_x, prec);
mpfr_set_prec (cos_x, prec);
mpfr_set_q (res, q, rnd);
mpfr_sin_cos (sin_x, cos_x, res, rnd);
switch (l % 4)
{
case 0:
break;
case 1:
mpfr_swap (sin_x, cos_x);
mpfr_neg (sin_x, sin_x, rnd);
break;
case 2:
mpfr_neg (sin_x, sin_x, rnd);
mpfr_neg (cos_x, cos_x, rnd);
break;
case 3:
mpfr_swap (sin_x, cos_x);
mpfr_neg (cos_x, cos_x, rnd);
break;
}
if (l > 0)
{
mpfr_mul_ui (cos_x, cos_x, l * (l + 1), rnd);
mpfr_div (cos_x, cos_x, res, rnd);
mpfr_div (cos_x, cos_x, res, rnd);
mpfr_div_2ui (cos_x, cos_x, 1, rnd);
}
mpfr_div (sin_x, sin_x, res, rnd);
data->l = l;
mpq_inv (data->mq2_2, q);
mpq_mul (data->mq2_2, data->mq2_2, data->mq2_2);
mpq_neg (data->mq2_2, data->mq2_2);
mpq_div_2exp (data->mq2_2, data->mq2_2, 2);
data->sincos = 0;
binsplit_spherical_bessel_assympt (bs, 0, (l + 1) / 2 + (l + 1) % 2);
mpfr_mul_z (sin_x, sin_x, bs->T, rnd);
mpfr_div_z (sin_x, sin_x, bs->Q, rnd);
data->sincos = 1;
if (l > 0)
{
binsplit_spherical_bessel_assympt (bs, 0, l / 2 + l % 2);
mpfr_mul_z (cos_x, cos_x, bs->T, rnd);
mpfr_div_z (cos_x, cos_x, bs->Q, rnd);
mpfr_add (res, sin_x, cos_x, rnd);
}
else
mpfr_set (res, sin_x, rnd);
ncm_memory_pool_return (bs_ptr);
return;
}
