static MPC_Object *
GMPy_MPC_From_MPFR(MPFR_Object *obj, mpfr_prec_t rprec, mpfr_prec_t iprec,
CTXT_Object *context)
{
MPC_Object *result;
assert(MPFR_Check(obj));
CHECK_CONTEXT(context);
if (rprec == 0)
rprec = GET_REAL_PREC(context);
else if (rprec == 1)
rprec = mpfr_get_prec(obj->f);
if (iprec == 0)
iprec = GET_IMAG_PREC(context);
else if (iprec == 1)
rprec = mpfr_get_prec(obj->f);
if ((result = GMPy_MPC_New(rprec, iprec, context))) {
result->rc = mpc_set_fr(result->c, obj->f, GET_MPC_ROUND(context));
if (rprec != 1) {
GMPY_MPC_CHECK_RANGE(result, context);
}
GMPY_MPC_SUBNORMALIZE(result, context);
GMPY_MPC_EXCEPTIONS(result, context);
}
return result;
}
void fmpz_poly_disc_gauss_rounding(fmpz_poly_t rop, const fmpq_poly_t x, const mpfr_t r_f, gmp_randstate_t randstate) {
mpfr_t xi; mpfr_init2(xi, mpfr_get_prec(r_f));
mpf_t xi_f; mpf_init2(xi_f, mpfr_get_prec(r_f));
mpq_t xi_q; mpq_init(xi_q);
mpz_t s_z; mpz_init(s_z);
const long n = fmpq_poly_length(x);
const size_t tau = (ceil(2*sqrt(log2((double)n))) > 3) ? ceil(2*sqrt(log2((double)n))) : 3;
fmpz_poly_zero(rop);
for(int i=0; i<n; i++) {
fmpq_poly_get_coeff_mpq(xi_q, x, i);
mpf_set_q(xi_f, xi_q);
mpfr_set_f(xi, xi_f, MPFR_RNDN);
dgs_disc_gauss_mp_t *D = dgs_disc_gauss_mp_init(r_f, xi, tau, DGS_DISC_GAUSS_UNIFORM_ONLINE);
D->call(s_z, D, randstate);
dgs_disc_gauss_mp_clear(D);
fmpz_poly_set_coeff_mpz(rop, i, s_z);
}
mpz_clear(s_z);
mpq_clear(xi_q);
mpf_clear(xi_f);
mpfr_clear(xi);
}
int
mpfr_ui_div (mpfr_ptr y, unsigned long int u, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_t uu;
mp_limb_t up[1];
unsigned long cnt;
MPFR_LOG_FUNC
(("u=%lu x[%Pu]=%.*Rg rnd=%d",
u, mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode),
("y[%Pu]=%.*Rg", mpfr_get_prec(y), mpfr_log_prec, y));
if (MPFR_UNLIKELY(MPFR_IS_SINGULAR(x)))
{
if (MPFR_IS_NAN(x))
{
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF(x)) /* u/Inf = 0 */
{
MPFR_SET_ZERO(y);
MPFR_SET_SAME_SIGN(y,x);
MPFR_RET(0);
}
else /* u / 0 */
{
MPFR_ASSERTD(MPFR_IS_ZERO(x));
if (u)
{
/* u > 0, so y = sign(x) * Inf */
MPFR_SET_SAME_SIGN(y, x);
MPFR_SET_INF(y);
mpfr_set_divby0 ();
MPFR_RET(0);
}
else
{
/* 0 / 0 */
MPFR_SET_NAN(y);
MPFR_RET_NAN;
}
}
}
else if (MPFR_LIKELY(u != 0))
{
MPFR_TMP_INIT1(up, uu, GMP_NUMB_BITS);
MPFR_ASSERTN(u == (mp_limb_t) u);
count_leading_zeros(cnt, (mp_limb_t) u);
up[0] = (mp_limb_t) u << cnt;
MPFR_SET_EXP (uu, GMP_NUMB_BITS - cnt);
return mpfr_div (y, uu, x, rnd_mode);
}
else /* u = 0, and x != 0 */
{
MPFR_SET_ZERO(y); /* if u=0, then set y to 0 */
MPFR_SET_SAME_SIGN(y, x); /* u considered as +0: sign(+0/x) = sign(x) */
MPFR_RET(0);
}
}
int
mpfr_mul_2si (mpfr_ptr y, mpfr_srcptr x, long int n, mpfr_rnd_t rnd_mode)
{
int inexact;
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg n=%ld rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x, n, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
return mpfr_set (y, x, rnd_mode);
else
{
mpfr_exp_t exp = MPFR_GET_EXP (x);
MPFR_SETRAW (inexact, y, x, exp, rnd_mode);
if (MPFR_UNLIKELY( n > 0 && (__gmpfr_emax < MPFR_EMIN_MIN + n ||
exp > __gmpfr_emax - n)))
return mpfr_overflow (y, rnd_mode, MPFR_SIGN(y));
else if (MPFR_UNLIKELY(n < 0 && (__gmpfr_emin > MPFR_EMAX_MAX + n ||
exp < __gmpfr_emin - n)))
{
if (rnd_mode == MPFR_RNDN &&
(__gmpfr_emin > MPFR_EMAX_MAX + (n + 1) ||
exp < __gmpfr_emin - (n + 1) ||
(inexact >= 0 && mpfr_powerof2_raw (y))))
rnd_mode = MPFR_RNDZ;
return mpfr_underflow (y, rnd_mode, MPFR_SIGN(y));
}
MPFR_SET_EXP (y, exp + n);
}
MPFR_RET (inexact);
}
/* compute remainder as in definition:
r = x - n * y, where n = trunc(x/y).
warning: may change flags. */
static int
slow_fmod (mpfr_ptr r, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd)
{
mpfr_t q;
int inexact;
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x) || MPFR_IS_SINGULAR (y)))
{
if (MPFR_IS_NAN (x) || MPFR_IS_NAN (y) || MPFR_IS_INF (x)
|| MPFR_IS_ZERO (y))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
else /* either y is Inf and x is 0 or non-special,
or x is 0 and y is non-special,
in both cases the quotient is zero. */
return mpfr_set (r, x, rnd);
}
/* regular cases */
/* if 2^(ex-1) <= |x| < 2^ex, and 2^(ey-1) <= |y| < 2^ey,
then |x/y| < 2^(ex-ey+1) */
mpfr_init2 (q,
MAX (MPFR_PREC_MIN, mpfr_get_exp (x) - mpfr_get_exp (y) + 1));
mpfr_div (q, x, y, MPFR_RNDZ);
mpfr_trunc (q, q); /* may change inexact flag */
mpfr_prec_round (q, mpfr_get_prec (q) + mpfr_get_prec (y), MPFR_RNDZ);
inexact = mpfr_mul (q, q, y, MPFR_RNDZ); /* exact */
inexact = mpfr_sub (r, x, q, rnd);
mpfr_clear (q);
return inexact;
}
MPFR_COLD_FUNCTION_ATTR int
mpfr_overflow (mpfr_ptr x, mpfr_rnd_t rnd_mode, int sign)
{
int inex;
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d sign=%d", mpfr_get_prec (x), mpfr_log_prec, x,
rnd_mode, sign),
("x[%Pu]=%.*Rg", mpfr_get_prec (x), mpfr_log_prec, x));
MPFR_ASSERT_SIGN (sign);
if (MPFR_IS_LIKE_RNDZ(rnd_mode, sign < 0))
{
mpfr_setmax (x, __gmpfr_emax);
inex = -1;
}
else
{
MPFR_SET_INF(x);
inex = 1;
}
MPFR_SET_SIGN(x, sign);
__gmpfr_flags |= MPFR_FLAGS_INEXACT | MPFR_FLAGS_OVERFLOW;
return sign > 0 ? inex : -inex;
}
int
mpfr_add_ui (mpfr_ptr y, mpfr_srcptr x, unsigned long int u, mpfr_rnd_t rnd_mode)
{
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg u=%lu rnd=%d",
mpfr_get_prec(x), mpfr_log_prec, x, u, rnd_mode),
("y[%Pu]=%.*Rg", mpfr_get_prec (y), mpfr_log_prec, y));
if (MPFR_LIKELY(u != 0) ) /* if u=0, do nothing */
{
mpfr_t uu;
mp_limb_t up[1];
unsigned long cnt;
int inex;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_TMP_INIT1 (up, uu, GMP_NUMB_BITS);
MPFR_ASSERTD (u == (mp_limb_t) u);
count_leading_zeros(cnt, (mp_limb_t) u);
up[0] = (mp_limb_t) u << cnt;
/* Optimization note: Exponent save/restore operations may be
removed if mpfr_add works even when uu is out-of-range. */
MPFR_SAVE_EXPO_MARK (expo);
MPFR_SET_EXP (uu, GMP_NUMB_BITS - cnt);
inex = mpfr_add(y, x, uu, rnd_mode);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range(y, inex, rnd_mode);
}
else
/* (unsigned long) 0 is assumed to be a real 0 (unsigned) */
return mpfr_set (y, x, rnd_mode);
}
void coords_pixel_to_coord(coords* c, mpfr_t x, mpfr_t y)
{
mpfr_t tmp;
mpfr_t tmp2;
mpfr_init2(tmp, mpfr_get_prec(x));
mpfr_init2(tmp2, mpfr_get_prec(x));
if (y != NULL)
{
mpfr_div_si(tmp2, c->width, c->img_width, GMP_RNDN);
mpfr_mul( tmp, tmp2, y, GMP_RNDN);
mpfr_sub( y, c->ymax, tmp, GMP_RNDN);
}
if (x != NULL)
{
mpfr_div_si(tmp2, x, c->img_width, GMP_RNDN);
mpfr_mul( tmp, tmp2, c->width, GMP_RNDN);
mpfr_add( x, tmp, c->xmin, GMP_RNDN);
}
mpfr_clear(tmp2);
mpfr_clear(tmp);
}
int
mpfr_d_div (mpfr_ptr a, double b, mpfr_srcptr c, mpfr_rnd_t rnd_mode)
{
int inexact;
mpfr_t d;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC (
("b=%.20g c[%Pu]=%*.Rg rnd=%d", b, mpfr_get_prec (c), mpfr_log_prec, c, rnd_mode),
("a[%Pu]=%*.Rg", mpfr_get_prec (a), mpfr_log_prec, a));
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (d, IEEE_DBL_MANT_DIG);
inexact = mpfr_set_d (d, b, rnd_mode);
MPFR_ASSERTN (inexact == 0);
mpfr_clear_flags ();
inexact = mpfr_div (a, d, c, rnd_mode);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
mpfr_clear(d);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (a, inexact, rnd_mode);
}
int
mpfr_mul_d (mpfr_ptr a, mpfr_srcptr b, double c, mpfr_rnd_t rnd_mode)
{
int inexact;
mpfr_t d;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("b[%Pu]=%.*Rg c=%.20g rnd=%d",
mpfr_get_prec(b), mpfr_log_prec, b, c, rnd_mode),
("a[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (a), mpfr_get_prec, a, inexact));
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (d, IEEE_DBL_MANT_DIG);
inexact = mpfr_set_d (d, c, rnd_mode);
MPFR_ASSERTN (inexact == 0);
mpfr_clear_flags ();
inexact = mpfr_mul (a, b, d, rnd_mode);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
mpfr_clear(d);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (a, inexact, rnd_mode);
}
int
mpfr_mul_d (mpfr_ptr a, mpfr_srcptr b, double c, mpfr_rnd_t rnd_mode)
{
int inexact;
mpfr_t d;
mp_limb_t tmp_man[MPFR_LIMBS_PER_DOUBLE];
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("b[%Pu]=%.*Rg c=%.20g rnd=%d",
mpfr_get_prec(b), mpfr_log_prec, b, c, rnd_mode),
("a[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (a), mpfr_log_prec, a, inexact));
MPFR_SAVE_EXPO_MARK (expo);
MPFR_TMP_INIT1(tmp_man, d, IEEE_DBL_MANT_DIG);
inexact = mpfr_set_d (d, c, rnd_mode);
MPFR_ASSERTD (inexact == 0);
MPFR_CLEAR_FLAGS ();
inexact = mpfr_mul (a, b, d, rnd_mode);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (a, inexact, rnd_mode);
}
void
tpl_copy_mpfr (mpfr_ptr dest, mpfr_srcptr src)
{
/* source and destination are assumed to be of the same precision , so the
copy is exact (no rounding) */
MPC_ASSERT(mpfr_get_prec (dest) == mpfr_get_prec (src));
mpfr_set (dest, src, GMP_RNDN);
}
/*
* fh : IN : file hander
* x : IN : MPFR number to put in the file
* return 0 if successful
*/
int
mpfr_fpif_export (FILE *fh, mpfr_t x)
{
int status;
unsigned char *buf;
unsigned char *bufResult;
size_t used_size, buf_size;
if (fh == NULL)
return -1;
buf_size = MAX_VARIABLE_STORAGE(sizeof(mpfr_exp_t), mpfr_get_prec (x));
buf = (unsigned char*) (*__gmp_allocate_func) (buf_size);
if (buf == NULL)
return -1;
used_size = buf_size;
buf = mpfr_fpif_store_precision (buf, &used_size, mpfr_get_prec (x));
used_size > buf_size ? buf_size = used_size : 0;
status = fwrite (buf, used_size, 1, fh);
if (status != 1)
{
(*__gmp_free_func) (buf, buf_size);
return -1;
}
used_size = buf_size;
bufResult = mpfr_fpif_store_exponent (buf, &used_size, x);
if (bufResult == NULL)
{
(*__gmp_free_func) (buf, buf_size);
return -1;
}
buf = bufResult;
used_size > buf_size ? buf_size = used_size : 0;
status = fwrite (buf, used_size, 1, fh);
if (status != 1)
{
(*__gmp_free_func) (buf, buf_size);
return -1;
}
if (mpfr_regular_p (x))
{
used_size = buf_size;
buf = mpfr_fpif_store_limbs (buf, &used_size, x);
used_size > buf_size ? buf_size = used_size : 0;
status = fwrite (buf, used_size, 1, fh);
if (status != 1)
{
(*__gmp_free_func) (buf, buf_size);
return -1;
}
}
(*__gmp_free_func) (buf, buf_size);
return 0;
}
static Obj MPD_2MPFR (Obj self, Obj fl, Obj fr)
{
mp_prec_t precl = mpfr_get_prec(GET_MPFR(fl)),
precr = mpfr_get_prec(GET_MPFR(fr));
Obj g = NEW_MPD(precl > precr ? precl : precr);
mpfr_set (MPD_OBJ(g)->re, GET_MPFR(fl), GMP_RNDN);
mpfr_set (MPD_OBJ(g)->im, GET_MPFR(fr), GMP_RNDN);
return g;
}
/* given y = o(x/u), x, u, find the inexact flag by
multiplying y by u */
static int
get_inexact (mpfr_t y, mpfr_t x, mpfr_t u)
{
mpfr_t xx;
int inex;
mpfr_init2 (xx, mpfr_get_prec (y) + mpfr_get_prec (u));
mpfr_mul (xx, y, u, MPFR_RNDN); /* exact */
inex = mpfr_cmp (xx, x);
mpfr_clear (xx);
return inex;
}
static __inline__ void
mpfr_add_bound(mpfr_t r,const mpfr_t s)
{
mpfr_prec_t s_prec=mpfr_get_prec(s);
if(s_prec > mpfr_get_prec(r) )
{
mpfr_t n; mpfr_init2(n,s_prec);
mpfr_swap(n,r);
mpfr_add(r,n,s,MPFR_RNDU);
mpfr_clear(n);
}
else
mpfr_add(r,r,s,MPFR_RNDU);
}
int
mpfr_root (mpfr_ptr y, mpfr_srcptr x, unsigned long k, mpfr_rnd_t rnd_mode)
{
mpz_t m;
mpfr_exp_t e, r, sh;
mpfr_prec_t n, size_m, tmp;
int inexact, negative;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg k=%lu rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x, k, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
if (MPFR_UNLIKELY (k <= 1))
{
if (k < 1) /* k==0 => y=x^(1/0)=x^(+Inf) */
#if 0
/* For 0 <= x < 1 => +0.
For x = 1 => 1.
For x > 1, => +Inf.
For x < 0 => NaN.
*/
{
if (MPFR_IS_NEG (x) && !MPFR_IS_ZERO (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
inexact = mpfr_cmp (x, __gmpfr_one);
if (inexact == 0)
return mpfr_set_ui (y, 1, rnd_mode); /* 1 may be Out of Range */
else if (inexact < 0)
return mpfr_set_ui (y, 0, rnd_mode); /* 0+ */
else
{
mpfr_set_inf (y, 1);
return 0;
}
}
#endif
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else /* y =x^(1/1)=x */
return mpfr_set (y, x, rnd_mode);
}
static PyObject *
GMPy_Real_Round2(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPFR_Object *result, *tempx;
long n = 0;
CHECK_CONTEXT(context);
if (y) {
n = PyIntOrLong_AsLong(y);
if ( (n == -1 && PyErr_Occurred()) || n < MPFR_PREC_MIN || n > MPFR_PREC_MAX) {
VALUE_ERROR("invalid precision");
return NULL;
}
}
if (!(tempx = GMPy_MPFR_From_Real(x, 1, context))) {
return NULL;
}
if (!(result = GMPy_MPFR_New(mpfr_get_prec(tempx->f), context))) {
Py_DECREF((PyObject*)tempx);
return NULL;
}
mpfr_set(result->f, tempx->f, GET_MPFR_ROUND(context));
Py_DECREF((PyObject*)tempx);
mpfr_clear_flags();
result->rc = mpfr_prec_round(result->f, n, GET_MPFR_ROUND(context));
_GMPy_MPFR_Cleanup(&result, context);
return (PyObject*)result;
}
/*
* x : OUT : MPFR number extracted from the binary buffer, should have the same
* precision than the number in the binary format
* buffer : IN : limb of the MPFR number x in a binary format,
* buffer_size : IN/OUT : size of the buffer => size used in the buffer
* return 0 if successful
*/
static int
mpfr_fpif_read_limbs (mpfr_t x, unsigned char *buffer, size_t *buffer_size)
{
mpfr_prec_t precision;
size_t nb_byte;
size_t mp_bytes_per_limb;
size_t nb_partial_byte;
size_t i, j;
precision = mpfr_get_prec (x);
nb_byte = (precision + 7) >> 3;
mp_bytes_per_limb = mp_bits_per_limb >> 3;
nb_partial_byte = nb_byte % mp_bytes_per_limb;
if ((buffer == NULL) || (*buffer_size < nb_byte))
{
*buffer_size = 0;
return 1;
}
*buffer_size = nb_byte;
if (nb_partial_byte > 0)
{
memset (MPFR_MANT(x), 0, sizeof(mp_limb_t));
getBigEndianData ((unsigned char*) MPFR_MANT(x), buffer,
sizeof(mp_limb_t), nb_partial_byte);
}
for (i = nb_partial_byte, j = (nb_partial_byte == 0) ? 0 : 1; i < nb_byte;
i += mp_bytes_per_limb, j++)
getLittleEndianData ((unsigned char*) (MPFR_MANT(x) + j), buffer + i,
sizeof(mp_limb_t), sizeof(mp_limb_t));
return 0;
}
/*
* buffer : OUT : store the limb of the MPFR number x in a binary format,
* can be null (may be reallocated if too small)
* buffer_size : IN/OUT : size of the buffer => size used in the buffer
* x : IN : MPFR number
* return pointer to a buffer storing the limb of the MPFR number x in a binary
* format
*/
static unsigned char*
mpfr_fpif_store_limbs (unsigned char *buffer, size_t *buffer_size, mpfr_t x)
{
unsigned char *result;
mpfr_prec_t precision;
size_t nb_byte;
size_t nb_limb, mp_bytes_per_limb;
size_t nb_partial_byte;
size_t i, j;
precision = mpfr_get_prec (x);
nb_byte = (precision + 7) >> 3;
mp_bytes_per_limb = mp_bits_per_limb >> 3;
nb_partial_byte = nb_byte % mp_bytes_per_limb;
nb_limb = (nb_byte + mp_bytes_per_limb - 1) / mp_bytes_per_limb;
result = buffer;
ALLOC_RESULT(result, buffer_size, nb_byte);
putBigEndianData (result, (unsigned char*) MPFR_MANT(x),
sizeof(mp_limb_t), nb_partial_byte);
for (i = nb_partial_byte, j = (nb_partial_byte == 0) ? 0 : 1; j < nb_limb;
i += mp_bytes_per_limb, j++)
putLittleEndianData (result + i, (unsigned char*) (MPFR_MANT(x) + j),
sizeof(mp_limb_t), sizeof(mp_limb_t));
return result;
}
/** Binomial Coefficient --
* all initialization and cleanup is called in the caller
* @result R = choose(X, n)
*/
int my_mpfr_choose (mpfr_t R, long n, mpfr_t X, mpfr_rnd_t RND)
{
int ans;
long i;
mpfr_t r, x;
mpfr_prec_t p_X = mpfr_get_prec(X);
mpfr_init2(x, p_X); mpfr_set(x, X, RND);
mpfr_init2(r, p_X);
if(n > 0) {
mpfr_set(r, X, RND);
for(i=1; i < n; ) {
mpfr_sub_si(x, x, 1L, RND); // x = X - i
mpfr_mul (r, r, x, RND); // r := r * x = X(X-1)..(X-i)
mpfr_div_si(r, r, ++i, RND);
// r := r / (i+1) = X(X-1)..(X-i) / (1*2..*(i+1))
#ifdef DEBUG_Rmpfr
Rprintf("my_mpfr_choose(): X (= X_0 - %d)= ", i); R_PRT(x);
Rprintf("\n --> r ="); R_PRT(r); Rprintf("\n");
#endif
}
}
else // n = 0
mpfr_set_si(r, (long) 1, RND);
ans = mpfr_set(R, r, RND);
mpfr_clear (x);
mpfr_clear (r);
return ans;
}
/** Pochhammer Symbol -- *rising* factorial x * (x+1) * ... (x+n-1)
* all initialization and cleanup is called in the caller
*/
int my_mpfr_poch (mpfr_t R, long n, mpfr_t X, mpfr_rnd_t RND)
{
int ans;
long i;
mpfr_t r, x;
mpfr_prec_t p_X = mpfr_get_prec(X);
mpfr_init2(x, p_X); mpfr_set(x, X, RND);
mpfr_init2(r, p_X);
if(n > 0) {
mpfr_set(r, X, RND);
for(i=1; i < n; i++) {
mpfr_add_si(x, x, 1L, RND); // x = X + i
mpfr_mul(r, r, x, RND); // r := r * x = X(X+1)..(X+i)
#ifdef DEBUG_Rmpfr
Rprintf("my_mpfr_poch(): X (= X_0 + %d)= ", i); R_PRT(x);
Rprintf("\n --> r ="); R_PRT(r); Rprintf("\n");
#endif
}
}
else // n = 0
mpfr_set_si(r, (long) 1, RND);
ans = mpfr_set(R, r, RND);
mpfr_clear (x);
mpfr_clear (r);
return ans;
}
static void
tgeneric_fc (mpc_function *function, mpc_ptr op, mpfr_ptr rop,
mpfr_ptr rop4, mpfr_ptr rop4rnd, mpfr_rnd_t rnd)
{
function->pointer.FC (rop4, op, rnd);
function->pointer.FC (rop, op, rnd);
if (MPFR_CAN_ROUND (rop4, 1, mpfr_get_prec (rop), rnd))
mpfr_set (rop4rnd, rop4, rnd);
else
return;
if (same_mpfr_value (rop, rop4rnd, 1))
return;
printf ("Rounding in %s might be incorrect for\n", function->name);
MPC_OUT (op);
printf ("with rounding mode %s", mpfr_print_rnd_mode (rnd));
printf ("\n%s gives ", function->name);
MPFR_OUT (rop);
printf ("%s quadruple precision gives ", function->name);
MPFR_OUT (rop4);
printf ("and is rounded to ");
MPFR_OUT (rop4rnd);
exit (1);
}
static PyObject *
GMPy_Context_NextBelow(PyObject *self, PyObject *other)
{
MPFR_Object *result, *tempx;
CTXT_Object *context = NULL;
mpfr_rnd_t temp_round;
if (self && CTXT_Check(self)) {
context = (CTXT_Object*)self;
}
else {
CHECK_CONTEXT(context);
}
if (!(tempx = GMPy_MPFR_From_Real(other, 1, context))) {
TYPE_ERROR("next_below() argument type not supported");
return NULL;
}
if (!(result = GMPy_MPFR_New(mpfr_get_prec(tempx->f), context))) {
Py_DECREF((PyObject*)tempx);
return NULL;
}
mpfr_clear_flags();
mpfr_set(result->f, tempx->f, GET_MPFR_ROUND(context));
Py_DECREF((PyObject*)tempx);
mpfr_nextbelow(result->f);
result->rc = 0;
temp_round = GET_MPFR_ROUND(context);
context->ctx.mpfr_round = MPFR_RNDD;
_GMPy_MPFR_Cleanup(&result, context);
context->ctx.mpfr_round = temp_round;
return (PyObject*)result;
}
std::ostream& operator << (std::ostream &sout, mpfr_t m){
if (&m != NULL){
// int mp_prec = int(mpfr_get_prec(m));
// assume a base of 10 to output
// d = log10(2^b);
// std::cout << "int(mpfr_get_prec(m)) = " << int(mpfr_get_prec(m)) << "\n";
int buf_size = floor( int(mpfr_get_prec(m))* log10(2));
// std::cout << "buf_size = " << buf_size;
char* the_buf = new char[buf_size];
std::stringstream somess;
somess << "%." << buf_size << "RNf";
mpfr_sprintf(the_buf, somess.str().c_str() , m);
sout << the_buf;
delete[] the_buf;
}
return sout;
}
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;
}
/* res <- x[0]*y[0] + ... + x[n-1]*y[n-1] */
int
mpc_dot (mpc_ptr res, const mpc_ptr *x, const mpc_ptr *y,
unsigned long n, mpc_rnd_t rnd)
{
int inex_re, inex_im;
mpfr_ptr *t;
mpfr_t *z;
unsigned long i;
z = (mpfr_t *) malloc (2 * n * sizeof (mpfr_t));
MPC_ASSERT(z != NULL);
t = (mpfr_ptr *) malloc (2 * n * sizeof(mpfr_ptr));
MPC_ASSERT(t != NULL);
for (i = 0; i < 2 * n; i++)
t[i] = z[i];
/* we first store in z[i] the value of Re(x[i])*Re(y[i])
and in z[n+i] that of -Im(x[i])*Im(y[i]) */
for (i = 0; i < n; i++)
{
mpfr_prec_t prec_x_re = mpfr_get_prec (mpc_realref (x[i]));
mpfr_prec_t prec_x_im = mpfr_get_prec (mpc_imagref (x[i]));
mpfr_prec_t prec_y_re = mpfr_get_prec (mpc_realref (y[i]));
mpfr_prec_t prec_y_im = mpfr_get_prec (mpc_imagref (y[i]));
mpfr_prec_t prec_y_max = MPC_MAX (prec_y_re, prec_y_im);
/* we allocate z[i] with prec_x_re + prec_y_max bits
so that the second loop below does not reallocate */
mpfr_init2 (z[i], prec_x_re + prec_y_max);
mpfr_set_prec (z[i], prec_x_re + prec_y_re);
mpfr_mul (z[i], mpc_realref (x[i]), mpc_realref (y[i]), MPFR_RNDZ);
/* idem for z[n+i]: we allocate with prec_x_im + prec_y_max bits */
mpfr_init2 (z[n+i], prec_x_im + prec_y_max);
mpfr_set_prec (z[n+i], prec_x_im + prec_y_im);
mpfr_mul (z[n+i], mpc_imagref (x[i]), mpc_imagref (y[i]), MPFR_RNDZ);
mpfr_neg (z[n+i], z[n+i], MPFR_RNDZ);
}
inex_re = mpfr_sum (mpc_realref (res), t, 2 * n, MPC_RND_RE (rnd));
/* we then store in z[i] the value of Re(x[i])*Im(y[i])
and in z[n+i] that of Im(x[i])*Re(y[i]) */
for (i = 0; i < n; i++)
{
mpfr_prec_t prec_x_re = mpfr_get_prec (mpc_realref (x[i]));
mpfr_prec_t prec_x_im = mpfr_get_prec (mpc_imagref (x[i]));
mpfr_prec_t prec_y_re = mpfr_get_prec (mpc_realref (y[i]));
mpfr_prec_t prec_y_im = mpfr_get_prec (mpc_imagref (y[i]));
mpfr_set_prec (z[i], prec_x_re + prec_y_im);
mpfr_mul (z[i], mpc_realref (x[i]), mpc_imagref (y[i]), MPFR_RNDZ);
mpfr_set_prec (z[n+i], prec_x_im + prec_y_re);
mpfr_mul (z[n+i], mpc_imagref (x[i]), mpc_realref (y[i]), MPFR_RNDZ);
}
inex_im = mpfr_sum (mpc_imagref (res), t, 2 * n, MPC_RND_IM (rnd));
for (i = 0; i < 2 * n; i++)
mpfr_clear (z[i]);
free (t);
free (z);
return MPC_INEX(inex_re, inex_im);
}
static Obj MPD_MPFR(Obj self, Obj f)
{
Obj g = NEW_MPD (mpfr_get_prec(GET_MPFR(f)));
mpfr_set (MPD_OBJ(g)->re, GET_MPFR(f), GMP_RNDN);
mpfr_set_ui (MPD_OBJ(g)->im, 0, GMP_RNDN);
return g;
}
int
mpfi_sech (mpfi_ptr a, mpfi_srcptr b)
{
mpfr_t tmp;
int inexact_left, inexact_right, inexact=0;
if ( MPFI_NAN_P (b) ) {
mpfr_set_nan (&(a->left));
mpfr_set_nan (&(a->right));
MPFR_RET_NAN;
}
if ( MPFI_IS_NONNEG (b) ) {
mpfr_init2 (tmp, mpfr_get_prec (&(a->left)));
inexact_left = mpfr_sech (tmp, &(b->right), MPFI_RNDD);
inexact_right = mpfr_sech (&(a->right), &(b->left), MPFI_RNDU);
mpfr_set (&(a->left), tmp, MPFI_RNDD); /* exact */
mpfr_clear (tmp);
}
else if ( MPFI_HAS_ZERO (b) ) {
mpfr_init2 (tmp, mpfr_get_prec (&(b->left)));
mpfr_neg (tmp, &(b->left), MPFI_RNDD); /* exact */
if (mpfr_cmp (tmp, &(b->right)) > 0)
inexact_left = mpfr_sech (&(a->left), tmp, MPFI_RNDD);
else
inexact_left = mpfr_sech (&(a->left), &(b->right), MPFI_RNDD);
inexact_right = mpfr_set_ui (&(a->right), 1, MPFI_RNDU);
mpfr_clear (tmp);
}
else { /* b <= 0 */
inexact_left = mpfr_sech (&(a->left), &(b->left), MPFI_RNDD);
inexact_right = mpfr_sech (&(a->right), &(b->right), MPFI_RNDU);
}
/* do not allow +0 as upper bound */
if (mpfr_zero_p (&(a->right)) && !mpfr_signbit (&(a->right))) {
mpfr_neg (&(a->right), &(a->right), MPFI_RNDD);
}
if (inexact_left)
inexact += 1;
if (inexact_right)
inexact += 2;
return inexact;
}
static void
check (long int n, long int d, mpfr_rnd_t rnd, const char *ys)
{
mpq_t q;
mpfr_t x, t;
int inexact, compare;
unsigned int flags, ex_flags;
mpfr_init2 (x, 53);
mpfr_init2 (t, mpfr_get_prec (x) + mp_bits_per_limb);
mpq_init (q);
mpq_set_si (q, n, d);
mpfr_clear_flags ();
inexact = mpfr_set_q (x, q, rnd);
flags = __gmpfr_flags;
/* check values */
if (mpfr_cmp_str1 (x, ys))
{
printf ("Error for q = %ld/%ld and rnd = %s\n", n, d,
mpfr_print_rnd_mode (rnd));
printf ("correct result is %s, mpfr_set_q gives ", ys);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
/* check inexact flag */
if (mpfr_mul_ui (t, x, (d < 0) ? (-d) : d, rnd))
{
printf ("t <- x * d should be exact\n");
exit (1);
}
compare = mpfr_cmp_si (t, n);
if (! SAME_SIGN (inexact, compare))
{
printf ("Wrong ternary value for q = %ld/%ld and rnd = %s:\n"
"expected %d or equivalent, got %d\n",
n, d, mpfr_print_rnd_mode (rnd), compare, inexact);
exit (1);
}
ex_flags = compare == 0 ? 0 : MPFR_FLAGS_INEXACT;
if (flags != ex_flags)
{
printf ("Wrong flags for q = %ld/%ld and rnd = %s:\n",
n, d, mpfr_print_rnd_mode (rnd));
printf ("Expected flags:");
flags_out (ex_flags);
printf ("Got flags: ");
flags_out (flags);
exit (1);
}
mpfr_clear (x);
mpfr_clear (t);
mpq_clear (q);
}
