/* This function does not change the flags. */
static void
mpfr_get_zexp (mpz_ptr ez, mpfr_srcptr x)
{
mpz_init (ez);
if (MPFR_IS_UBF (x))
mpz_set (ez, MPFR_ZEXP (x));
else
{
mp_limb_t e_limb[MPFR_EXP_LIMB_SIZE];
mpfr_t e;
int inex;
MPFR_SAVE_EXPO_DECL (expo);
/* TODO: Once this has been tested, optimize based on whether
_MPFR_EXP_FORMAT <= 3. */
MPFR_TMP_INIT1 (e_limb, e, sizeof (mpfr_exp_t) * CHAR_BIT);
MPFR_SAVE_EXPO_MARK (expo);
MPFR_DBGRES (inex = mpfr_set_exp_t (e, MPFR_GET_EXP (x), MPFR_RNDN));
MPFR_ASSERTD (inex == 0);
MPFR_DBGRES (inex = mpfr_get_z (ez, e, MPFR_RNDN));
MPFR_ASSERTD (inex == 0);
MPFR_SAVE_EXPO_FREE (expo);
}
}
/**
* Wrapper function to find the log of a number of type mpz_t.
*/
void compute_logn(mpz_t rop, mpz_t n) {
mpfr_t tmp;
mpfr_init(tmp);
mpfr_set_z(tmp, n, MPFR_RNDN);
mpfr_log(tmp, tmp, MPFR_RNDN);
mpfr_get_z(rop, tmp, MPFR_RNDN);
mpfr_clear(tmp);
}
static void
check_diff (void)
{
int inex;
mpfr_t x;
mpz_t z;
mpfr_exp_t emin;
mpz_init (z);
mpfr_init2 (x, 2);
mpfr_set_ui (x, 2047, MPFR_RNDU);
mpz_set_fr (z, x, MPFR_RNDN);
if (mpz_cmp_ui (z, 2048) != 0)
{
printf ("get_z RU 2048 failed\n");
exit (1);
}
mpfr_set_prec (x, 6);
mpfr_set_str (x, "17.5", 10, MPFR_RNDN);
inex = mpfr_get_z (z, x, MPFR_RNDN);
if (inex <= 0 || mpz_cmp_ui (z, 18) != 0)
{
printf ("get_z RN 17.5 failed\n");
exit (1);
}
/* save default emin */
emin = mpfr_get_emin ();;
mpfr_set_emin (17);
mpfr_set_ui (x, 0, MPFR_RNDN);
inex = mpfr_get_z (z, x, MPFR_RNDN);
if (inex != 0 || mpz_cmp_ui (z, 0) != 0)
{
printf ("get_z 0 failed\n");
exit (1);
}
/* restore default emin */
mpfr_set_emin (emin);
mpfr_clear (x);
mpz_clear (z);
}
/**
* Wrapper function to find the square of the log of a number of type mpz_t.
*/
void compute_logn2(mpz_t rop, mpz_t n) {
mpfr_t tmp;
mpfr_init(tmp);
mpfr_set_z(tmp, n, MPFR_RNDN);
mpfr_log(tmp, tmp, MPFR_RNDA);
mpfr_pow_ui(tmp, tmp, 2, MPFR_RNDA);
mpfr_ceil(tmp, tmp);
mpfr_get_z(rop, tmp, MPFR_RNDA);
mpfr_clear(tmp);
}
static void
check_one (mpz_ptr z)
{
int inex;
int sh, neg;
mpfr_t f;
mpz_t got;
mpfr_init2 (f, MAX( mpz_sizeinbase (z, 2), MPFR_PREC_MIN) );
mpz_init (got);
for (sh = -2*GMP_NUMB_BITS ; sh < 2*GMP_NUMB_BITS ; sh++)
{
for (neg = 0; neg <= 1; neg++)
{
mpz_neg (z, z);
mpfr_set_z (f, z, MPFR_RNDN);
if (sh < 0)
{
mpz_tdiv_q_2exp (z, z, -sh);
mpfr_div_2exp (f, f, -sh, MPFR_RNDN);
}
else
{
mpz_mul_2exp (z, z, sh);
mpfr_mul_2exp (f, f, sh, MPFR_RNDN);
}
inex = mpfr_get_z (got, f, MPFR_RNDZ);
if (mpz_cmp (got, z) != 0)
{
printf ("Wrong result for shift=%d\n", sh);
printf (" f "); mpfr_dump (f);
printf (" got "); mpz_dump (got);
printf (" want "); mpz_dump (z);
exit (1);
}
if (! SAME_SIGN (inex, - mpfr_cmp_z (f, z)))
{
printf ("Wrong inexact value for shift=%d\n", sh);
printf (" f "); mpfr_dump (f);
printf (" got %+d\n", inex);
printf (" want %+d\n", -mpfr_cmp_z (f, z));
exit (1);
}
}
}
mpfr_clear (f);
mpz_clear (got);
}
void _arith_euler_number_zeta(fmpz_t res, ulong n)
{
mpz_t r;
mpfr_t t, z, pi;
mp_bitcnt_t prec, pi_prec;
if (n % 2)
{
fmpz_zero(res);
return;
}
if (n < SMALL_EULER_LIMIT)
{
fmpz_set_ui(res, euler_number_small[n / 2]);
if (n % 4 == 2)
fmpz_neg(res, res);
return;
}
prec = arith_euler_number_size(n) + 10;
pi_prec = prec + FLINT_BIT_COUNT(n);
mpz_init(r);
mpfr_init2(t, prec);
mpfr_init2(z, prec);
mpfr_init2(pi, pi_prec);
flint_mpz_fac_ui(r, n);
mpfr_set_z(t, r, GMP_RNDN);
mpfr_mul_2exp(t, t, n + 2, GMP_RNDN);
/* pi^(n + 1) * L(n+1) */
mpfr_zeta_inv_euler_product(z, n + 1, 1);
mpfr_const_pi(pi, GMP_RNDN);
mpfr_pow_ui(pi, pi, n + 1, GMP_RNDN);
mpfr_mul(z, z, pi, GMP_RNDN);
mpfr_div(t, t, z, GMP_RNDN);
/* round */
mpfr_round(t, t);
mpfr_get_z(r, t, GMP_RNDN);
fmpz_set_mpz(res, r);
if (n % 4 == 2)
fmpz_neg(res, res);
mpz_clear(r);
mpfr_clear(t);
mpfr_clear(z);
mpfr_clear(pi);
}
static VALUE r_mpfr_to_mpz(int argc, VALUE *argv, VALUE self)
{
VALUE ptr_return;
MPFR *ptr_self;
MP_INT *ptr_mpz;
mp_rnd_t rnd;
rnd = r_mpfr_rnd_from_optional_argument(0, 1, argc, argv);
r_mpfr_get_struct(ptr_self, self);
mpz_make_struct_init(ptr_return, ptr_mpz);
mpfr_get_z(ptr_mpz, ptr_self, rnd);
return ptr_return;
}
//-----------------------------------------------------------
// base <- exp((1/2) sqrt(ln(n) ln(ln(n))))
//-----------------------------------------------------------
void get_smoothness_base(mpz_t base, mpz_t n) {
mpfr_t fN, lnN, lnlnN;
mpfr_init(fN), mpfr_init(lnN), mpfr_init(lnlnN);
mpfr_set_z(fN, n, MPFR_RNDU);
mpfr_log(lnN, fN, MPFR_RNDU);
mpfr_log(lnlnN, lnN, MPFR_RNDU);
mpfr_mul(fN, lnN, lnlnN, MPFR_RNDU);
mpfr_sqrt(fN, fN, MPFR_RNDU);
mpfr_div_ui(fN, fN, 2, MPFR_RNDU);
mpfr_exp(fN, fN, MPFR_RNDU);
mpfr_get_z(base, fN, MPFR_RNDU);
mpfr_clears(fN, lnN, lnlnN, NULL);
}
void
number_of_partitions(fmpz_t x, ulong n)
{
if (n < NUMBER_OF_SMALL_PARTITIONS)
{
fmpz_set_ui(x, partitions_lookup[n]);
}
else
{
mpfr_t t;
mpfr_init(t);
number_of_partitions_mpfr(t, n);
mpfr_get_z(_fmpz_promote(x), t, MPFR_RNDN);
_fmpz_demote_val(x);
mpfr_clear(t);
}
}
static void
check_one (mpz_ptr z)
{
int sh, neg;
mpfr_t f;
mpz_t got;
mpfr_init2 (f, MAX( mpz_sizeinbase (z, 2), MPFR_PREC_MIN) );
mpz_init (got);
for (sh = -2*BITS_PER_MP_LIMB ; sh < 2*BITS_PER_MP_LIMB ; sh++)
{
for (neg = 0; neg <= 1; neg++)
{
mpz_neg (z, z);
mpfr_set_z (f, z, GMP_RNDN);
if (sh < 0)
{
mpz_tdiv_q_2exp (z, z, -sh);
mpfr_div_2exp (f, f, -sh, GMP_RNDN);
}
else
{
mpz_mul_2exp (z, z, sh);
mpfr_mul_2exp (f, f, sh, GMP_RNDN);
}
mpfr_get_z (got, f, GMP_RNDZ);
if (mpz_cmp (got, z) != 0)
{
printf ("Wrong result for shift=%d\n", sh);
printf (" f "); mpfr_dump (f);
printf (" got "); mpz_dump (got);
printf (" want "); mpz_dump (z);
exit (1);
}
}
}
mpfr_clear (f);
mpz_clear (got);
}
num_t
num_new_z(int flags, num_t b)
{
num_t r;
r = num_new(flags);
r->num_type = NUM_INT;
mpz_init(Z(r));
if (b != NULL) {
if (b->num_type == NUM_INT)
mpz_set(Z(r), Z(b));
else if (b->num_type == NUM_FP)
mpfr_get_z(Z(r), F(b), round_mode);
}
return r;
}
mpz_class FirstLogTable::function(int x)
{
mpz_class result;
double apprinv;
mpfr_t i,l;
mpz_t r;
mpfr_init(i);
mpfr_init2(l,wOut);
mpz_init2(r,400);
apprinv = fit->output2double(fit->function(x));;
// result = double2output(log(apprinv));
mpfr_set_d(i, apprinv, GMP_RNDN);
mpfr_log(l, i, GMP_RNDN);
mpfr_neg(l, l, GMP_RNDN);
// Remove the sum of small offsets that are added to the other log tables
for(int j=1; j<=op->stages; j++){
mpfr_set_d(i, 1.0, GMP_RNDN);
int pi=op->p[j];
mpfr_mul_2si(i, i, -2*pi, GMP_RNDN);
mpfr_sub(l, l, i, GMP_RNDN);
}
// code the log in 2's compliment
mpfr_mul_2si(l, l, wOut, GMP_RNDN);
mpfr_get_z(r, l, GMP_RNDN);
result = mpz_class(r); // signed
// This is a very inefficient way of converting
mpz_class t = mpz_class(1) << wOut;
result = t+result;
if(result>t) result-=t;
// cout << "x="<<x<<" apprinv="<<apprinv<<" logapprinv="<<log(apprinv)<<" result="<<result<<endl;
mpfr_clear(i);
mpfr_clear(l);
mpz_clear(r);
return result;
}
void HOTBM::emulate(TestCase* tc)
{
/* Get inputs / outputs */
mpz_class sx = tc->getInputValue ("X");
// int outSign = 0;
mpfr_t mpX, mpR;
mpfr_inits(mpX, mpR, 0, NULL);
/* Convert a random signal to an mpfr_t in [0,1[ */
mpfr_set_z(mpX, sx.get_mpz_t(), GMP_RNDN);
mpfr_div_2si(mpX, mpX, wI, GMP_RNDN);
/* Compute the function */
f.eval(mpR, mpX);
/* Compute the signal value */
if (mpfr_signbit(mpR))
{
// outSign = 1;
mpfr_abs(mpR, mpR, GMP_RNDN);
}
mpfr_mul_2si(mpR, mpR, wO, GMP_RNDN);
/* NOT A TYPO. HOTBM only guarantees faithful
* rounding, so we will round down here,
* add both the upper and lower neighbor.
*/
mpz_t rd_t;
mpz_init (rd_t);
mpfr_get_z(rd_t, mpR, GMP_RNDD);
mpz_class rd (rd_t), ru = rd + 1;
tc->addExpectedOutput ("R", rd);
tc->addExpectedOutput ("R", ru);
mpz_clear (rd_t);
mpfr_clear (mpX);
mpfr_clear (mpR);
}
static void
special (void)
{
int inex;
mpfr_t x;
mpz_t z;
int i;
mpfr_exp_t e;
mpfr_init2 (x, 2);
mpz_init (z);
for (i = -1; i <= 1; i++)
{
if (i != 0)
mpfr_set_nan (x);
else
mpfr_set_inf (x, i);
mpfr_clear_flags ();
inex = mpfr_get_z (z, x, MPFR_RNDN);
if (!mpfr_erangeflag_p () || inex != 0 || mpz_cmp_ui (z, 0) != 0)
{
printf ("special() failed on mpfr_get_z for i = %d\n", i);
exit (1);
}
mpfr_clear_flags ();
e = mpfr_get_z_2exp (z, x);
if (!mpfr_erangeflag_p () || e != __gmpfr_emin ||
mpz_cmp_ui (z, 0) != 0)
{
printf ("special() failed on mpfr_get_z_2exp for i = %d\n", i);
exit (1);
}
}
mpfr_clear (x);
mpz_clear (z);
}
void MathUtils::GetSmoothnessBase(mpz_class& ret_base, mpz_class& N)
{
mpfr_t f_N, log_N, log_log_N;
mpz_t base_mpz;
mpz_init(base_mpz);
mpfr_init(f_N); mpfr_init(log_N); mpfr_init(log_log_N);
mpfr_set_z(f_N, N.get_mpz_t(), MPFR_RNDU); //f_N = N
mpfr_log(log_N, f_N, MPFR_RNDU); //log_N = log(N)
mpfr_log(log_log_N, log_N, MPFR_RNDU); //log_log_N = log(log(N))
mpfr_mul(f_N, log_N, log_log_N, MPFR_RNDU); //f_N = log(N) * log(log(N))
mpfr_sqrt(f_N, f_N, MPFR_RNDU); //f_N = sqrt(f_N)
mpfr_div_ui(f_N, f_N, 2, MPFR_RNDU); //f_N = f_N/2
mpfr_exp(f_N, f_N, MPFR_RNDU); //f_N = e^f_N
mpfr_get_z(base_mpz, f_N, MPFR_RNDU);
ret_base = mpz_class(base_mpz);
mpfr_clears(f_N, log_N, log_log_N, NULL);
}
void FixComplexKCM::emulate(TestCase * tc) {
/* first we are going to format the entries */
mpz_class reIn = tc->getInputValue("ReIN");
mpz_class imIn = tc->getInputValue("ImIN");
/* Sign handling */
// Msb index counting from one
bool reInNeg = (
signedInput &&
(mpz_tstbit(reIn.get_mpz_t(), input_width - 1) == 1)
);
bool imInNeg = (
signedInput &&
(mpz_tstbit(imIn.get_mpz_t(), input_width - 1) == 1)
);
// 2's complement -> absolute value unsigned representation
if(reInNeg)
{
reIn = (mpz_class(1) << input_width) - reIn;
}
if(imInNeg)
{
imIn = (mpz_class(1) << input_width) - imIn;
}
//Cast to mp floating point number
mpfr_t reIn_mpfr, imIn_mpfr;
mpfr_init2(reIn_mpfr, input_width + 1);
mpfr_init2(imIn_mpfr, input_width + 1);
//Exact
mpfr_set_z(reIn_mpfr, reIn.get_mpz_t(), GMP_RNDN);
mpfr_set_z(imIn_mpfr, imIn.get_mpz_t(), GMP_RNDN);
//Scaling : Exact
mpfr_mul_2si(reIn_mpfr, reIn_mpfr, lsb_in, GMP_RNDN);
mpfr_mul_2si(imIn_mpfr, imIn_mpfr, lsb_in, GMP_RNDN);
mpfr_t re_prod, im_prod, crexim_prod, xrecim_prod;
mpfr_t reOut, imOut;
mpfr_inits2(
2 * input_width + 1,
re_prod,
im_prod,
crexim_prod,
xrecim_prod,
NULL
);
mpfr_inits2(5 * max(outputim_width, outputre_width) + 1, reOut, imOut, NULL);
// c_r * x_r -> re_prod
mpfr_mul(re_prod, reIn_mpfr, mpfr_constant_re, GMP_RNDN);
// c_i * x_i -> im_prod
mpfr_mul(im_prod, imIn_mpfr, mpfr_constant_im, GMP_RNDN);
// c_r * x_i -> crexim_prod
mpfr_mul(crexim_prod, mpfr_constant_re, imIn_mpfr, GMP_RNDN);
// x_r * c_im -> xrecim_prod
mpfr_mul(xrecim_prod, reIn_mpfr, mpfr_constant_im, GMP_RNDN);
/* Input sign correction */
if(reInNeg)
{
//Exact
mpfr_neg(re_prod, re_prod, GMP_RNDN);
mpfr_neg(xrecim_prod, xrecim_prod, GMP_RNDN);
}
if(imInNeg)
{
//Exact
mpfr_neg(im_prod, im_prod, GMP_RNDN);
mpfr_neg(crexim_prod, crexim_prod, GMP_RNDN);
}
mpfr_sub(reOut, re_prod, im_prod, GMP_RNDN);
mpfr_add(imOut, crexim_prod, xrecim_prod, GMP_RNDN);
bool reOutNeg = (mpfr_sgn(reOut) < 0);
bool imOutNeg = (mpfr_sgn(imOut) < 0);
if(reOutNeg)
{
//Exact
mpfr_abs(reOut, reOut, GMP_RNDN);
}
if(imOutNeg)
{
//Exact
mpfr_abs(imOut, imOut, GMP_RNDN);
}
//Scale back (Exact)
mpfr_mul_2si(reOut, reOut, -lsb_out, GMP_RNDN);
mpfr_mul_2si(imOut, imOut, -lsb_out, GMP_RNDN);
//Get bits vector
mpz_class reUp, reDown, imUp, imDown, carry;
mpfr_get_z(reUp.get_mpz_t(), reOut, GMP_RNDU);
mpfr_get_z(reDown.get_mpz_t(), reOut, GMP_RNDD);
mpfr_get_z(imDown.get_mpz_t(), imOut, GMP_RNDD);
mpfr_get_z(imUp.get_mpz_t(), imOut, GMP_RNDU);
carry = 0;
//If result was negative, compute 2's complement
if(reOutNeg)
{
reUp = (mpz_class(1) << outputre_width) - reUp;
reDown = (mpz_class(1) << outputre_width) - reDown;
}
if(imOutNeg)
{
imUp = (mpz_class(1) << outputim_width) - imUp;
imDown = (mpz_class(1) << outputim_width) - imDown;
}
//Handle border cases
if(imUp > (mpz_class(1) << outputim_width) - 1 )
{
imUp = 0;
}
if(reUp > (mpz_class(1) << outputre_width) - 1)
{
reUp = 0;
}
if(imDown > (mpz_class(1) << outputim_width) - 1 )
{
imDown = 0;
}
if(reDown > (mpz_class(1) << outputre_width) - 1)
{
reDown = 0;
}
//Add expected results to corresponding outputs
tc->addExpectedOutput("ReOut", reUp);
tc->addExpectedOutput("ReOut", reDown);
tc->addExpectedOutput("ImOut", imUp);
tc->addExpectedOutput("ImOut", imDown);
mpfr_clears(
reOut,
imOut,
re_prod,
im_prod,
crexim_prod,
xrecim_prod,
reIn_mpfr,
imIn_mpfr,
NULL
);
}
/* The computation of z = pow(x,y) is done by
z = exp(y * log(x)) = x^y
For the special cases, see Section F.9.4.4 of the C standard:
_ pow(±0, y) = ±inf for y an odd integer < 0.
_ pow(±0, y) = +inf for y < 0 and not an odd integer.
_ pow(±0, y) = ±0 for y an odd integer > 0.
_ pow(±0, y) = +0 for y > 0 and not an odd integer.
_ pow(-1, ±inf) = 1.
_ pow(+1, y) = 1 for any y, even a NaN.
_ pow(x, ±0) = 1 for any x, even a NaN.
_ pow(x, y) = NaN for finite x < 0 and finite non-integer y.
_ pow(x, -inf) = +inf for |x| < 1.
_ pow(x, -inf) = +0 for |x| > 1.
_ pow(x, +inf) = +0 for |x| < 1.
_ pow(x, +inf) = +inf for |x| > 1.
_ pow(-inf, y) = -0 for y an odd integer < 0.
_ pow(-inf, y) = +0 for y < 0 and not an odd integer.
_ pow(-inf, y) = -inf for y an odd integer > 0.
_ pow(-inf, y) = +inf for y > 0 and not an odd integer.
_ pow(+inf, y) = +0 for y < 0.
_ pow(+inf, y) = +inf for y > 0. */
int
mpfr_pow (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode)
{
int inexact;
int cmp_x_1;
int y_is_integer;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg y[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (x), mpfr_log_prec, x,
mpfr_get_prec (y), mpfr_log_prec, y, rnd_mode),
("z[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (z), mpfr_log_prec, z, inexact));
if (MPFR_ARE_SINGULAR (x, y))
{
/* pow(x, 0) returns 1 for any x, even a NaN. */
if (MPFR_UNLIKELY (MPFR_IS_ZERO (y)))
return mpfr_set_ui (z, 1, rnd_mode);
else if (MPFR_IS_NAN (x))
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_NAN (y))
{
/* pow(+1, NaN) returns 1. */
if (mpfr_cmp_ui (x, 1) == 0)
return mpfr_set_ui (z, 1, rnd_mode);
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (y))
{
if (MPFR_IS_INF (x))
{
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int cmp;
cmp = mpfr_cmpabs (x, __gmpfr_one) * MPFR_INT_SIGN (y);
MPFR_SET_POS (z);
if (cmp > 0)
{
/* Return +inf. */
MPFR_SET_INF (z);
MPFR_RET (0);
}
else if (cmp < 0)
{
/* Return +0. */
MPFR_SET_ZERO (z);
MPFR_RET (0);
}
else
{
/* Return 1. */
return mpfr_set_ui (z, 1, rnd_mode);
}
}
}
else if (MPFR_IS_INF (x))
{
int negative;
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG (x) && is_odd (y);
if (MPFR_IS_POS (y))
MPFR_SET_INF (z);
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
else
{
int negative;
MPFR_ASSERTD (MPFR_IS_ZERO (x));
/* Determine the sign now, in case y and z are the same object */
negative = MPFR_IS_NEG(x) && is_odd (y);
if (MPFR_IS_NEG (y))
{
MPFR_ASSERTD (! MPFR_IS_INF (y));
MPFR_SET_INF (z);
mpfr_set_divby0 ();
}
else
MPFR_SET_ZERO (z);
if (negative)
MPFR_SET_NEG (z);
else
MPFR_SET_POS (z);
MPFR_RET (0);
}
}
/* x^y for x < 0 and y not an integer is not defined */
y_is_integer = mpfr_integer_p (y);
if (MPFR_IS_NEG (x) && ! y_is_integer)
{
MPFR_SET_NAN (z);
MPFR_RET_NAN;
}
/* now the result cannot be NaN:
(1) either x > 0
(2) or x < 0 and y is an integer */
cmp_x_1 = mpfr_cmpabs (x, __gmpfr_one);
if (cmp_x_1 == 0)
return mpfr_set_si (z, MPFR_IS_NEG (x) && is_odd (y) ? -1 : 1, rnd_mode);
/* now we have:
(1) either x > 0
(2) or x < 0 and y is an integer
and in addition |x| <> 1.
*/
/* detect overflow: an overflow is possible if
(a) |x| > 1 and y > 0
(b) |x| < 1 and y < 0.
FIXME: this assumes 1 is always representable.
FIXME2: maybe we can test overflow and underflow simultaneously.
The idea is the following: first compute an approximation to
y * log2|x|, using rounding to nearest. If |x| is not too near from 1,
this approximation should be accurate enough, and in most cases enable
one to prove that there is no underflow nor overflow.
Otherwise, it should enable one to check only underflow or overflow,
instead of both cases as in the present case.
*/
if (cmp_x_1 * MPFR_SIGN (y) > 0)
{
mpfr_t t;
int negative, overflow;
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (t, 53);
/* we want a lower bound on y*log2|x|:
(i) if x > 0, it suffices to round log2(x) toward zero, and
to round y*o(log2(x)) toward zero too;
(ii) if x < 0, we first compute t = o(-x), with rounding toward 1,
and then follow as in case (1). */
if (MPFR_SIGN (x) > 0)
mpfr_log2 (t, x, MPFR_RNDZ);
else
{
mpfr_neg (t, x, (cmp_x_1 > 0) ? MPFR_RNDZ : MPFR_RNDU);
mpfr_log2 (t, t, MPFR_RNDZ);
}
mpfr_mul (t, t, y, MPFR_RNDZ);
overflow = mpfr_cmp_si (t, __gmpfr_emax) > 0;
mpfr_clear (t);
MPFR_SAVE_EXPO_FREE (expo);
if (overflow)
{
MPFR_LOG_MSG (("early overflow detection\n", 0));
negative = MPFR_SIGN(x) < 0 && is_odd (y);
return mpfr_overflow (z, rnd_mode, negative ? -1 : 1);
}
}
/* Basic underflow checking. One has:
* - if y > 0, |x^y| < 2^(EXP(x) * y);
* - if y < 0, |x^y| <= 2^((EXP(x) - 1) * y);
* so that one can compute a value ebound such that |x^y| < 2^ebound.
* If we have ebound <= emin - 2 (emin - 1 in directed rounding modes),
* then there is an underflow and we can decide the return value.
*/
if (MPFR_IS_NEG (y) ? (MPFR_GET_EXP (x) > 1) : (MPFR_GET_EXP (x) < 0))
{
mpfr_t tmp;
mpfr_eexp_t ebound;
int inex2;
/* We must restore the flags. */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, sizeof (mpfr_exp_t) * CHAR_BIT);
inex2 = mpfr_set_exp_t (tmp, MPFR_GET_EXP (x), MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
if (MPFR_IS_NEG (y))
{
inex2 = mpfr_sub_ui (tmp, tmp, 1, MPFR_RNDN);
MPFR_ASSERTN (inex2 == 0);
}
mpfr_mul (tmp, tmp, y, MPFR_RNDU);
if (MPFR_IS_NEG (y))
mpfr_nextabove (tmp);
/* tmp doesn't necessarily fit in ebound, but that doesn't matter
since we get the minimum value in such a case. */
ebound = mpfr_get_exp_t (tmp, MPFR_RNDU);
mpfr_clear (tmp);
MPFR_SAVE_EXPO_FREE (expo);
if (MPFR_UNLIKELY (ebound <=
__gmpfr_emin - (rnd_mode == MPFR_RNDN ? 2 : 1)))
{
/* warning: mpfr_underflow rounds away from 0 for MPFR_RNDN */
MPFR_LOG_MSG (("early underflow detection\n", 0));
return mpfr_underflow (z,
rnd_mode == MPFR_RNDN ? MPFR_RNDZ : rnd_mode,
MPFR_SIGN (x) < 0 && is_odd (y) ? -1 : 1);
}
}
/* If y is an integer, we can use mpfr_pow_z (based on multiplications),
but if y is very large (I'm not sure about the best threshold -- VL),
we shouldn't use it, as it can be very slow and take a lot of memory
(and even crash or make other programs crash, as several hundred of
MBs may be necessary). Note that in such a case, either x = +/-2^b
(this case is handled below) or x^y cannot be represented exactly in
any precision supported by MPFR (the general case uses this property).
*/
if (y_is_integer && (MPFR_GET_EXP (y) <= 256))
{
mpz_t zi;
MPFR_LOG_MSG (("special code for y not too large integer\n", 0));
mpz_init (zi);
mpfr_get_z (zi, y, MPFR_RNDN);
inexact = mpfr_pow_z (z, x, zi, rnd_mode);
mpz_clear (zi);
return inexact;
}
/* Special case (+/-2^b)^Y which could be exact. If x is negative, then
necessarily y is a large integer. */
{
mpfr_exp_t b = MPFR_GET_EXP (x) - 1;
MPFR_ASSERTN (b >= LONG_MIN && b <= LONG_MAX); /* FIXME... */
if (mpfr_cmp_si_2exp (x, MPFR_SIGN(x), b) == 0)
{
mpfr_t tmp;
int sgnx = MPFR_SIGN (x);
MPFR_LOG_MSG (("special case (+/-2^b)^Y\n", 0));
/* now x = +/-2^b, so x^y = (+/-1)^y*2^(b*y) is exact whenever b*y is
an integer */
MPFR_SAVE_EXPO_MARK (expo);
mpfr_init2 (tmp, MPFR_PREC (y) + sizeof (long) * CHAR_BIT);
inexact = mpfr_mul_si (tmp, y, b, MPFR_RNDN); /* exact */
MPFR_ASSERTN (inexact == 0);
/* Note: as the exponent range has been extended, an overflow is not
possible (due to basic overflow and underflow checking above, as
the result is ~ 2^tmp), and an underflow is not possible either
because b is an integer (thus either 0 or >= 1). */
MPFR_CLEAR_FLAGS ();
inexact = mpfr_exp2 (z, tmp, rnd_mode);
mpfr_clear (tmp);
if (sgnx < 0 && is_odd (y))
{
mpfr_neg (z, z, rnd_mode);
inexact = -inexact;
}
/* Without the following, the overflows3 test in tpow.c fails. */
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* Case where |y * log(x)| is very small. Warning: x can be negative, in
that case y is a large integer. */
{
mpfr_t t;
mpfr_exp_t err;
/* We need an upper bound on the exponent of y * log(x). */
mpfr_init2 (t, 16);
if (MPFR_IS_POS(x))
mpfr_log (t, x, cmp_x_1 < 0 ? MPFR_RNDD : MPFR_RNDU); /* away from 0 */
else
{
/* if x < -1, round to +Inf, else round to zero */
mpfr_neg (t, x, (mpfr_cmp_si (x, -1) < 0) ? MPFR_RNDU : MPFR_RNDD);
mpfr_log (t, t, (mpfr_cmp_ui (t, 1) < 0) ? MPFR_RNDD : MPFR_RNDU);
}
MPFR_ASSERTN (MPFR_IS_PURE_FP (t));
err = MPFR_GET_EXP (y) + MPFR_GET_EXP (t);
mpfr_clear (t);
MPFR_CLEAR_FLAGS ();
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (z, __gmpfr_one, - err, 0,
(MPFR_SIGN (y) > 0) ^ (cmp_x_1 < 0),
rnd_mode, expo, {});
}
/* General case */
inexact = mpfr_pow_general (z, x, y, rnd_mode, y_is_integer, &expo);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (z, inexact, rnd_mode);
}
int
mpc_log10 (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int ok = 0, loops = 0, check_exact = 0, special_re, special_im,
inex, inex_re, inex_im;
mpfr_prec_t prec;
mpfr_t log10;
mpc_t log;
mpfr_init2 (log10, 2);
mpc_init2 (log, 2);
prec = MPC_MAX_PREC (rop);
/* compute log(op)/log(10) */
while (ok == 0) {
loops ++;
prec += (loops <= 2) ? mpc_ceil_log2 (prec) + 4 : prec / 2;
mpfr_set_prec (log10, prec);
mpc_set_prec (log, prec);
inex = mpc_log (log, op, rnd); /* error <= 1 ulp */
if (!mpfr_number_p (mpc_imagref (log))
|| mpfr_zero_p (mpc_imagref (log))) {
/* no need to divide by log(10) */
special_im = 1;
ok = 1;
}
else {
special_im = 0;
mpfr_const_log10 (log10);
mpfr_div (mpc_imagref (log), mpc_imagref (log), log10, MPFR_RNDN);
ok = mpfr_can_round (mpc_imagref (log), prec - 2,
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_IM(rop) + (MPC_RND_IM (rnd) == MPFR_RNDN));
}
if (ok) {
if (!mpfr_number_p (mpc_realref (log))
|| mpfr_zero_p (mpc_realref (log)))
special_re = 1;
else {
special_re = 0;
if (special_im)
/* log10 not yet computed */
mpfr_const_log10 (log10);
mpfr_div (mpc_realref (log), mpc_realref (log), log10, MPFR_RNDN);
/* error <= 24/7 ulp < 4 ulp for prec >= 4, see algorithms.tex */
ok = mpfr_can_round (mpc_realref (log), prec - 2,
MPFR_RNDN, MPFR_RNDZ,
MPC_PREC_RE(rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
}
/* Special code to deal with cases where the real part of log10(x+i*y)
is exact, like x=3 and y=1. Since Re(log10(x+i*y)) = log10(x^2+y^2)/2
this happens whenever x^2+y^2 is a nonnegative power of 10.
Indeed x^2+y^2 cannot equal 10^(a/2^b) for a, b integers, a odd, b>0,
since x^2+y^2 is rational, and 10^(a/2^b) is irrational.
Similarly, for b=0, x^2+y^2 cannot equal 10^a for a < 0 since x^2+y^2
is a rational with denominator a power of 2.
Now let x^2+y^2 = 10^s. Without loss of generality we can assume
x = u/2^e and y = v/2^e with u, v, e integers: u^2+v^2 = 10^s*2^(2e)
thus u^2+v^2 = 0 mod 2^(2e). By recurrence on e, necessarily
u = v = 0 mod 2^e, thus x and y are necessarily integers.
*/
if (!ok && !check_exact && mpfr_integer_p (mpc_realref (op)) &&
mpfr_integer_p (mpc_imagref (op))) {
mpz_t x, y;
unsigned long s, v;
check_exact = 1;
mpz_init (x);
mpz_init (y);
mpfr_get_z (x, mpc_realref (op), MPFR_RNDN); /* exact */
mpfr_get_z (y, mpc_imagref (op), MPFR_RNDN); /* exact */
mpz_mul (x, x, x);
mpz_mul (y, y, y);
mpz_add (x, x, y); /* x^2+y^2 */
v = mpz_scan1 (x, 0);
/* if x = 10^s then necessarily s = v */
s = mpz_sizeinbase (x, 10);
/* since s is either the number of digits of x or one more,
then x = 10^(s-1) or 10^(s-2) */
if (s == v + 1 || s == v + 2) {
mpz_div_2exp (x, x, v);
mpz_ui_pow_ui (y, 5, v);
if (mpz_cmp (y, x) == 0) {
/* Re(log10(x+i*y)) is exactly v/2
we reset the precision of Re(log) so that v can be
represented exactly */
mpfr_set_prec (mpc_realref (log),
sizeof(unsigned long)*CHAR_BIT);
mpfr_set_ui_2exp (mpc_realref (log), v, -1, MPFR_RNDN);
/* exact */
ok = 1;
}
}
mpz_clear (x);
mpz_clear (y);
}
}
}
inex_re = mpfr_set (mpc_realref(rop), mpc_realref (log), MPC_RND_RE (rnd));
if (special_re)
inex_re = MPC_INEX_RE (inex);
/* recover flag from call to mpc_log above */
inex_im = mpfr_set (mpc_imagref(rop), mpc_imagref (log), MPC_RND_IM (rnd));
if (special_im)
inex_im = MPC_INEX_IM (inex);
mpfr_clear (log10);
mpc_clear (log);
return MPC_INEX(inex_re, inex_im);
}
int main()
{
long iter;
flint_rand_t state;
printf("get_fmpz....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 100000; iter++)
{
long bits;
fmpr_t x;
mpfr_t y;
fmpz_t z, z2;
mpz_t w;
bits = 2 + n_randint(state, 1000);
fmpr_init(x);
mpfr_init2(y, bits);
fmpz_init(z);
fmpz_init(z2);
mpz_init(w);
fmpr_randtest(x, state, bits, 10);
fmpr_get_mpfr(y, x, MPFR_RNDN);
switch (n_randint(state, 5))
{
case 0:
fmpr_get_fmpz(z, x, FMPR_RND_FLOOR);
mpfr_get_z(w, y, MPFR_RNDD);
break;
case 1:
fmpr_get_fmpz(z, x, FMPR_RND_CEIL);
mpfr_get_z(w, y, MPFR_RNDU);
break;
case 2:
fmpr_get_fmpz(z, x, FMPR_RND_DOWN);
mpfr_get_z(w, y, MPFR_RNDZ);
break;
case 3:
fmpr_get_fmpz(z, x, FMPR_RND_UP);
mpfr_get_z(w, y, MPFR_RNDA);
break;
default:
fmpr_get_fmpz(z, x, FMPR_RND_NEAR);
mpfr_get_z(w, y, MPFR_RNDN);
break;
}
fmpz_set_mpz(z2, w);
if (!fmpz_equal(z, z2))
{
printf("FAIL\n\n");
printf("x = "); fmpr_print(x); printf("\n\n");
printf("z = "); fmpz_print(z); printf("\n\n");
printf("z2 = "); fmpz_print(z2); printf("\n\n");
abort();
}
fmpr_clear(x);
mpfr_clear(y);
fmpz_clear(z);
fmpz_clear(z2);
mpz_clear(w);
}
flint_randclear(state);
flint_cleanup();
printf("PASS\n");
return EXIT_SUCCESS;
}
// TODO : Refactor function so that memory allocation and deallocation
//calls are minimized.
double network_eff(double bfrac, int mu, int gamma, int d, int phi, double pin,double xi, double yi, double delta, int prec)
{
int psiz=1,i,dmax=d;
double pini=pin,pmax=pin, pinc=0.1,effout;
mpz_t mump;
mpz_init_set_ui(mump,(unsigned long int)mu);
mpz_t dmp;
mpz_init_set_ui(dmp,(unsigned long int)dmax);
mpz_t gamp;
mpz_init(gamp);
mpz_set_ui(gamp,gamma);
mpz_t ncodes;
mpz_init(ncodes);
mpfr_t ncodesfr;
mpfr_t nc_pow;
mpfr_init2(nc_pow,prec);
mpfr_init2(ncodesfr,prec);
mpfr_set_d(ncodesfr,2,MPFR_RNDN);
mpfr_set_d(nc_pow,bfrac*mu,MPFR_RNDN);
mpfr_pow(ncodesfr,ncodesfr,nc_pow,MPFR_RNDN);
mpfr_get_z(ncodes,ncodesfr,MPFR_RNDN);
int pdfsize=(mu+1)*psiz;
mpfr_t * ipdfptr;
mpfr_t * ucodesptr;
mpfr_t * p0ptr;
ipdfptr=(mpfr_t *) malloc(pdfsize*sizeof(mpfr_t));
ucodesptr=(mpfr_t *) malloc(pdfsize*sizeof(mpfr_t));
p0ptr=(mpfr_t *) malloc(pdfsize*sizeof(mpfr_t));
for(i=0;i<=pdfsize-1;i++)
{
mpfr_init2(*(ipdfptr+i),prec);
mpfr_set_d(*(ipdfptr+i),0,MPFR_RNDN);
mpfr_init2(*(ucodesptr+i),prec);
mpfr_init2(*(p0ptr+i),prec);
}
int rsize=(mu+1)*(gamma+1);
mpfr_t * distptr;
distptr=(mpfr_t *) malloc(rsize*sizeof(mpfr_t));
for(i=0;i<=rsize-1;i++)
{
mpfr_init2(*(distptr+i),prec);
}
mpfr_t *eff;
int esize=1;
eff=(mpfr_t *) malloc(esize*sizeof(mpfr_t));
for(i=0;i<=esize-1;i++)
{
mpfr_init2(*(eff+i),prec);
mpfr_set_d(*(eff+i),0,MPFR_RNDN);
}
//Binomial coeffs: (z,x) with z:0->gamma, x:0->gamma
mpfr_t * gamma_bcfr;
int gbf_size=(gamma+1)*(gamma+1);
gamma_bcfr=(mpfr_t *)malloc(gbf_size*sizeof(mpfr_t));
for(i=0;i<=gbf_size-1;i++)
mpfr_init2(*(gamma_bcfr+i),prec);
//Binomial coeffs: (y,x) with y:0->mu, x:0->d
int bacsize=(mu+1)*(dmax+1);
mpz_t beta_ai_cnt[bacsize];
for(i=0;i<=bacsize-1;i++)
mpz_init(beta_ai_cnt[i]);
//Binomial coeffs: (mu,x) with x:0->mu
mpfr_t mu_bcfr[mu+1];
for(i=0;i<=mu;i++)
mpfr_init2(mu_bcfr[i],prec);
//Binomial coeff: (mu,d) x:1->d (integer)
mpz_t mu_bc[dmax];
for(i=0;i<=dmax-1;i++)
mpz_init(mu_bc[i]);
int ppsize=(mu+1);//0.5*(dmax*(dmax+1)-(dini-1)*dini)*(mu+1);
mpfr_t * ppptr;
ppptr=(mpfr_t *) malloc(ppsize*sizeof(mpfr_t));
for(i=0;i<=ppsize-1;i++)
{
mpfr_init2(*(ppptr+i),prec);
mpfr_set_d(*(ppptr+i),0,MPFR_RNDN);
}
tabulate_bins_fr(gamma_bcfr,0,gamma,0,gamma,prec);
tabulate_bins_fr(mu_bcfr,mu,mu,0,mu,prec);
tabulate_bins_z(mu_bc,mu,mu,1,dmax);
tabulate_bins_z(beta_ai_cnt,0,mu,0,dmax);
inpdf(ipdfptr,mump,psiz,pini,pinc,mu,mu_bcfr,prec);
uniquecodes(ucodesptr,psiz,mump,mu,ncodes,ipdfptr,prec);
pphi(ppptr,mump,dmp,mu,d,phi,beta_ai_cnt,mu_bc,prec);
scjoint(distptr,mu,gamma,psiz,d,phi,(gamma_bcfr+gamma*(gamma+1)),ipdfptr,ppptr,prec);
for(i=0;i<=pdfsize-1;i++)
{
if(mpfr_cmp_si(*(ucodesptr+i),0)<=0)
mpfr_set_ui(*(p0ptr+i),0,MPFR_RNDN);
else
mpfr_ui_div(*(p0ptr+i),1,*(ucodesptr+i),MPFR_RNDN);
}
eff_point(eff,ipdfptr,distptr,ppptr,gamma_bcfr,p0ptr,d,phi,mu,gamma,pin,xi,yi,delta,prec);
effout=mpfr_get_d(*eff,MPFR_RNDN);
mpz_clear(mump);
mpz_clear(dmp);
mpz_clear(gamp);
mpz_clear(ncodes);
mpfr_clear(ncodesfr);
mpfr_clear(nc_pow);
for(i=0;i<=pdfsize-1;i++)
{
mpfr_clear(*(ipdfptr+i));
mpfr_clear(*(ucodesptr+i));
mpfr_clear(*(p0ptr+i));
}
free(ipdfptr);
free(ucodesptr);
free(p0ptr);
for(i=0;i<=rsize-1;i++)
mpfr_clear(*(distptr+i));
free(distptr);
for(i=0;i<=esize-1;i++)
mpfr_clear(*(eff+i));
free(eff);
for(i=0;i<=(gamma+1)*(gamma+1)-1;i++)
mpfr_clear(*(gamma_bcfr+i));
free(gamma_bcfr);
for(i=0;i<=bacsize-1;i++)
mpz_clear(beta_ai_cnt[i]);
for(i=0;i<=mu;i++)
mpfr_clear(mu_bcfr[i]);
for(i=0;i<=dmax-1;i++)
mpz_clear(mu_bc[i]);
for(i=0;i<=ppsize-1;i++)
mpfr_clear(*(ppptr+i));
free(ppptr);
return effout;
}
int my_mpfr_lbeta(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);
/* "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 = ln(finite / +-Inf) = ln(0) = -Inf :
mpfr_set_inf (R, -1);
mpfr_clear (s);
return ans;
}// else: sum is integer; at least one 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 ------------------
* ================
* --> see my_mpfr_beta() above */
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) {
//----------------- 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 = log(|1 / S|) = - log(|S|)
mpz_abs(S, S);
mpfr_set_z(s, S, RND); // <mpfr> s := |S|
mpfr_log(R, s, RND); // R := log(s) = log(|S|)
mpfr_neg(R, R, RND); // R = -R = -log(|S|)
mpz_clear(S);
}
else { // b is "large", use direct B(.,.) formula
// a := (-1)^b -- not needed here, neither 'neg': want log( |.| )
// s' := 1-s = 1-a-b
mpfr_ui_sub(s, 1, s, RND);
// R := log(|B(1-a-b, b)|) = log(|B(s', b)|)
my_mpfr_lbeta (R, s, b, RND);
}
mpfr_clear(s);
return ans;
}
}
ans = mpfr_lngamma(s, s, RND); // s = lngamma(a + b)
ans = mpfr_lngamma(a, a, RND);
ans = mpfr_lngamma(b, b, RND);
ans = mpfr_add (b, b, a, RND); // b' = lngamma(a) + lngamma(b)
ans = mpfr_sub (R, b, s, RND);
mpfr_clear (s);
return ans;
}
/*------------------------------------------------------------------------*/
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;
}
/* Compare the result (z1,inex1) of mpfr_pow with all flags cleared
with those of mpfr_pow with all flags set and of the other power
functions. Arguments x and y are the input values; sx and sy are
their string representations (sx may be null); rnd contains the
rounding mode; s is a string containing the function that called
test_others. */
static void
test_others (const void *sx, const char *sy, mpfr_rnd_t rnd,
mpfr_srcptr x, mpfr_srcptr y, mpfr_srcptr z1,
int inex1, unsigned int flags, const char *s)
{
mpfr_t z2;
int inex2;
int spx = sx != NULL;
if (!spx)
sx = x;
mpfr_init2 (z2, mpfr_get_prec (z1));
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_pow (z2, x, y, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_pow, flags set");
/* If y is an integer that fits in an unsigned long and is not -0,
we can test mpfr_pow_ui. */
if (MPFR_IS_POS (y) && mpfr_integer_p (y) &&
mpfr_fits_ulong_p (y, MPFR_RNDN))
{
unsigned long yy = mpfr_get_ui (y, MPFR_RNDN);
mpfr_clear_flags ();
inex2 = mpfr_pow_ui (z2, x, yy, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_pow_ui, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_pow_ui (z2, x, yy, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_pow_ui, flags set");
/* If x is an integer that fits in an unsigned long and is not -0,
we can also test mpfr_ui_pow_ui. */
if (MPFR_IS_POS (x) && mpfr_integer_p (x) &&
mpfr_fits_ulong_p (x, MPFR_RNDN))
{
unsigned long xx = mpfr_get_ui (x, MPFR_RNDN);
mpfr_clear_flags ();
inex2 = mpfr_ui_pow_ui (z2, xx, yy, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_ui_pow_ui, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_ui_pow_ui (z2, xx, yy, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_ui_pow_ui, flags set");
}
}
/* If y is an integer but not -0 and not huge, we can test mpfr_pow_z,
and possibly mpfr_pow_si (and possibly mpfr_ui_div). */
if (MPFR_IS_ZERO (y) ? MPFR_IS_POS (y) :
(mpfr_integer_p (y) && MPFR_GET_EXP (y) < 256))
{
mpz_t yyy;
/* If y fits in a long, we can test mpfr_pow_si. */
if (mpfr_fits_slong_p (y, MPFR_RNDN))
{
long yy = mpfr_get_si (y, MPFR_RNDN);
mpfr_clear_flags ();
inex2 = mpfr_pow_si (z2, x, yy, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_pow_si, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_pow_si (z2, x, yy, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_pow_si, flags set");
/* If y = -1, we can test mpfr_ui_div. */
if (yy == -1)
{
mpfr_clear_flags ();
inex2 = mpfr_ui_div (z2, 1, x, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_ui_div, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_ui_div (z2, 1, x, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_ui_div, flags set");
}
/* If y = 2, we can test mpfr_sqr. */
if (yy == 2)
{
mpfr_clear_flags ();
inex2 = mpfr_sqr (z2, x, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_sqr, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_sqr (z2, x, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_sqr, flags set");
}
}
/* Test mpfr_pow_z. */
mpz_init (yyy);
mpfr_get_z (yyy, y, MPFR_RNDN);
mpfr_clear_flags ();
inex2 = mpfr_pow_z (z2, x, yyy, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_pow_z, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_pow_z (z2, x, yyy, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_pow_z, flags set");
mpz_clear (yyy);
}
/* If y = 0.5, we can test mpfr_sqrt, except if x is -0 or -Inf (because
the rule for mpfr_pow on these special values is different). */
if (MPFR_IS_PURE_FP (y) && mpfr_cmp_str1 (y, "0.5") == 0 &&
! ((MPFR_IS_ZERO (x) || MPFR_IS_INF (x)) && MPFR_IS_NEG (x)))
{
mpfr_clear_flags ();
inex2 = mpfr_sqrt (z2, x, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_sqrt, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_sqrt (z2, x, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_sqrt, flags set");
}
#if MPFR_VERSION >= MPFR_VERSION_NUM(2,4,0)
/* If y = -0.5, we can test mpfr_rec_sqrt, except if x = -Inf
(because the rule for mpfr_pow on -Inf is different). */
if (MPFR_IS_PURE_FP (y) && mpfr_cmp_str1 (y, "-0.5") == 0 &&
! (MPFR_IS_INF (x) && MPFR_IS_NEG (x)))
{
mpfr_clear_flags ();
inex2 = mpfr_rec_sqrt (z2, x, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_rec_sqrt, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_rec_sqrt (z2, x, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_rec_sqrt, flags set");
}
#endif
/* If x is an integer that fits in an unsigned long and is not -0,
we can test mpfr_ui_pow. */
if (MPFR_IS_POS (x) && mpfr_integer_p (x) &&
mpfr_fits_ulong_p (x, MPFR_RNDN))
{
unsigned long xx = mpfr_get_ui (x, MPFR_RNDN);
mpfr_clear_flags ();
inex2 = mpfr_ui_pow (z2, xx, y, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_ui_pow, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_ui_pow (z2, xx, y, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_ui_pow, flags set");
/* If x = 2, we can test mpfr_exp2. */
if (xx == 2)
{
mpfr_clear_flags ();
inex2 = mpfr_exp2 (z2, y, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_exp2, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_exp2 (z2, y, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_exp2, flags set");
}
/* If x = 10, we can test mpfr_exp10. */
if (xx == 10)
{
mpfr_clear_flags ();
inex2 = mpfr_exp10 (z2, y, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, flags,
s, "mpfr_exp10, flags cleared");
__gmpfr_flags = MPFR_FLAGS_ALL;
inex2 = mpfr_exp10 (z2, y, rnd);
cmpres (spx, sx, sy, rnd, z1, inex1, z2, inex2, MPFR_FLAGS_ALL,
s, "mpfr_exp10, flags set");
}
}
mpfr_clear (z2);
}
static void
check_one (mpz_ptr z)
{
int inex, ex_inex, same;
int sh, neg;
mpfr_t f;
mpz_t got, ex;
mpfr_init2 (f, MAX (mpz_sizeinbase (z, 2), MPFR_PREC_MIN));
mpz_init (got);
mpz_init (ex);
for (sh = -2*GMP_NUMB_BITS ; sh < 2*GMP_NUMB_BITS ; sh++)
{
inex = mpfr_set_z (f, z, MPFR_RNDN); /* exact */
MPFR_ASSERTN (inex == 0);
if (sh < 0)
{
mpz_tdiv_q_2exp (ex, z, -sh);
inex = mpfr_div_2exp (f, f, -sh, MPFR_RNDN);
}
else
{
mpz_mul_2exp (ex, z, sh);
inex = mpfr_mul_2exp (f, f, sh, MPFR_RNDN);
}
MPFR_ASSERTN (inex == 0);
for (neg = 0; neg <= 1; neg++)
{
/* Test (-1)^neg * z * 2^sh */
int fi;
mpfr_flags_t flags[3] = { 0, MPFR_FLAGS_ALL ^ MPFR_FLAGS_ERANGE,
MPFR_FLAGS_ALL }, ex_flags, gt_flags;
for (fi = 0; fi < numberof (flags); fi++)
{
ex_inex = - mpfr_cmp_z (f, ex);
ex_flags = __gmpfr_flags = flags[fi];
if (ex_inex != 0)
ex_flags |= MPFR_FLAGS_INEXACT;
inex = mpfr_get_z (got, f, MPFR_RNDZ);
gt_flags = __gmpfr_flags;
same = SAME_SIGN (inex, ex_inex);
if (mpz_cmp (got, ex) != 0 || !same || gt_flags != ex_flags)
{
printf ("Error in check_one for sh=%d, fi=%d\n", sh, fi);
printf (" f = "); mpfr_dump (f);
printf ("expected "); mpz_dump (ex);
printf (" got "); mpz_dump (got);
printf ("Expected inex ~ %d, got %d (%s)\n",
inex, ex_inex, same ? "OK" : "wrong");
printf ("Flags:\n");
printf (" in"); flags_out (gt_flags);
printf ("expected"); flags_out (ex_flags);
printf (" got"); flags_out (gt_flags);
exit (1);
}
}
mpz_neg (ex, ex);
mpfr_neg (f, f, MPFR_RNDN);
}
}
mpfr_clear (f);
mpz_clear (got);
mpz_clear (ex);
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("get_fmpz....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arf_t x, x2;
fmpz_t z, z2, e;
int ret1, ret2;
arf_init(x);
arf_init(x2);
fmpz_init(z);
fmpz_init(z2);
fmpz_init(e);
arf_randtest(x, state, 2 + n_randint(state, 1000), 10);
fmpz_randtest(z, state, 1 + n_randint(state, 1000));
fmpz_randtest(z2, state, 1 + n_randint(state, 1000));
fmpz_randtest(e, state, 1 + n_randint(state, 200));
arf_mul_2exp_fmpz(x2, x, e);
ret1 = arf_get_fmpz(z, x, ARF_RND_DOWN);
ret2 = arf_get_fmpz_fixed_fmpz(z2, x2, e);
if (!fmpz_equal(z, z2) || (ret1 != ret2))
{
flint_printf("FAIL (fixed_fmpz)\n\n");
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("x2 = "); arf_print(x2); flint_printf("\n\n");
flint_printf("z = "); fmpz_print(z); flint_printf("\n\n");
flint_printf("z2 = "); fmpz_print(z2); flint_printf("\n\n");
flint_printf("ret1 = %d, ret2 = %d\n\n", ret1, ret2);
flint_abort();
}
arf_clear(x);
arf_clear(x2);
fmpz_clear(z);
fmpz_clear(z2);
fmpz_clear(e);
}
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
arf_t x, x2;
fmpz_t z, z2;
slong e;
int ret1, ret2;
arf_init(x);
arf_init(x2);
fmpz_init(z);
fmpz_init(z2);
arf_randtest(x, state, 2 + n_randint(state, 1000), 10);
fmpz_randtest(z, state, 1 + n_randint(state, 1000));
fmpz_randtest(z2, state, 1 + n_randint(state, 1000));
e = n_randtest(state);
arf_mul_2exp_si(x2, x, e);
ret1 = arf_get_fmpz(z, x, ARF_RND_DOWN);
ret2 = arf_get_fmpz_fixed_si(z2, x2, e);
if (!fmpz_equal(z, z2) || (ret1 != ret2))
{
flint_printf("FAIL (fixed_si)\n\n");
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("x2 = "); arf_print(x2); flint_printf("\n\n");
flint_printf("z = "); fmpz_print(z); flint_printf("\n\n");
flint_printf("z2 = "); fmpz_print(z2); flint_printf("\n\n");
flint_printf("ret1 = %d, ret2 = %d\n\n", ret1, ret2);
flint_abort();
}
arf_clear(x);
arf_clear(x2);
fmpz_clear(z);
fmpz_clear(z2);
}
for (iter = 0; iter < 1000000 * arb_test_multiplier(); iter++)
{
slong bits;
arf_t x;
mpfr_t y;
fmpz_t z, z2;
mpz_t w;
int ret1, ret2;
bits = 2 + n_randint(state, 1000);
arf_init(x);
mpfr_init2(y, bits);
fmpz_init(z);
fmpz_init(z2);
mpz_init(w);
arf_randtest(x, state, bits, 10);
fmpz_randtest(z, state, 1 + n_randint(state, 1000));
arf_get_mpfr(y, x, MPFR_RNDN);
switch (n_randint(state, 5))
{
case 0:
ret1 = arf_get_fmpz(z, x, ARF_RND_FLOOR);
ret2 = mpfr_get_z(w, y, MPFR_RNDD);
break;
case 1:
ret1 = arf_get_fmpz(z, x, ARF_RND_CEIL);
ret2 = mpfr_get_z(w, y, MPFR_RNDU);
break;
case 2:
ret1 = arf_get_fmpz(z, x, ARF_RND_DOWN);
ret2 = mpfr_get_z(w, y, MPFR_RNDZ);
break;
case 3:
ret1 = arf_get_fmpz(z, x, ARF_RND_UP);
ret2 = mpfr_get_z(w, y, MPFR_RNDA);
break;
default:
ret1 = arf_get_fmpz(z, x, ARF_RND_NEAR);
ret2 = mpfr_get_z(w, y, MPFR_RNDN);
break;
}
fmpz_set_mpz(z2, w);
if (!fmpz_equal(z, z2) || (ret1 != (ret2 != 0)))
{
flint_printf("FAIL\n\n");
flint_printf("x = "); arf_print(x); flint_printf("\n\n");
flint_printf("z = "); fmpz_print(z); flint_printf("\n\n");
flint_printf("z2 = "); fmpz_print(z2); flint_printf("\n\n");
flint_printf("ret1 = %d, ret2 = %d\n\n", ret1, ret2);
flint_abort();
}
arf_clear(x);
mpfr_clear(y);
fmpz_clear(z);
fmpz_clear(z2);
mpz_clear(w);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
CRFPConstMult::CRFPConstMult(Target* target, int wE_in, int wF_in, int wE_out, int wF_out, string _constant):
FPConstMult(target, wE_in, wF_in, wE_out, wF_out),
constant (_constant)
{
#if 0
sollya_obj_t node;
mpfr_t mpR;
mpz_t zz;
srcFileName="CRFPConstMult";
/* Convert the input string into a sollya evaluation tree */
node = sollya_lib_parse_string(constant.c_str());
/* If parse error throw an exception */
if (sollya_lib_obj_is_error(node))
{
ostringstream error;
error << srcFileName << ": Unable to parse string "<< constant << " as a numeric constant" <<endl;
throw error.str();
}
mpfr_inits(mpR, NULL);
sollya_lib_get_constant(mpR, node);
if(verbose){
double r;
r = mpfr_get_d(mpR, GMP_RNDN);
cout << " Constant evaluates to " <<r <<endl;
}
// compute the precision -- TODO with NWB
cst_width = 2*wF_in+4;
REPORT(0, "***** WARNING Taking constant with 2*wF_in+4 bits. Correct rounding is not yet guaranteed. This is being implemented." );
REPORT(INFO, "Required significand precision to reach correct rounding is " << cst_width );
mpfr_set_prec(mpfrC, cst_width);
sollya_lib_get_constant(mpR, node);
// Now convert mpR into exponent + integral significand
// sign
cst_sgn = mpfr_sgn(mpR);
if(cst_sgn<0)
mpfr_neg(mpR, mpR, GMP_RNDN);
// compute exponent and mantissa
cst_exp_when_mantissa_1_2 = mpfr_get_exp(mpR) - 1; //mpfr_get_exp() assumes significand in [1/2,1)
cst_exp_when_mantissa_int = cst_exp_when_mantissa_1_2 - cst_width + 1;
mpfr_init2(mpfr_cst_sig, cst_width);
mpfr_div_2si(mpfr_cst_sig, mpR, cst_exp_when_mantissa_1_2, GMP_RNDN);
REPORT(INFO, "mpfr_cst_sig = " << mpfr_get_d(mpfr_cst_sig, GMP_RNDN));
// Build the corresponding FPConstMult.
// initialize mpfr_xcut_sig = 2/cst_sig, will be between 1 and 2
mpfr_init2(mpfr_xcut_sig, 32*(cst_width+wE_in+wE_out)); // should be accurate enough
mpfr_set_d(mpfr_xcut_sig, 2.0, GMP_RNDN); // exaxt op
mpfr_div(mpfr_xcut_sig, mpfr_xcut_sig, mpfr_cst_sig, GMP_RNDD);
// now round it down to wF_in+1 bits
mpfr_t xcut_wF;
mpfr_init2(xcut_wF, wF_in+1);
mpfr_set(xcut_wF, mpfr_xcut_sig, GMP_RNDD);
mpfr_mul_2si(xcut_wF, xcut_wF, wF_in, GMP_RNDN);
// It should now be an int; cast it into a mpz, then a mpz_class
mpz_init2(zz, wF_in+1);
mpfr_get_z(zz, xcut_wF, GMP_RNDN);
xcut_sig_rd = mpz_class(zz);
mpz_clear(zz);
REPORT(DETAILED, "mpfr_xcut_sig = " << mpfr_get_d(mpfr_xcut_sig, GMP_RNDN) );
// Now build the mpz significand
mpfr_mul_2si(mpfr_cst_sig, mpfr_cst_sig, cst_width, GMP_RNDN);
// It should now be an int; cast it into a mpz, then a mpz_class
mpz_init2(zz, cst_width);
mpfr_get_z(zz, mpfr_cst_sig, GMP_RNDN);
cst_sig = mpz_class(zz);
mpz_clear(zz);
REPORT(DETAILED, "mpzclass cst_sig = " << cst_sig);
// build the name
ostringstream name;
name <<"FPConstMult_"<<(cst_sgn==0?"":"M") <<cst_sig<<"b"
<<(cst_exp_when_mantissa_int<0?"M":"")<<abs(cst_exp_when_mantissa_int)
<<"_"<<wE_in<<"_"<<wF_in<<"_"<<wE_out<<"_"<<wF_out;
uniqueName_=name.str();
// cleaning up
mpfr_clears(mpR, mpfr_xcut_sig, xcut_wF, mpfr_cst_sig, NULL);
icm = new IntConstMult(target, wF_in+1, cst_sig);
oplist.push_back(icm);
buildVHDL();
#endif
}
static void
special (void)
{
int inex;
mpfr_t x;
mpz_t z;
int i, fi;
int rnd;
mpfr_exp_t e;
mpfr_flags_t flags[3] = { 0, MPFR_FLAGS_ALL ^ MPFR_FLAGS_ERANGE,
MPFR_FLAGS_ALL }, ex_flags, gt_flags;
mpfr_init2 (x, 2);
mpz_init (z);
RND_LOOP (rnd)
for (i = -1; i <= 1; i++)
for (fi = 0; fi < numberof (flags); fi++)
{
ex_flags = flags[fi] | MPFR_FLAGS_ERANGE;
if (i != 0)
mpfr_set_nan (x);
else
mpfr_set_inf (x, i);
__gmpfr_flags = flags[fi];
inex = mpfr_get_z (z, x, (mpfr_rnd_t) rnd);
gt_flags = __gmpfr_flags;
if (gt_flags != ex_flags || inex != 0 || mpz_cmp_ui (z, 0) != 0)
{
printf ("special() failed on mpfr_get_z"
" for %s, i = %d, fi = %d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), i, fi);
printf ("Expected z = 0, inex = 0,");
flags_out (ex_flags);
printf ("Got z = ");
mpz_out_str (stdout, 10, z);
printf (", inex = %d,", inex);
flags_out (gt_flags);
exit (1);
}
__gmpfr_flags = flags[fi];
e = mpfr_get_z_2exp (z, x);
gt_flags = __gmpfr_flags;
if (gt_flags != ex_flags || e != __gmpfr_emin ||
mpz_cmp_ui (z, 0) != 0)
{
printf ("special() failed on mpfr_get_z_2exp"
" for %s, i = %d, fi = %d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) rnd), i, fi);
printf ("Expected z = 0, e = %" MPFR_EXP_FSPEC "d,",
(mpfr_eexp_t) __gmpfr_emin);
flags_out (ex_flags);
printf ("Got z = ");
mpz_out_str (stdout, 10, z);
printf (", e = %" MPFR_EXP_FSPEC "d,", (mpfr_eexp_t) e);
flags_out (gt_flags);
exit (1);
}
}
mpfr_clear (x);
mpz_clear (z);
}
/* return in z a lower bound (for rnd = RNDD) or upper bound (for rnd = RNDU)
of |zeta(s)|/2, using:
log(|zeta(s)|/2) = (s-1)*log(2*Pi) + lngamma(1-s)
+ log(|sin(Pi*s/2)| * zeta(1-s)).
Assumes s < 1/2 and s1 = 1-s exactly, thus s1 > 1/2.
y and p are temporary variables.
At input, p is Pi rounded down.
The comments in the code are for rnd = RNDD. */
static void
mpfr_reflection_overflow (mpfr_t z, mpfr_t s1, const mpfr_t s, mpfr_t y,
mpfr_t p, mpfr_rnd_t rnd)
{
mpz_t sint;
MPFR_ASSERTD (rnd == MPFR_RNDD || rnd == MPFR_RNDU);
/* Since log is increasing, we want lower bounds on |sin(Pi*s/2)| and
zeta(1-s). */
mpz_init (sint);
mpfr_get_z (sint, s, MPFR_RNDD); /* sint = floor(s) */
/* We first compute a lower bound of |sin(Pi*s/2)|, which is a periodic
function of period 2. Thus:
if 2k < s < 2k+1, then |sin(Pi*s/2)| is increasing;
if 2k-1 < s < 2k, then |sin(Pi*s/2)| is decreasing.
These cases are distinguished by testing bit 0 of floor(s) as if
represented in two's complement (or equivalently, as an unsigned
integer mod 2):
0: sint = 0 mod 2, thus 2k < s < 2k+1 and |sin(Pi*s/2)| is increasing;
1: sint = 1 mod 2, thus 2k-1 < s < 2k and |sin(Pi*s/2)| is decreasing.
Let's recall that the comments are for rnd = RNDD. */
if (mpz_tstbit (sint, 0) == 0) /* |sin(Pi*s/2)| is increasing: round down
Pi*s to get a lower bound. */
{
mpfr_mul (y, p, s, rnd);
if (rnd == MPFR_RNDD)
mpfr_nextabove (p); /* we will need p rounded above afterwards */
}
else /* |sin(Pi*s/2)| is decreasing: round up Pi*s to get a lower bound. */
{
if (rnd == MPFR_RNDD)
mpfr_nextabove (p);
mpfr_mul (y, p, s, MPFR_INVERT_RND(rnd));
}
mpfr_div_2ui (y, y, 1, MPFR_RNDN); /* exact, rounding mode doesn't matter */
/* The rounding direction of sin depends on its sign. We have:
if -4k-2 < s < -4k, then -2k-1 < s/2 < -2k, thus sin(Pi*s/2) < 0;
if -4k < s < -4k+2, then -2k < s/2 < -2k+1, thus sin(Pi*s/2) > 0.
These cases are distinguished by testing bit 1 of floor(s) as if
represented in two's complement (or equivalently, as an unsigned
integer mod 4):
0: sint = {0,1} mod 4, thus -2k < s/2 < -2k+1 and sin(Pi*s/2) > 0;
1: sint = {2,3} mod 4, thus -2k-1 < s/2 < -2k and sin(Pi*s/2) < 0.
Let's recall that the comments are for rnd = RNDD. */
if (mpz_tstbit (sint, 1) == 0) /* -2k < s/2 < -2k+1; sin(Pi*s/2) > 0 */
{
/* Round sin down to get a lower bound of |sin(Pi*s/2)|. */
mpfr_sin (y, y, rnd);
}
else /* -2k-1 < s/2 < -2k; sin(Pi*s/2) < 0 */
{
/* Round sin up to get a lower bound of |sin(Pi*s/2)|. */
mpfr_sin (y, y, MPFR_INVERT_RND(rnd));
mpfr_abs (y, y, MPFR_RNDN); /* exact, rounding mode doesn't matter */
}
mpz_clear (sint);
/* now y <= |sin(Pi*s/2)| when rnd=RNDD, y >= |sin(Pi*s/2)| when rnd=RNDU */
mpfr_zeta_pos (z, s1, rnd); /* zeta(1-s) */
mpfr_mul (z, z, y, rnd);
/* now z <= |sin(Pi*s/2)|*zeta(1-s) */
mpfr_log (z, z, rnd);
/* now z <= log(|sin(Pi*s/2)|*zeta(1-s)) */
mpfr_lngamma (y, s1, rnd);
mpfr_add (z, z, y, rnd);
/* z <= lngamma(1-s) + log(|sin(Pi*s/2)|*zeta(1-s)) */
/* since s-1 < 0, we want to round log(2*pi) upwards */
mpfr_mul_2ui (y, p, 1, MPFR_INVERT_RND(rnd));
mpfr_log (y, y, MPFR_INVERT_RND(rnd));
mpfr_mul (y, y, s1, MPFR_INVERT_RND(rnd));
mpfr_sub (z, z, y, rnd);
mpfr_exp (z, z, rnd);
if (rnd == MPFR_RNDD)
mpfr_nextbelow (p); /* restore original p */
}
