/* This bug occurs in mpfr_exp_2 on a Linux-64 machine, r5475. */
static void
bug20080731 (void)
{
mpfr_exp_t emin;
mpfr_t x, y1, y2;
mpfr_prec_t prec = 64;
emin = mpfr_get_emin ();
set_emin (MPFR_EMIN_MIN);
mpfr_init2 (x, 200);
mpfr_set_str (x, "-2.c5c85fdf473de6af278ece700fcbdabd03cd0cb9ca62d8b62c@7",
16, MPFR_RNDN);
mpfr_init2 (y1, prec);
mpfr_exp (y1, x, MPFR_RNDU);
/* Compute the result with a higher internal precision. */
mpfr_init2 (y2, 300);
mpfr_exp (y2, x, MPFR_RNDU);
mpfr_prec_round (y2, prec, MPFR_RNDU);
if (mpfr_cmp0 (y1, y2) != 0)
{
printf ("Error in bug20080731\nExpected ");
mpfr_out_str (stdout, 16, 0, y2, MPFR_RNDN);
printf ("\nGot ");
mpfr_out_str (stdout, 16, 0, y1, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_clears (x, y1, y2, (mpfr_ptr) 0);
set_emin (emin);
}
decimal r_exp(const decimal& a,bool round)
{
#ifdef USE_CGAL
CGAL::Gmpfr m;
CGAL::Gmpfr n=to_gmpfr(a);
mpfr_exp(m.fr(),n.fr(),MPFR_RNDN);
return r_round_preference(decimal(m),round);
#else
return r_round_preference(exp(a),round);
#endif
}
void bvisit(const Pow &x) {
if (eq(*x.get_base(), *E)) {
apply(result_, *(x.get_exp()));
mpfr_exp(result_, result_, rnd_);
} else {
mpfr_class b(mpfr_get_prec(result_));
apply(b.get_mpfr_t(), *(x.get_base()));
apply(result_, *(x.get_exp()));
mpfr_pow(result_, b.get_mpfr_t(), result_, rnd_);
}
}
static int synge_euler(synge_t num, mpfr_rnd_t round) {
/* get one */
synge_t one;
mpfr_init2(one, SYNGE_PRECISION);
mpfr_set_si(one, 1, round);
/* e^1 */
mpfr_exp(num, one, round);
mpfr_clears(one, NULL);
return 0;
} /* synge_euler() */
int
main (int argc, char *argv[])
{
unsigned long N = atoi (argv[1]), M;
mp_prec_t p;
mpfr_t i, j;
char *lo;
mp_exp_t exp_lo;
int st, st0;
fprintf (stderr, "Using GMP %s and MPFR %s\n", gmp_version, mpfr_version);
st = cputime ();
mpfr_init (i);
mpfr_init (j);
M = N;
do
{
M += 10;
mpfr_set_prec (i, 32);
mpfr_set_d (i, LOG2_10, GMP_RNDU);
mpfr_mul_ui (i, i, M, GMP_RNDU);
mpfr_add_ui (i, i, 3, GMP_RNDU);
p = mpfr_get_ui (i, GMP_RNDU);
fprintf (stderr, "Setting precision to %lu\n", p);
mpfr_set_prec (j, 2);
mpfr_set_prec (i, p);
mpfr_set_ui (j, 1, GMP_RNDN);
mpfr_exp (i, j, GMP_RNDN); /* i = exp(1) */
mpfr_set_prec (j, p);
mpfr_const_pi (j, GMP_RNDN);
mpfr_div (i, i, j, GMP_RNDN);
mpfr_sqrt (i, i, GMP_RNDN);
st0 = cputime ();
lo = mpfr_get_str (NULL, &exp_lo, 10, M, i, GMP_RNDN);
st0 = cputime () - st0;
}
while (can_round (lo, N, M) == 0);
lo[N] = '\0';
printf ("%s\n", lo);
mpfr_clear (i);
mpfr_clear (j);
fprintf (stderr, "Cputime: %dms (output %dms)\n", cputime () - st, st0);
return 0;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("const_e....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 250 * arb_test_multiplier(); iter++)
{
arb_t r;
mpfr_t s;
slong accuracy, prec;
prec = 2 + n_randint(state, 1 << n_randint(state, 16));
arb_init(r);
mpfr_init2(s, prec + 1000);
arb_const_e(r, prec);
mpfr_set_ui(s, 1, MPFR_RNDN);
mpfr_exp(s, s, MPFR_RNDN);
if (!arb_contains_mpfr(r, s))
{
flint_printf("FAIL: containment\n\n");
flint_printf("prec = %wd\n", prec);
flint_printf("r = "); arb_printd(r, prec / 3.33); flint_printf("\n\n");
flint_abort();
}
accuracy = arb_rel_accuracy_bits(r);
if (accuracy < prec - 4)
{
flint_printf("FAIL: poor accuracy\n\n");
flint_printf("prec = %wd\n", prec);
flint_printf("r = "); arb_printd(r, prec / 3.33); flint_printf("\n\n");
flint_abort();
}
arb_clear(r);
mpfr_clear(s);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
num_t
num_new_const_e(int flags)
{
mpfr_t one;
num_t r;
r = num_new_fp(flags, NULL);
mpfr_init_set_si(one, 1, round_mode);
mpfr_exp(F(r), one, round_mode);
mpfr_clear(one);
return r;
}
/* expx is the value of exp(X) rounded towards -infinity */
static void
check_worst_case (const char *Xs, const char *expxs)
{
mpfr_t x, y;
mpfr_inits2(53, x, y, NULL);
mpfr_set_str1(x, Xs);
mpfr_exp(y, x, GMP_RNDD);
if (mpfr_cmp_str1 (y, expxs))
{
printf ("exp(x) rounded towards -infinity is wrong\n");
exit(1);
}
mpfr_set_str1(x, Xs);
mpfr_exp(x, x, GMP_RNDU);
mpfr_add_one_ulp(y, GMP_RNDN);
if (mpfr_cmp(x,y))
{
printf ("exp(x) rounded towards +infinity is wrong\n");
exit(1);
}
mpfr_clears(x,y,NULL);
}
/* check sign of inexact flag */
static void
check_inexact (void)
{
mpfr_t x, y;
int inexact;
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
mpfr_set_str_binary (x,
"1.0000000000001001000110100100101000001101101011100101e2");
inexact = mpfr_exp (y, x, GMP_RNDN);
if (inexact <= 0)
{
printf ("Wrong inexact flag\n");
exit (1);
}
/* Bug due to wrong approximation of (x)/log2 */
mpfr_set_prec (x, 163);
mpfr_set_str (x, "-4.28ac8fceeadcda06bb56359017b1c81b85b392e7", 16,
GMP_RNDN);
mpfr_exp (x, x, GMP_RNDN);
if (mpfr_cmp_str (x, "3.fffffffffffffffffffffffffffffffffffffffe8@-2",
16, GMP_RNDN))
{
printf ("Error for x= -4.28ac8fceeadcda06bb56359017b1c81b85b392e7");
printf ("expected 3.fffffffffffffffffffffffffffffffffffffffe8@-2");
printf ("Got ");
mpfr_out_str (stdout, 16, 0, x, GMP_RNDN); putchar ('\n');
}
mpfr_clear (x);
mpfr_clear (y);
}
/* computes R(n) = exp(-n)/n * sum(k!/(-n)^k, k=0..n-2)
with error at most 4*ulp(x). Assumes n>=2.
Since x <= exp(-n)/n <= 1/8, then 4*ulp(x) <= ulp(1).
*/
static void
mpfr_const_euler_R (mpfr_t x, unsigned long n)
{
unsigned long k, m;
mpz_t a, s;
mpfr_t y;
MPFR_ASSERTN (n >= 2); /* ensures sum(k!/(-n)^k, k=0..n-2) >= 2/3 */
/* as we multiply the sum by exp(-n), we need only PREC(x) - n/LOG2 bits */
m = MPFR_PREC(x) - (unsigned long) ((double) n / LOG2);
mpz_init_set_ui (a, 1);
mpz_mul_2exp (a, a, m);
mpz_init_set (s, a);
for (k = 1; k <= n; k++)
{
mpz_mul_ui (a, a, k);
mpz_fdiv_q_ui (a, a, n);
/* the error e(k) on a is e(k) <= 1 + k/n*e(k-1) with e(0)=0,
i.e. e(k) <= k */
if (k % 2)
mpz_sub (s, s, a);
else
mpz_add (s, s, a);
}
/* the error on s is at most 1+2+...+n = n*(n+1)/2 */
mpz_fdiv_q_ui (s, s, n); /* err <= 1 + (n+1)/2 */
MPFR_ASSERTN (MPFR_PREC(x) >= mpz_sizeinbase(s, 2));
mpfr_set_z (x, s, MPFR_RNDD); /* exact */
mpfr_div_2ui (x, x, m, MPFR_RNDD);
/* now x = 1/n * sum(k!/(-n)^k, k=0..n-2) <= 1/n */
/* err(x) <= (n+1)/2^m <= (n+1)*exp(n)/2^PREC(x) */
mpfr_init2 (y, m);
mpfr_set_si (y, -(long)n, MPFR_RNDD); /* assumed exact */
mpfr_exp (y, y, MPFR_RNDD); /* err <= ulp(y) <= exp(-n)*2^(1-m) */
mpfr_mul (x, x, y, MPFR_RNDD);
/* err <= ulp(x) + (n + 1 + 2/n) / 2^prec(x)
<= ulp(x) + (n + 1 + 2/n) ulp(x)/x since x*2^(-prec(x)) < ulp(x)
<= ulp(x) + (n + 1 + 2/n) 3/(2n) ulp(x) since x >= 2/3*n for n >= 2
<= 4 * ulp(x) for n >= 2 */
mpfr_clear (y);
mpz_clear (a);
mpz_clear (s);
}
//-----------------------------------------------------------
// 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);
}
static int
test_exp (mpfr_ptr a, mpfr_srcptr b, mpfr_rnd_t rnd_mode)
{
int res;
int ok = rnd_mode == MPFR_RNDN && mpfr_number_p (b) && mpfr_get_prec (a)>=53;
if (ok)
{
mpfr_print_raw (b);
}
res = mpfr_exp (a, b, rnd_mode);
if (ok)
{
printf (" ");
mpfr_print_raw (a);
printf ("\n");
}
return res;
}
//------------------------------------------------------------------------------
// Name:
//------------------------------------------------------------------------------
knumber_base *knumber_float::exp() {
#ifdef KNUMBER_USE_MPFR
mpfr_t mpfr;
mpfr_init_set_f(mpfr, mpf_, rounding_mode);
mpfr_exp(mpfr, mpfr, rounding_mode);
mpfr_get_f(mpf_, mpfr, rounding_mode);
mpfr_clear(mpfr);
return this;
#else
const double x = mpf_get_d(mpf_);
if(isinf(x)) {
delete this;
return new knumber_error(knumber_error::ERROR_POS_INFINITY);
} else {
return execute_libc_func< ::exp>(x);
}
#endif
}
/* Return in y an approximation of Ei(x) using the asymptotic expansion:
Ei(x) = exp(x)/x * (1 + 1/x + 2/x^2 + ... + k!/x^k + ...)
Assumes x >= PREC(y) * log(2).
Returns the error bound in terms of ulp(y).
*/
static mp_exp_t
mpfr_eint_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mp_prec_t p = MPFR_PREC(y);
mpfr_t invx, t, err;
unsigned long k;
mp_exp_t err_exp;
mpfr_init2 (t, p);
mpfr_init2 (invx, p);
mpfr_init2 (err, 31); /* error in ulps on y */
mpfr_ui_div (invx, 1, x, GMP_RNDN); /* invx = 1/x*(1+u) with |u|<=2^(1-p) */
mpfr_set_ui (t, 1, GMP_RNDN); /* exact */
mpfr_set (y, t, GMP_RNDN);
mpfr_set_ui (err, 0, GMP_RNDN);
for (k = 1; MPFR_GET_EXP(t) + (mp_exp_t) p > MPFR_GET_EXP(y); k++)
{
mpfr_mul (t, t, invx, GMP_RNDN); /* 2 more roundings */
mpfr_mul_ui (t, t, k, GMP_RNDN); /* 1 more rounding: t = k!/x^k*(1+u)^e
with u=2^{-p} and |e| <= 3*k */
/* we use the fact that |(1+u)^n-1| <= 2*|n*u| for |n*u| <= 1, thus
the error on t is less than 6*k*2^{-p}*t <= 6*k*ulp(t) */
/* err is in terms of ulp(y): transform it in terms of ulp(t) */
mpfr_mul_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add_ui (err, err, 6 * k, GMP_RNDU);
/* transform back in terms of ulp(y) */
mpfr_div_2si (err, err, MPFR_GET_EXP(y) - MPFR_GET_EXP(t), GMP_RNDU);
mpfr_add (y, y, t, GMP_RNDN);
}
/* add the truncation error bounded by ulp(y): 1 ulp */
mpfr_mul (y, y, invx, GMP_RNDN); /* err <= 2*err + 3/2 */
mpfr_exp (t, x, GMP_RNDN); /* err(t) <= 1/2*ulp(t) */
mpfr_mul (y, y, t, GMP_RNDN); /* again: err <= 2*err + 3/2 */
mpfr_mul_2ui (err, err, 2, GMP_RNDU);
mpfr_add_ui (err, err, 8, GMP_RNDU);
err_exp = MPFR_GET_EXP(err);
mpfr_clear (t);
mpfr_clear (invx);
mpfr_clear (err);
return err_exp;
}
/* returns the number of ulp of error */
static void
check3 (const char *op, mp_rnd_t rnd, const char *res)
{
mpfr_t x, y;
mpfr_inits2 (53, x, y, NULL);
/* y negative. If we forget to set the sign in mpfr_exp, we'll see it. */
mpfr_set_si (y, -1, GMP_RNDN);
mpfr_set_str1 (x, op);
mpfr_exp (y, x, rnd);
if (mpfr_cmp_str1 (y, res) )
{
printf ("mpfr_exp failed for x=%s, rnd=%s\n",
op, mpfr_print_rnd_mode (rnd));
printf ("expected result is %s, got ", res);
mpfr_out_str (stdout, 10, 0, y, GMP_RNDN);
putchar('\n');
exit (1);
}
mpfr_clears (x, y, NULL);
}
REAL _exp(REAL a, REAL, QByteArray &)
{
mpfr_t tmp1; mpfr_init2(tmp1, NUMBITS);
mpfr_t result; mpfr_init2(result, NUMBITS);
try
{
// mpfr_init_set_f(tmp1, a.get_mpf_t(), MPFR_RNDN);
mpfr_set_str(tmp1, getString(a).data(), 10, MPFR_RNDN);
mpfr_exp(result, tmp1, MPFR_RNDN);
mpfr_get_f(a.get_mpf_t(), result, MPFR_RNDN);
}
catch(...)
{
mpfr_clear(tmp1);
mpfr_clear(result);
return ZERO;
}
mpfr_clear(tmp1);
mpfr_clear(result);
return a;
}
void
arb_exp_arf_via_mpfr(arb_t z, const arf_t x, slong prec)
{
mpfr_t t, u;
int exact;
mpfr_init2(t, 2 + arf_bits(x));
mpfr_init2(u, prec);
mpfr_set_emin(MPFR_EMIN_MIN);
mpfr_set_emax(MPFR_EMAX_MAX);
arf_get_mpfr(t, x, MPFR_RNDD);
exact = (mpfr_exp(u, t, MPFR_RNDD) == 0);
arf_set_mpfr(arb_midref(z), u);
if (!exact)
arf_mag_set_ulp(arb_radref(z), arb_midref(z), prec);
mpfr_clear(t);
mpfr_clear(u);
}
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);
}
int
mpfr_exp2 (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
int inexact;
long xint;
mpfr_t xfrac;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec(x), mpfr_log_prec, x, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec(y), mpfr_log_prec, y,
inexact));
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))
{
if (MPFR_IS_POS (x))
MPFR_SET_INF (y);
else
MPFR_SET_ZERO (y);
MPFR_SET_POS (y);
MPFR_RET (0);
}
else /* 2^0 = 1 */
{
MPFR_ASSERTD (MPFR_IS_ZERO(x));
return mpfr_set_ui (y, 1, rnd_mode);
}
}
/* since the smallest representable non-zero float is 1/2*2^__gmpfr_emin,
if x < __gmpfr_emin - 1, the result is either 1/2*2^__gmpfr_emin or 0 */
MPFR_ASSERTN (MPFR_EMIN_MIN >= LONG_MIN + 2);
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emin - 1) < 0))
{
mpfr_rnd_t rnd2 = rnd_mode;
/* in round to nearest mode, round to zero when x <= __gmpfr_emin-2 */
if (rnd_mode == MPFR_RNDN &&
mpfr_cmp_si_2exp (x, __gmpfr_emin - 2, 0) <= 0)
rnd2 = MPFR_RNDZ;
return mpfr_underflow (y, rnd2, 1);
}
MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX);
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax) >= 0))
return mpfr_overflow (y, rnd_mode, 1);
/* We now know that emin - 1 <= x < emax. */
MPFR_SAVE_EXPO_MARK (expo);
/* 2^x = 1 + x*log(2) + O(x^2) for x near zero, and for |x| <= 1 we have
|2^x - 1| <= x < 2^EXP(x). If x > 0 we must round away from 0 (dir=1);
if x < 0 we must round toward 0 (dir=0). */
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, - MPFR_GET_EXP (x), 0,
MPFR_IS_POS (x), rnd_mode, expo, {});
xint = mpfr_get_si (x, MPFR_RNDZ);
mpfr_init2 (xfrac, MPFR_PREC (x));
mpfr_sub_si (xfrac, x, xint, MPFR_RNDN); /* exact */
if (MPFR_IS_ZERO (xfrac))
{
mpfr_set_ui (y, 1, MPFR_RNDN);
inexact = 0;
}
else
{
/* Declaration of the intermediary variable */
mpfr_t t;
/* Declaration of the size variable */
mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */
mpfr_prec_t Nt; /* working precision */
mpfr_exp_t err; /* error */
MPFR_ZIV_DECL (loop);
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Ny + 5 + MPFR_INT_CEIL_LOG2 (Ny);
/* initialize of intermediary variable */
mpfr_init2 (t, Nt);
/* First computation */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute exp(x*ln(2))*/
mpfr_const_log2 (t, MPFR_RNDU); /* ln(2) */
mpfr_mul (t, xfrac, t, MPFR_RNDU); /* xfrac * ln(2) */
err = Nt - (MPFR_GET_EXP (t) + 2); /* Estimate of the error */
mpfr_exp (t, t, MPFR_RNDN); /* exp(xfrac * ln(2)) */
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
break;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, t, rnd_mode);
mpfr_clear (t);
}
mpfr_clear (xfrac);
MPFR_CLEAR_FLAGS ();
mpfr_mul_2si (y, y, xint, MPFR_RNDN); /* exact or overflow */
/* Note: We can have an overflow only when t was rounded up to 2. */
MPFR_ASSERTD (MPFR_IS_PURE_FP (y) || inexact > 0);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, __gmpfr_flags);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
int main()
{
long iter;
flint_rand_t state;
printf("exp....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 100000; iter++)
{
fmprb_t a, b;
fmpq_t q;
mpfr_t t;
long prec = 2 + n_randint(state, 200);
fmprb_init(a);
fmprb_init(b);
fmpq_init(q);
mpfr_init2(t, prec + 100);
fmprb_randtest(a, state, 1 + n_randint(state, 200), 3);
fmprb_randtest(b, state, 1 + n_randint(state, 200), 3);
fmprb_get_rand_fmpq(q, state, a, 1 + n_randint(state, 200));
fmpq_get_mpfr(t, q, MPFR_RNDN);
mpfr_exp(t, t, MPFR_RNDN);
fmprb_exp(b, a, prec);
if (!fmprb_contains_mpfr(b, t))
{
printf("FAIL: containment\n\n");
printf("a = "); fmprb_print(a); printf("\n\n");
printf("b = "); fmprb_print(b); printf("\n\n");
abort();
}
fmprb_exp(a, a, prec);
if (!fmprb_equal(a, b))
{
printf("FAIL: aliasing\n\n");
abort();
}
fmprb_clear(a);
fmprb_clear(b);
fmpq_clear(q);
mpfr_clear(t);
}
/* check large arguments */
for (iter = 0; iter < 100000; iter++)
{
fmprb_t a, b, c, d;
long prec1, prec2;
prec1 = 2 + n_randint(state, 1000);
prec2 = prec1 + 30;
fmprb_init(a);
fmprb_init(b);
fmprb_init(c);
fmprb_init(d);
fmprb_randtest_precise(a, state, 1 + n_randint(state, 1000), 100);
fmprb_exp(b, a, prec1);
fmprb_exp(c, a, prec2);
if (!fmprb_overlaps(b, c))
{
printf("FAIL: overlap\n\n");
printf("a = "); fmprb_print(a); printf("\n\n");
printf("b = "); fmprb_print(b); printf("\n\n");
printf("c = "); fmprb_print(c); printf("\n\n");
abort();
}
fmprb_randtest_precise(b, state, 1 + n_randint(state, 1000), 100);
/* check exp(a)*exp(b) = exp(a+b) */
fmprb_exp(c, a, prec1);
fmprb_exp(d, b, prec1);
fmprb_mul(c, c, d, prec1);
fmprb_add(d, a, b, prec1);
fmprb_exp(d, d, prec1);
if (!fmprb_overlaps(c, d))
{
printf("FAIL: functional equation\n\n");
printf("a = "); fmprb_print(a); printf("\n\n");
printf("b = "); fmprb_print(b); printf("\n\n");
printf("c = "); fmprb_print(c); printf("\n\n");
printf("d = "); fmprb_print(d); printf("\n\n");
abort();
}
fmprb_clear(a);
fmprb_clear(b);
fmprb_clear(c);
fmprb_clear(d);
}
flint_randclear(state);
flint_cleanup();
printf("PASS\n");
return EXIT_SUCCESS;
}
int
main (int argc, char *argv[])
{
int n, prec, st, st2, N, i;
mpfr_t x, y, z;
if (argc != 2 && argc != 3)
{
fprintf(stderr, "Usage: timing digits \n");
exit(1);
}
printf ("Using MPFR-%s with GMP-%s\n", mpfr_version, gmp_version);
n = atoi(argv[1]);
prec = (int) ( n * log(10.0) / log(2.0) + 1.0 );
printf("[precision is %u bits]\n", prec);
mpfr_init2(x, prec); mpfr_init2(y, prec); mpfr_init2(z, prec);
mpfr_set_d(x, 3.0, GMP_RNDN); mpfr_sqrt(x, x, GMP_RNDN); mpfr_sub_ui (x, x, 1, GMP_RNDN);
mpfr_set_d(y, 5.0, GMP_RNDN); mpfr_sqrt(y, y, GMP_RNDN);
mpfr_log (z, x, GMP_RNDN);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_mul(z, x, y, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("x*y took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_mul(z, x, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("x*x took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_div(z, x, y, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("x/y took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_sqrt(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("sqrt(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_exp(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("exp(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_log(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("log(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_sin(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("sin(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_cos(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("cos(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_acos(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("arccos(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
N=1; st = cputime();
do {
for (i=0;i<N;i++) mpfr_atan(z, x, GMP_RNDN);
N=2*N;
st2=cputime();
} while (st2-st<1000);
printf("arctan(x) took %f ms (%d eval in %d ms)\n",
(double)(st2-st)/(N-1),N-1,st2-st);
mpfr_clear(x); mpfr_clear(y); mpfr_clear(z);
return 0;
}
int main()
{
slong i;
mpfr_t tabx, expx, y1, y2;
mpz_t tt;
flint_printf("exp_tab....");
fflush(stdout);
{
slong prec, bits, num;
prec = ARB_EXP_TAB1_LIMBS * FLINT_BITS;
bits = ARB_EXP_TAB1_BITS;
num = ARB_EXP_TAB1_NUM;
mpfr_init2(tabx, prec);
mpfr_init2(expx, prec);
mpfr_init2(y1, prec);
mpfr_init2(y2, prec);
for (i = 0; i < num; i++)
{
tt->_mp_d = (mp_ptr) arb_exp_tab1[i];
tt->_mp_size = prec / FLINT_BITS;
tt->_mp_alloc = tt->_mp_size;
while (tt->_mp_size > 0 && tt->_mp_d[tt->_mp_size-1] == 0)
tt->_mp_size--;
mpfr_set_z(tabx, tt, MPFR_RNDD);
mpfr_div_2ui(tabx, tabx, prec, MPFR_RNDD);
mpfr_set_ui(expx, i, MPFR_RNDD);
mpfr_div_2ui(expx, expx, bits, MPFR_RNDD);
mpfr_exp(expx, expx, MPFR_RNDD);
mpfr_mul_2ui(y1, tabx, prec, MPFR_RNDD);
mpfr_floor(y1, y1);
mpfr_div_2ui(y1, y1, prec, MPFR_RNDD);
mpfr_mul_2ui(y2, expx, prec - 1, MPFR_RNDD);
mpfr_floor(y2, y2);
mpfr_div_2ui(y2, y2, prec, MPFR_RNDD);
if (!mpfr_equal_p(y1, y2))
{
flint_printf("FAIL: i = %wd, bits = %wd, prec = %wd\n", i, bits, prec);
mpfr_printf("y1 = %.1500Rg\n", y1);
mpfr_printf("y2 = %.1500Rg\n", y2);
abort();
}
}
mpfr_clear(tabx);
mpfr_clear(expx);
mpfr_clear(y1);
mpfr_clear(y2);
}
{
slong prec, bits, num;
prec = ARB_EXP_TAB2_LIMBS * FLINT_BITS;
bits = ARB_EXP_TAB21_BITS;
num = ARB_EXP_TAB21_NUM;
mpfr_init2(tabx, prec);
mpfr_init2(expx, prec);
mpfr_init2(y1, prec);
mpfr_init2(y2, prec);
for (i = 0; i < num; i++)
{
tt->_mp_d = (mp_ptr) arb_exp_tab21[i];
tt->_mp_size = prec / FLINT_BITS;
tt->_mp_alloc = tt->_mp_size;
while (tt->_mp_size > 0 && tt->_mp_d[tt->_mp_size-1] == 0)
tt->_mp_size--;
mpfr_set_z(tabx, tt, MPFR_RNDD);
mpfr_div_2ui(tabx, tabx, prec, MPFR_RNDD);
mpfr_set_ui(expx, i, MPFR_RNDD);
mpfr_div_2ui(expx, expx, bits, MPFR_RNDD);
mpfr_exp(expx, expx, MPFR_RNDD);
mpfr_mul_2ui(y1, tabx, prec, MPFR_RNDD);
mpfr_floor(y1, y1);
mpfr_div_2ui(y1, y1, prec, MPFR_RNDD);
mpfr_mul_2ui(y2, expx, prec - 1, MPFR_RNDD);
mpfr_floor(y2, y2);
mpfr_div_2ui(y2, y2, prec, MPFR_RNDD);
if (!mpfr_equal_p(y1, y2))
{
flint_printf("FAIL: i = %wd, bits = %wd, prec = %wd\n", i, bits, prec);
mpfr_printf("y1 = %.1500Rg\n", y1);
mpfr_printf("y2 = %.1500Rg\n", y2);
abort();
}
}
mpfr_clear(tabx);
mpfr_clear(expx);
mpfr_clear(y1);
mpfr_clear(y2);
}
{
slong prec, bits, num;
prec = ARB_EXP_TAB2_LIMBS * FLINT_BITS;
bits = ARB_EXP_TAB21_BITS + ARB_EXP_TAB22_BITS;
num = ARB_EXP_TAB22_NUM;
mpfr_init2(tabx, prec);
mpfr_init2(expx, prec);
mpfr_init2(y1, prec);
mpfr_init2(y2, prec);
for (i = 0; i < num; i++)
{
tt->_mp_d = (mp_ptr) arb_exp_tab22[i];
tt->_mp_size = prec / FLINT_BITS;
tt->_mp_alloc = tt->_mp_size;
while (tt->_mp_size > 0 && tt->_mp_d[tt->_mp_size-1] == 0)
tt->_mp_size--;
mpfr_set_z(tabx, tt, MPFR_RNDD);
mpfr_div_2ui(tabx, tabx, prec, MPFR_RNDD);
mpfr_set_ui(expx, i, MPFR_RNDD);
mpfr_div_2ui(expx, expx, bits, MPFR_RNDD);
mpfr_exp(expx, expx, MPFR_RNDD);
mpfr_mul_2ui(y1, tabx, prec, MPFR_RNDD);
mpfr_floor(y1, y1);
mpfr_div_2ui(y1, y1, prec, MPFR_RNDD);
mpfr_mul_2ui(y2, expx, prec - 1, MPFR_RNDD);
mpfr_floor(y2, y2);
mpfr_div_2ui(y2, y2, prec, MPFR_RNDD);
if (!mpfr_equal_p(y1, y2))
{
flint_printf("FAIL: i = %wd, bits = %wd, prec = %wd\n", i, bits, prec);
mpfr_printf("y1 = %.1500Rg\n", y1);
mpfr_printf("y2 = %.1500Rg\n", y2);
abort();
}
}
mpfr_clear(tabx);
mpfr_clear(expx);
mpfr_clear(y1);
mpfr_clear(y2);
}
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
/* Put in y an approximation of erfc(x) for large x, using formulae 7.1.23 and
7.1.24 from Abramowitz and Stegun.
Returns e such that the error is bounded by 2^e ulp(y),
or returns 0 in case of underflow.
*/
static mpfr_exp_t
mpfr_erfc_asympt (mpfr_ptr y, mpfr_srcptr x)
{
mpfr_t t, xx, err;
unsigned long k;
mpfr_prec_t prec = MPFR_PREC(y);
mpfr_exp_t exp_err;
mpfr_init2 (t, prec);
mpfr_init2 (xx, prec);
mpfr_init2 (err, 31);
/* let u = 2^(1-p), and let us represent the error as (1+u)^err
with a bound for err */
mpfr_mul (xx, x, x, MPFR_RNDD); /* err <= 1 */
mpfr_ui_div (xx, 1, xx, MPFR_RNDU); /* upper bound for 1/(2x^2), err <= 2 */
mpfr_div_2ui (xx, xx, 1, MPFR_RNDU); /* exact */
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term, exact */
mpfr_set (y, t, MPFR_RNDN); /* current sum */
mpfr_set_ui (err, 0, MPFR_RNDN);
for (k = 1; ; k++)
{
mpfr_mul_ui (t, t, 2 * k - 1, MPFR_RNDU); /* err <= 4k-3 */
mpfr_mul (t, t, xx, MPFR_RNDU); /* err <= 4k */
/* for -1 < x < 1, and |nx| < 1, we have |(1+x)^n| <= 1+7/4|nx|.
Indeed, for x>=0: log((1+x)^n) = n*log(1+x) <= n*x. Let y=n*x < 1,
then exp(y) <= 1+7/4*y.
For x<=0, let x=-x, we can prove by induction that (1-x)^n >= 1-n*x.*/
mpfr_mul_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
mpfr_add_ui (err, err, 14 * k, MPFR_RNDU); /* 2^(1-p) * t <= 2 ulp(t) */
mpfr_div_2si (err, err, MPFR_GET_EXP (y) - MPFR_GET_EXP (t), MPFR_RNDU);
if (MPFR_GET_EXP (t) + (mpfr_exp_t) prec <= MPFR_GET_EXP (y))
{
/* the truncation error is bounded by |t| < ulp(y) */
mpfr_add_ui (err, err, 1, MPFR_RNDU);
break;
}
if (k & 1)
mpfr_sub (y, y, t, MPFR_RNDN);
else
mpfr_add (y, y, t, MPFR_RNDN);
}
/* the error on y is bounded by err*ulp(y) */
mpfr_mul (t, x, x, MPFR_RNDU); /* rel. err <= 2^(1-p) */
mpfr_div_2ui (err, err, 3, MPFR_RNDU); /* err/8 */
mpfr_add (err, err, t, MPFR_RNDU); /* err/8 + xx */
mpfr_mul_2ui (err, err, 3, MPFR_RNDU); /* err + 8*xx */
mpfr_exp (t, t, MPFR_RNDU); /* err <= 1/2*ulp(t) + err(x*x)*t
<= 1/2*ulp(t)+2*|x*x|*ulp(t)
<= (2*|x*x|+1/2)*ulp(t) */
mpfr_mul (t, t, x, MPFR_RNDN); /* err <= 1/2*ulp(t) + (4*|x*x|+1)*ulp(t)
<= (4*|x*x|+3/2)*ulp(t) */
mpfr_const_pi (xx, MPFR_RNDZ); /* err <= ulp(Pi) */
mpfr_sqrt (xx, xx, MPFR_RNDN); /* err <= 1/2*ulp(xx) + ulp(Pi)/2/sqrt(Pi)
<= 3/2*ulp(xx) */
mpfr_mul (t, t, xx, MPFR_RNDN); /* err <= (8 |xx| + 13/2) * ulp(t) */
mpfr_div (y, y, t, MPFR_RNDN); /* the relative error on input y is bounded
by (1+u)^err with u = 2^(1-p), that on
t is bounded by (1+u)^(8 |xx| + 13/2),
thus that on output y is bounded by
8 |xx| + 7 + err. */
if (MPFR_IS_ZERO(y))
{
/* If y is zero, most probably we have underflow. We check it directly
using the fact that erfc(x) <= exp(-x^2)/sqrt(Pi)/x for x >= 0.
We compute an upper approximation of exp(-x^2)/sqrt(Pi)/x.
*/
mpfr_mul (t, x, x, MPFR_RNDD); /* t <= x^2 */
mpfr_neg (t, t, MPFR_RNDU); /* -x^2 <= t */
mpfr_exp (t, t, MPFR_RNDU); /* exp(-x^2) <= t */
mpfr_const_pi (xx, MPFR_RNDD); /* xx <= sqrt(Pi), cached */
mpfr_mul (xx, xx, x, MPFR_RNDD); /* xx <= sqrt(Pi)*x */
mpfr_div (y, t, xx, MPFR_RNDN); /* if y is zero, this means that the upper
approximation of exp(-x^2)/sqrt(Pi)/x
is nearer from 0 than from 2^(-emin-1),
thus we have underflow. */
exp_err = 0;
}
else
{
mpfr_add_ui (err, err, 7, MPFR_RNDU);
exp_err = MPFR_GET_EXP (err);
}
mpfr_clear (t);
mpfr_clear (xx);
mpfr_clear (err);
return exp_err;
}
int
mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mp_rnd_t rnd_mode)
{
mpfr_t x;
int inexact;
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", xt, xt, rnd_mode),
("y[%#R]=%R inexact=%d", y, y, inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t t, ti;
mp_exp_t d;
mp_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
Nt = MAX (MPFR_PREC (x), MPFR_PREC (y));
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */
if (MPFR_GET_EXP (x) < 0)
Nt -= 2*MPFR_GET_EXP (x);
/* initialise of intermediary variables */
MPFR_GROUP_INIT_2 (group, Nt, t, ti);
/* First computation of sinh */
MPFR_ZIV_INIT (loop, Nt);
for (;;) {
/* compute sinh */
mpfr_clear_flags ();
mpfr_exp (t, x, GMP_RNDD); /* exp(x) */
/* exp(x) can overflow! */
/* BUG/TODO/FIXME: exp can overflow but sinh may be representable! */
if (MPFR_UNLIKELY (mpfr_overflow_p ())) {
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
d = MPFR_GET_EXP (t);
mpfr_ui_div (ti, 1, t, GMP_RNDU); /* 1/exp(x) */
mpfr_sub (t, t, ti, GMP_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (t, t, 1, GMP_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that t is zero (in fact, it can only occur when te=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (t))
err = Nt; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (t) + 2;
/* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = Nt - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y), rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
}
/* actualisation of the precision */
Nt += err;
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
return mpfr_check_range (y, inexact, rnd_mode);
}
int
mpfr_tanh (mpfr_ptr y, mpfr_srcptr xt , mpfr_rnd_t rnd_mode)
{
/****** Declaration ******/
mpfr_t x;
int inexact;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
/* Special value checking */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
/* tanh(inf) = 1 && tanh(-inf) = -1 */
return mpfr_set_si (y, MPFR_INT_SIGN (xt), rnd_mode);
}
else /* tanh (0) = 0 and xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO(xt));
MPFR_SET_ZERO (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* tanh(x) = x - x^3/3 + ... so the error is < 2^(3*EXP(x)-1) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP (xt), 1, 0,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
MPFR_SAVE_EXPO_MARK (expo);
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, te;
mpfr_exp_t d;
/* Declaration of the size variable */
mpfr_prec_t Ny = MPFR_PREC(y); /* target precision */
mpfr_prec_t Nt; /* working precision */
long int err; /* error */
int sign = MPFR_SIGN (xt);
MPFR_ZIV_DECL (loop);
MPFR_GROUP_DECL (group);
/* First check for BIG overflow of exp(2*x):
For x > 0, exp(2*x) > 2^(2*x)
If 2 ^(2*x) > 2^emax or x>emax/2, there is an overflow */
if (MPFR_UNLIKELY (mpfr_cmp_si (x, __gmpfr_emax/2) >= 0)) {
/* initialise of intermediary variables
since 'set_one' label assumes the variables have been
initialize */
MPFR_GROUP_INIT_2 (group, MPFR_PREC_MIN, t, te);
goto set_one;
}
/* Compute the precision of intermediary variable */
/* The optimal number of bits: see algorithms.tex */
Nt = Ny + MPFR_INT_CEIL_LOG2 (Ny) + 4;
/* if x is small, there will be a cancellation in exp(2x)-1 */
if (MPFR_GET_EXP (x) < 0)
Nt += -MPFR_GET_EXP (x);
/* initialise of intermediary variable */
MPFR_GROUP_INIT_2 (group, Nt, t, te);
MPFR_ZIV_INIT (loop, Nt);
for (;;) {
/* tanh = (exp(2x)-1)/(exp(2x)+1) */
mpfr_mul_2ui (te, x, 1, MPFR_RNDN); /* 2x */
/* since x > 0, we can only have an overflow */
mpfr_exp (te, te, MPFR_RNDN); /* exp(2x) */
if (MPFR_UNLIKELY (MPFR_IS_INF (te))) {
set_one:
inexact = MPFR_FROM_SIGN_TO_INT (sign);
mpfr_set4 (y, __gmpfr_one, MPFR_RNDN, sign);
if (MPFR_IS_LIKE_RNDZ (rnd_mode, MPFR_IS_NEG_SIGN (sign)))
{
inexact = -inexact;
mpfr_nexttozero (y);
}
break;
}
d = MPFR_GET_EXP (te); /* For Error calculation */
mpfr_add_ui (t, te, 1, MPFR_RNDD); /* exp(2x) + 1*/
mpfr_sub_ui (te, te, 1, MPFR_RNDU); /* exp(2x) - 1*/
d = d - MPFR_GET_EXP (te);
mpfr_div (t, te, t, MPFR_RNDN); /* (exp(2x)-1)/(exp(2x)+1)*/
/* Calculation of the error */
d = MAX(3, d + 1);
err = Nt - (d + 1);
if (MPFR_LIKELY ((d <= Nt / 2) && MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, sign);
break;
}
/* if t=1, we still can round since |sinh(x)| < 1 */
if (MPFR_GET_EXP (t) == 1)
goto set_one;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, te);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
}
MPFR_SAVE_EXPO_FREE (expo);
inexact = mpfr_check_range (y, inexact, rnd_mode);
return inexact;
}
/* Assumes that the exponent range has already been extended and if y is
an integer, then the result is not exact in unbounded exponent range. */
int
mpfr_pow_general (mpfr_ptr z, mpfr_srcptr x, mpfr_srcptr y,
mpfr_rnd_t rnd_mode, int y_is_integer, mpfr_save_expo_t *expo)
{
mpfr_t t, u, k, absx;
int neg_result = 0;
int k_non_zero = 0;
int check_exact_case = 0;
int inexact;
/* Declaration of the size variable */
mpfr_prec_t Nz = MPFR_PREC(z); /* target precision */
mpfr_prec_t Nt; /* working precision */
mpfr_exp_t err; /* error */
MPFR_ZIV_DECL (ziv_loop);
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));
/* We put the absolute value of x in absx, pointing to the significand
of x to avoid allocating memory for the significand of absx. */
MPFR_ALIAS(absx, x, /*sign=*/ 1, /*EXP=*/ MPFR_EXP(x));
/* We will compute the absolute value of the result. So, let's
invert the rounding mode if the result is negative. */
if (MPFR_IS_NEG (x) && is_odd (y))
{
neg_result = 1;
rnd_mode = MPFR_INVERT_RND (rnd_mode);
}
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Nz + 5 + MPFR_INT_CEIL_LOG2 (Nz);
/* initialise of intermediary variable */
mpfr_init2 (t, Nt);
MPFR_ZIV_INIT (ziv_loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags1);
/* compute exp(y*ln|x|), using MPFR_RNDU to get an upper bound, so
that we can detect underflows. */
mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDD : MPFR_RNDU); /* ln|x| */
mpfr_mul (t, y, t, MPFR_RNDU); /* y*ln|x| */
if (k_non_zero)
{
MPFR_LOG_MSG (("subtract k * ln(2)\n", 0));
mpfr_const_log2 (u, MPFR_RNDD);
mpfr_mul (u, u, k, MPFR_RNDD);
/* Error on u = k * log(2): < k * 2^(-Nt) < 1. */
mpfr_sub (t, t, u, MPFR_RNDU);
MPFR_LOG_MSG (("t = y * ln|x| - k * ln(2)\n", 0));
MPFR_LOG_VAR (t);
}
/* estimate of the error -- see pow function in algorithms.tex.
The error on t is at most 1/2 + 3*2^(EXP(t)+1) ulps, which is
<= 2^(EXP(t)+3) for EXP(t) >= -1, and <= 2 ulps for EXP(t) <= -2.
Additional error if k_no_zero: treal = t * errk, with
1 - |k| * 2^(-Nt) <= exp(-|k| * 2^(-Nt)) <= errk <= 1,
i.e., additional absolute error <= 2^(EXP(k)+EXP(t)-Nt).
Total error <= 2^err1 + 2^err2 <= 2^(max(err1,err2)+1). */
err = MPFR_NOTZERO (t) && MPFR_GET_EXP (t) >= -1 ?
MPFR_GET_EXP (t) + 3 : 1;
if (k_non_zero)
{
if (MPFR_GET_EXP (k) > err)
err = MPFR_GET_EXP (k);
err++;
}
MPFR_BLOCK (flags1, mpfr_exp (t, t, MPFR_RNDN)); /* exp(y*ln|x|)*/
/* We need to test */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (t) || MPFR_UNDERFLOW (flags1)))
{
mpfr_prec_t Ntmin;
MPFR_BLOCK_DECL (flags2);
MPFR_ASSERTN (!k_non_zero);
MPFR_ASSERTN (!MPFR_IS_NAN (t));
/* Real underflow? */
if (MPFR_IS_ZERO (t))
{
/* Underflow. We computed rndn(exp(t)), where t >= y*ln|x|.
Therefore rndn(|x|^y) = 0, and we have a real underflow on
|x|^y. */
inexact = mpfr_underflow (z, rnd_mode == MPFR_RNDN ? MPFR_RNDZ
: rnd_mode, MPFR_SIGN_POS);
if (expo != NULL)
MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT
| MPFR_FLAGS_UNDERFLOW);
break;
}
/* Real overflow? */
if (MPFR_IS_INF (t))
{
/* Note: we can probably use a low precision for this test. */
mpfr_log (t, absx, MPFR_IS_NEG (y) ? MPFR_RNDU : MPFR_RNDD);
mpfr_mul (t, y, t, MPFR_RNDD); /* y * ln|x| */
MPFR_BLOCK (flags2, mpfr_exp (t, t, MPFR_RNDD));
/* t = lower bound on exp(y * ln|x|) */
if (MPFR_OVERFLOW (flags2))
{
/* We have computed a lower bound on |x|^y, and it
overflowed. Therefore we have a real overflow
on |x|^y. */
inexact = mpfr_overflow (z, rnd_mode, MPFR_SIGN_POS);
if (expo != NULL)
MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, MPFR_FLAGS_INEXACT
| MPFR_FLAGS_OVERFLOW);
break;
}
}
k_non_zero = 1;
Ntmin = sizeof(mpfr_exp_t) * CHAR_BIT;
if (Ntmin > Nt)
{
Nt = Ntmin;
mpfr_set_prec (t, Nt);
}
mpfr_init2 (u, Nt);
mpfr_init2 (k, Ntmin);
mpfr_log2 (k, absx, MPFR_RNDN);
mpfr_mul (k, y, k, MPFR_RNDN);
mpfr_round (k, k);
MPFR_LOG_VAR (k);
/* |y| < 2^Ntmin, therefore |k| < 2^Nt. */
continue;
}
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, Nt - err, Nz, rnd_mode)))
{
inexact = mpfr_set (z, t, rnd_mode);
break;
}
/* check exact power, except when y is an integer (since the
exact cases for y integer have already been filtered out) */
if (check_exact_case == 0 && ! y_is_integer)
{
if (mpfr_pow_is_exact (z, absx, y, rnd_mode, &inexact))
break;
check_exact_case = 1;
}
/* reactualisation of the precision */
MPFR_ZIV_NEXT (ziv_loop, Nt);
mpfr_set_prec (t, Nt);
if (k_non_zero)
mpfr_set_prec (u, Nt);
}
MPFR_ZIV_FREE (ziv_loop);
if (k_non_zero)
{
int inex2;
long lk;
/* The rounded result in an unbounded exponent range is z * 2^k. As
* MPFR chooses underflow after rounding, the mpfr_mul_2si below will
* correctly detect underflows and overflows. However, in rounding to
* nearest, if z * 2^k = 2^(emin - 2), then the double rounding may
* affect the result. We need to cope with that before overwriting z.
* This can occur only if k < 0 (this test is necessary to avoid a
* potential integer overflow).
* If inexact >= 0, then the real result is <= 2^(emin - 2), so that
* o(2^(emin - 2)) = +0 is correct. If inexact < 0, then the real
* result is > 2^(emin - 2) and we need to round to 2^(emin - 1).
*/
MPFR_ASSERTN (MPFR_EXP_MAX <= LONG_MAX);
lk = mpfr_get_si (k, MPFR_RNDN);
/* Due to early overflow detection, |k| should not be much larger than
* MPFR_EMAX_MAX, and as MPFR_EMAX_MAX <= MPFR_EXP_MAX/2 <= LONG_MAX/2,
* an overflow should not be possible in mpfr_get_si (and lk is exact).
* And one even has the following assertion. TODO: complete proof.
*/
MPFR_ASSERTD (lk > LONG_MIN && lk < LONG_MAX);
/* Note: even in case of overflow (lk inexact), the code is correct.
* Indeed, for the 3 occurrences of lk:
* - The test lk < 0 is correct as sign(lk) = sign(k).
* - In the test MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk,
* if lk is inexact, then lk = LONG_MIN <= MPFR_EXP_MIN
* (the minimum value of the mpfr_exp_t type), and
* __gmpfr_emin - 1 - lk >= MPFR_EMIN_MIN - 1 - 2 * MPFR_EMIN_MIN
* >= - MPFR_EMIN_MIN - 1 = MPFR_EMAX_MAX - 1. However, from the
* choice of k, z has been chosen to be around 1, so that the
* result of the test is false, as if lk were exact.
* - In the mpfr_mul_2si (z, z, lk, rnd_mode), if lk is inexact,
* then |lk| >= LONG_MAX >= MPFR_EXP_MAX, and as z is around 1,
* mpfr_mul_2si underflows or overflows in the same way as if
* lk were exact.
* TODO: give a bound on |t|, then on |EXP(z)|.
*/
if (rnd_mode == MPFR_RNDN && inexact < 0 && lk < 0 &&
MPFR_GET_EXP (z) == __gmpfr_emin - 1 - lk && mpfr_powerof2_raw (z))
{
/* Rounding to nearest, real result > z * 2^k = 2^(emin - 2),
* underflow case: as the minimum precision is > 1, we will
* obtain the correct result and exceptions by replacing z by
* nextabove(z).
*/
MPFR_ASSERTN (MPFR_PREC_MIN > 1);
mpfr_nextabove (z);
}
MPFR_CLEAR_FLAGS ();
inex2 = mpfr_mul_2si (z, z, lk, rnd_mode);
if (inex2) /* underflow or overflow */
{
inexact = inex2;
if (expo != NULL)
MPFR_SAVE_EXPO_UPDATE_FLAGS (*expo, __gmpfr_flags);
}
mpfr_clears (u, k, (mpfr_ptr) 0);
}
mpfr_clear (t);
/* update the sign of the result if x was negative */
if (neg_result)
{
MPFR_SET_NEG(z);
inexact = -inexact;
}
return inexact;
}
/* Function to calculate the expected number of unique codes
within each input success class */
void uniquecodes(mpfr_t *ucodes, int psiz, mpz_t n, unsigned long int mu, mpz_t ncodes ,mpfr_t *pdf,mpfr_prec_t prec)
{
//200 bits precision gives log[2^200] around 60 digits decimal precision
mpfr_t unity;
mpfr_init2(unity,prec);
mpfr_set_ui(unity,(unsigned long int) 1,MPFR_RNDN);
mpfr_t nunity;
mpfr_init2(nunity,prec);
mpfr_set_si(nunity,(signed long int) -1,MPFR_RNDN);
mpz_t bcnum;
mpz_init(bcnum);
mpfr_t bcnumf;
mpfr_init2(bcnumf,prec);
mpq_t cfrac;
mpq_init(cfrac);
mpfr_t cfracf;
mpfr_init2(cfracf,prec);
mpfr_t expargr;
mpfr_init2(expargr,prec);
mpfr_t r1;
mpfr_init2(r1,prec);
mpfr_t r2;
mpfr_init2(r2,prec);
// mpfr_t pdf[mu];
unsigned long int i;
int pdex;
int addr;
// for(i=0;i<=mu;i++)
// mpfr_init2(pdf[i],prec);
// inpdf(pdf,n,pin,mu,bcs,prec);
for(pdex=0;pdex<=psiz-1;pdex++)
{
for(i=0;i<=mu;i++)
{
addr=pdex*(mu+1)+i;
mpz_bin_ui(bcnum,n,i);
mpq_set_num(cfrac,ncodes);
mpq_set_den(cfrac,bcnum);
mpq_canonicalize(cfrac);
mpfr_set_q(cfracf,cfrac,MPFR_RNDN);
mpfr_mul(expargr,cfracf,*(pdf+addr),MPFR_RNDN);
mpfr_mul(expargr,expargr,nunity,MPFR_RNDN);
mpfr_exp(r1,expargr,MPFR_RNDN);
mpfr_sub(r1,unity,r1,MPFR_RNDN);
mpfr_set_z(bcnumf,bcnum,MPFR_RNDN);
mpfr_mul(r2,bcnumf,r1,MPFR_RNDN);
mpfr_set((*ucodes+addr),r2,MPFR_RNDN);
mpfr_round((*ucodes+addr),(*ucodes+addr));
}
}
mpfr_clear(unity);
mpfr_clear(nunity);
mpz_clear(bcnum);
mpfr_clear(bcnumf);
mpq_clear(cfrac);
mpfr_clear(cfracf);
mpfr_clear(expargr);
mpfr_clear(r1);
mpfr_clear(r2);
// for(i=0;i<=mu;i++)
// mpfr_clear(pdf[i]);
}
int
mpfr_sinh (mpfr_ptr y, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
mpfr_t x;
int inexact;
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d", mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("y[%Pu]=%.*Rg inexact=%d",
mpfr_get_prec (y), mpfr_log_prec, y, inexact));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (y);
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (y); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (y, xt);
MPFR_RET (0);
}
}
/* sinh(x) = x + x^3/6 + ... so the error is < 2^(3*EXP(x)-2) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (y, xt, -2 * MPFR_GET_EXP(xt), 2, 1,
rnd_mode, {});
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t t, ti;
mpfr_exp_t d;
mpfr_prec_t Nt; /* Precision of the intermediary variable */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
Nt = MAX (MPFR_PREC (x), MPFR_PREC (y));
/* the optimal number of bits : see algorithms.ps */
Nt = Nt + MPFR_INT_CEIL_LOG2 (Nt) + 4;
/* If x is near 0, exp(x) - 1/exp(x) = 2*x+x^3/3+O(x^5) */
if (MPFR_GET_EXP (x) < 0)
Nt -= 2*MPFR_GET_EXP (x);
/* initialise of intermediary variables */
MPFR_GROUP_INIT_2 (group, Nt, t, ti);
/* First computation of sinh */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute sinh */
MPFR_BLOCK (flags, mpfr_exp (t, x, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* exp(x) does overflow */
{
/* sinh(x) = 2 * sinh(x/2) * cosh(x/2) */
mpfr_div_2ui (ti, x, 1, MPFR_RNDD); /* exact */
/* t <- cosh(x/2): error(t) <= 1 ulp(t) */
MPFR_BLOCK (flags, mpfr_cosh (t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* when x>1 we have |sinh(x)| >= cosh(x/2), so sinh(x)
overflows too */
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* ti <- sinh(x/2): , error(ti) <= 1 ulp(ti)
cannot overflow because 0 < sinh(x) < cosh(x) when x > 0 */
mpfr_sinh (ti, ti, MPFR_RNDD);
/* multiplication below, error(t) <= 5 ulp(t) */
MPFR_BLOCK (flags, mpfr_mul (t, t, ti, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* doubling below, exact */
MPFR_BLOCK (flags, mpfr_mul_2ui (t, t, 1, MPFR_RNDN));
if (MPFR_OVERFLOW (flags))
{
inexact = mpfr_overflow (y, rnd_mode, MPFR_SIGN (xt));
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
/* we have lost at most 3 bits of precision */
err = Nt - 3;
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
err = Nt; /* double the precision */
}
else
{
d = MPFR_GET_EXP (t);
mpfr_ui_div (ti, 1, t, MPFR_RNDU); /* 1/exp(x) */
mpfr_sub (t, t, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (t, t, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that t is zero (in fact, it can only occur when te=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (t))
err = Nt; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (t) + 2;
/* error estimate: err = Nt-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = Nt - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, MPFR_PREC (y),
rnd_mode)))
{
inexact = mpfr_set4 (y, t, rnd_mode, MPFR_SIGN (xt));
break;
}
}
}
/* actualisation of the precision */
Nt += err;
MPFR_ZIV_NEXT (loop, Nt);
MPFR_GROUP_REPREC_2 (group, Nt, t, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
return mpfr_check_range (y, inexact, rnd_mode);
}
int
mpfr_sinh_cosh (mpfr_ptr sh, mpfr_ptr ch, mpfr_srcptr xt, mpfr_rnd_t rnd_mode)
{
mpfr_t x;
int inexact_sh, inexact_ch;
MPFR_ASSERTN (sh != ch);
MPFR_LOG_FUNC
(("x[%Pu]=%.*Rg rnd=%d",
mpfr_get_prec (xt), mpfr_log_prec, xt, rnd_mode),
("sh[%Pu]=%.*Rg ch[%Pu]=%.*Rg",
mpfr_get_prec (sh), mpfr_log_prec, sh,
mpfr_get_prec (ch), mpfr_log_prec, ch));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (xt)))
{
if (MPFR_IS_NAN (xt))
{
MPFR_SET_NAN (ch);
MPFR_SET_NAN (sh);
MPFR_RET_NAN;
}
else if (MPFR_IS_INF (xt))
{
MPFR_SET_INF (sh);
MPFR_SET_SAME_SIGN (sh, xt);
MPFR_SET_INF (ch);
MPFR_SET_POS (ch);
MPFR_RET (0);
}
else /* xt is zero */
{
MPFR_ASSERTD (MPFR_IS_ZERO (xt));
MPFR_SET_ZERO (sh); /* sinh(0) = 0 */
MPFR_SET_SAME_SIGN (sh, xt);
inexact_sh = 0;
inexact_ch = mpfr_set_ui (ch, 1, rnd_mode); /* cosh(0) = 1 */
return INEX(inexact_sh,inexact_ch);
}
}
/* Warning: if we use MPFR_FAST_COMPUTE_IF_SMALL_INPUT here, make sure
that the code also works in case of overlap (see sin_cos.c) */
MPFR_TMP_INIT_ABS (x, xt);
{
mpfr_t s, c, ti;
mpfr_exp_t d;
mpfr_prec_t N; /* Precision of the intermediary variables */
long int err; /* Precision of error */
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
MPFR_SAVE_EXPO_MARK (expo);
/* compute the precision of intermediary variable */
N = MPFR_PREC (ch);
N = MAX (N, MPFR_PREC (sh));
/* the optimal number of bits : see algorithms.ps */
N = N + MPFR_INT_CEIL_LOG2 (N) + 4;
/* initialise of intermediary variables */
MPFR_GROUP_INIT_3 (group, N, s, c, ti);
/* First computation of sinh_cosh */
MPFR_ZIV_INIT (loop, N);
for (;;)
{
MPFR_BLOCK_DECL (flags);
/* compute sinh_cosh */
MPFR_BLOCK (flags, mpfr_exp (s, x, MPFR_RNDD));
if (MPFR_OVERFLOW (flags))
/* exp(x) does overflow */
{
/* since cosh(x) >= exp(x), cosh(x) overflows too */
inexact_ch = mpfr_overflow (ch, rnd_mode, MPFR_SIGN_POS);
/* sinh(x) may be representable */
inexact_sh = mpfr_sinh (sh, xt, rnd_mode);
MPFR_SAVE_EXPO_UPDATE_FLAGS (expo, MPFR_FLAGS_OVERFLOW);
break;
}
d = MPFR_GET_EXP (s);
mpfr_ui_div (ti, 1, s, MPFR_RNDU); /* 1/exp(x) */
mpfr_add (c, s, ti, MPFR_RNDU); /* exp(x) + 1/exp(x) */
mpfr_sub (s, s, ti, MPFR_RNDN); /* exp(x) - 1/exp(x) */
mpfr_div_2ui (c, c, 1, MPFR_RNDN); /* 1/2(exp(x) + 1/exp(x)) */
mpfr_div_2ui (s, s, 1, MPFR_RNDN); /* 1/2(exp(x) - 1/exp(x)) */
/* it may be that s is zero (in fact, it can only occur when exp(x)=1,
and thus ti=1 too) */
if (MPFR_IS_ZERO (s))
err = N; /* double the precision */
else
{
/* calculation of the error */
d = d - MPFR_GET_EXP (s) + 2;
/* error estimate: err = N-(__gmpfr_ceil_log2(1+pow(2,d)));*/
err = N - (MAX (d, 0) + 1);
if (MPFR_LIKELY (MPFR_CAN_ROUND (s, err, MPFR_PREC (sh),
rnd_mode) && \
MPFR_CAN_ROUND (c, err, MPFR_PREC (ch),
rnd_mode)))
{
inexact_sh = mpfr_set4 (sh, s, rnd_mode, MPFR_SIGN (xt));
inexact_ch = mpfr_set (ch, c, rnd_mode);
break;
}
}
/* actualisation of the precision */
N += err;
MPFR_ZIV_NEXT (loop, N);
MPFR_GROUP_REPREC_3 (group, N, s, c, ti);
}
MPFR_ZIV_FREE (loop);
MPFR_GROUP_CLEAR (group);
MPFR_SAVE_EXPO_FREE (expo);
}
/* now, let's raise the flags if needed */
inexact_sh = mpfr_check_range (sh, inexact_sh, rnd_mode);
inexact_ch = mpfr_check_range (ch, inexact_ch, rnd_mode);
return INEX(inexact_sh,inexact_ch);
}
/******************************************************************************
One forward-backward pass through a minimum-duration HMM model with a
single Gaussian in each of the states. T: totalFeatures
*******************************************************************************/
double ESHMM::mdHMMLogForwardBackward(ESHMM *mdHMM, VECTOR_OF_F_VECTORS *features, double **post, int T, mat &gamma, rowvec &gamma1,
mat &sumxi){
printf("forward backward algorithm calculation in progress...\n");
int i = 0, j = 0 , k = 0;
/* total no of states is much larger, instead of number of pdfs we have to extend
states by Min_DUR, therefore total states = Q * MD */
int Q = mdHMM->hmmStates;
int Qmd = Q * MIN_DUR;
mat logalpha(T, Qmd); // forward probability matrix
mat logbeta(T, Qmd); // backward probability matrix
mat logg(T, Qmd); // loggamma
mat m(Q, 1);
mat logA(Qmd, Qmd); /// transition matrix is already in logarithm
mat new_logp(T, Qmd); // after replication for each substates
mat logp_k(Q, T); // we have single cluster only, probability of each feature corresponding to each cluster
printf("Q: %d Qmd: %d\n", Q, Qmd);
for(i = 0; i < Qmd; i++){
for(j = 0; j < Qmd; j++){
logA(i, j) = mdHMM->trans[i]->array[j];
}
}
// minimum duration viterbi hence modify B(posterior) prob matrix
for(i = 0; i < Q; i++)
for(j = 0; j < T; j++){
logp_k(i, j) = post[i][j];
}
for(i = 0; i < Q; i++){
m(i, 0) = 1;
for(j = 0; j < T; j++)
logp_k(i, j) = 0.0; // since we have only one cluster so cluster probability and
// total probability is same. Hence subtracting cluster probability from total probability would make it zero.
}
// modifying logp matrix according to minimum duration
for(i = 0; i < Q; i++){
for(j = 0; j < T; j++){
for(k = i*MIN_DUR; k < (i+1)*MIN_DUR; k++){
new_logp(j, k) = post[i][j];
}
}
}
/* forward initialization */
// for summing log probabilties, first sum probs and then take logarithm
printf("forward initialization...\n\n");
for(i = 0; i < Qmd; i++){
logalpha(0, i) = mdHMM->prior->array[i] + new_logp(0, i) ;
}
///print logalpha after initialization
for(i = 0; i < Qmd; i++)
printf("%lf ", logalpha(0, i));
/* forward induction */
printf("forward induction in progress...\n");
int t = 0;
mpfr_t summation3;
mpfr_init(summation3);
mpfr_t var11, var21;
mpfr_init(var11);
mpfr_init(var21);
mpfr_set_d(var11, 0.0, MPFR_RNDN);
mpfr_set_d(var21, 0.0, MPFR_RNDN);
mpfr_set_d(summation3, 0.0, MPFR_RNDN);
for(t = 1; t < T; t++){
//printf("%d ", t);
for(j = 0; j < Qmd; j++){
vec v1(Qmd), v2(Qmd); vec v3(Qmd);
//first find logalpha vector
for(i = 0; i < Qmd; i++)
v1(i) = logalpha(t-1, i);
// if(t < 20)
// v1.print("v1:\n");
// extract transition probability vector
for(i = 0; i < Qmd; i++)
v2(i) = logA(i, j);
// if(t < 20)
// v2.print("v2:\n");
// Now sum both the vectors into one
for(i = 0; i < Qmd; i++)
v3(i) = v1(i) + v2(i);
double *temp = (double *)calloc(Qmd, sizeof(double ));
for(i = 0; i < Qmd; i++)
temp[i] = v3(i);
// if(t < 20)
// v3.print("v3:\n");
//printf("printed\n");
// now sum over whole column vector
mpfr_set_d(summation3, 0.0, MPFR_RNDN);
// take the exponentiation and summation in one loop
// getting double from mpfr variable
/// double mpfr_get_d(mpfr_t op, mpfr_rnd_t rnd);
//mpfr_set_d(var1, 0.0, MPFR_RNDD);
//mpfr_set_d(var2, 0.0, MPFR_RNDD);
// now take the exponentiation
for(i = 0; i < Qmd; i++){
double elem = temp[i];
mpfr_set_d(var21, elem, MPFR_RNDD);
//mpfr_printf("var2: %lf\n", var21);
mpfr_exp(var11, var21, MPFR_RNDD); ///take exp(v2) and store in v1
// take sum of all elements in total
mpfr_add(summation3, summation3, var11, MPFR_RNDD); // add summation and v1
}
// now take the logarithm of sum
mpfr_log(summation3, summation3, MPFR_RNDD);
// now convert this sum to double
double sum2 = mpfr_get_d(summation3, MPFR_RNDD);
// now assign this double to logalpha
// now add logp(t, j)
sum2 += new_logp(t, j);
// if(t < 20)
// printf("sum: %lf\n", sum2);
logalpha(t, j) = sum2;
/// clear mpfr variables
}
if(t < 20){
printf("logalpha:\n");
for(j = 0; j < Qmd; j++)
printf("%lf ", logalpha(t, j));
printf("\n");
}
} // close the forward induction loop
mpfr_clear(var11);
mpfr_clear(var21);
mpfr_clear(summation3);
/* forward termination */
double ll = 0; // total log likelihood of all observation given this HMM
for(i = 0; i < Qmd; i++){
ll += logalpha(T-1, i);
}
///===================================================================
// for(i = 0; i < 100; i++){
// for(j = 0; j < Qmd; j++)
// printf("%lf ", logalpha(i, j));
// printf("\n");
// }
printf("\nprinting last column of logalpha...\n");
for(i = 1; i < 6; i++){
for(j = 0; j < Qmd; j++)
printf("%lf ", logalpha(T-i, j));
printf("\n");
}
printf("total loglikelihood: %lf\n", ll);
///===================================================================
double sum = 0;
/* calculate logalpha last row sum */
for(i = 0; i < Qmd; i++)
sum += logalpha(T-1, i);
ll = sum;
printf("LL: %lf........\n", ll);
/* backward initilization */
/// intialize mpfr variables
mpfr_t summation;
mpfr_init(summation);
mpfr_t var1, var2;
mpfr_init(var1);
mpfr_init(var2);
mpfr_set_d(summation, 0.0, MPFR_RNDN);
mpfr_set_d(var1, 0.0, MPFR_RNDN);
mpfr_set_d(var2, 0.0, MPFR_RNDN);
printf("backward initialization...\n");
mpfr_set_d(summation, 0.0, MPFR_RNDN);
double *temp = (double *)calloc(Qmd, sizeof(double ));
for(i = 0; i < Qmd; i++)
temp[i] = logalpha(T-1, i);
for(i = 0; i < Qmd; i++){
//double elem = logalpha(T-1, i);
double elem = temp[i-1];
mpfr_set_d(var2, elem, MPFR_RNDN);
mpfr_exp(var1, var2, MPFR_RNDN);
mpfr_add(summation, summation, var1, MPFR_RNDN);
}
// take logarithm
mpfr_log(summation, summation, MPFR_RNDN);
double sum2 = mpfr_get_d(summation, MPFR_RNDN);
for(i = 0; i < Qmd; i++){
logg(T-1, i) = logalpha(T-1, i) - sum2 ;
}
// gamma matrix
for(j = 0; j < Q; j++){
gamma(j, T-1) = exp(logp_k(j, T-1) + logg(T-1, j));
}
mat lognewxi(Qmd, Qmd); // declare lognewxi matrix
/* backward induction */
printf("backward induction in progress...\n");
for(t = T-2; t >= 0 ; t--){
for(j = 0; j < Qmd; j++){
vec v1(Qmd);
vec v2(Qmd);
vec v3(Qmd);
sum = 0;
for(i = 0; i < Qmd; i++)
v1(i) = logA(j, i);
for(i = 0; i < Qmd; i++)
v2(i) = logbeta(t+1, i);
for(i = 0; i < Qmd; i++)
v3(i) = new_logp(t+1, i);
// add all three vectors
for(i = 0; i < Qmd; i++)
v1(i) += v2(i) + v3(i);
mpfr_set_d(summation, 0.0, MPFR_RNDN);
for(i = 0; i < Qmd; i++){
double elem = v1(i);
mpfr_set_d(var2, elem, MPFR_RNDN);
mpfr_exp(var1, var2, MPFR_RNDN);
mpfr_add(summation, summation, var1, MPFR_RNDN);
}
mpfr_log(summation, summation, MPFR_RNDN);
sum2 = mpfr_get_d(summation, MPFR_RNDN);
logbeta(t, j) = sum2;
}
// computation of log(gamma) is now possible called logg here
for(i = 0; i < Qmd; i++){
logg(t, i) = logalpha(t, i) + logbeta(t, i);
}
mpfr_set_d(summation, 0.0, MPFR_RNDN);
for(i = 0; i < Qmd; i++){
double elem = logg(t, i);
mpfr_set_d(var2, elem, MPFR_RNDN);
mpfr_exp(var1, var2, MPFR_RNDN);
mpfr_add(summation, summation, var1, MPFR_RNDN);
}
mpfr_log(summation, summation, MPFR_RNDN);
sum2 = mpfr_get_d(summation, MPFR_RNDN);
for(i = 0; i < Qmd; i++)
logg(t, i) = logg(t, i) - sum2;
// finally the gamma_k is computed (called gamma here )
mpfr_set_d(summation, 0.0, MPFR_RNDN);
for(j = 0; j < Q; j++){
// for(i = j*MIN_DUR; i < (j+1) * MIN_DUR; i++){
// sum += exp(logg(t, i));
// }
gamma(j, t) = exp( logp_k(j, t) + logg(t, j) );
}
/* for the EM algorithm we need the sum
over xi all over t */
// replicate logalpha(t, :)' matrix along columns
mat m1(Qmd, Qmd);
for(i = 0; i < Qmd; i++){
for(j = 0; j < Qmd; j++){
m1(i, j) = logalpha(t, i);
}
}
// replicate logbeta matrix
vec v1(Qmd);
for(i = 0; i < Qmd; i++)
v1(i) = logbeta(t+1, i);
vec v2(Qmd);
for(i = 0; i < Qmd; i++)
v2(i) = new_logp(t+1, i);
vec v3(Qmd);
for(i = 0; i < Qmd; i++)
v3(i) = v1(i) + v2(i);
// replicate v3 row vector along all rows of matrix m2
mat m2(Qmd, Qmd);
for(i = 0; i < Qmd; i++){
for(j = 0; j < Qmd; j++){
m2(i, j) = v3(i);
}
}
// add both matrices m1 and m2
mat m3(Qmd, Qmd);
m3 = m1 + m2; // can do direct addition
///mat lognewxi(Qmd, Qmd); // declare lognewxi matrix
lognewxi.zeros();
lognewxi = m3 + logA;
// add new sum to older sumxi
/// first subtract total sum from lognewxi
mpfr_set_d(summation, 0.0, MPFR_RNDN);
for(i = 0; i < Qmd; i++){
for(j = 0; j < Qmd; j++){
double elem = lognewxi(i, j);
mpfr_set_d(var2, elem, MPFR_RNDN);
mpfr_exp(var1, var2, MPFR_RNDN);
mpfr_add(summation, summation, var1, MPFR_RNDN);
//sum += exp(lognewxi(i, j));
}
}
// now take the logarithm of sum
mpfr_log(summation, summation, MPFR_RNDN);
sum2 = mpfr_get_d(summation, MPFR_RNDN);
// subtract sum from lognewxi
for(i = 0; i < Qmd; i++){
for(j = 0; j < Qmd; j++){
lognewxi(i, j) = lognewxi(i, j) - sum2;
}
}
mat newxi(Qmd, Qmd);
newxi = lognewxi;
// add sumxi and newlogsumxi
/// take exponential of each element
for(i = 0; i < Qmd; i++){
for(j = 0; j < Qmd; j++){
newxi(i, j) = exp(newxi(i, j));
}
}
sumxi = sumxi + newxi;
} // close the backward induction loop
/* handle annoying numerics */
/// calculate sum of lognewxi along each row (lognewxi is already modified in our case)
for(i = 0; i < Qmd; i++){
mpfr_set_d(summation, 0.0, MPFR_RNDN);
for(j = 0; j < Qmd; j++){
//sum += lognewxi(i, j);
double elem = lognewxi(i, j);
mpfr_set_d(var2, elem, MPFR_RNDN);
mpfr_exp(var1, var2, MPFR_RNDN);
mpfr_add(summation, summation, var1, MPFR_RNDN);
}
sum2 = mpfr_get_d(summation, MPFR_RNDN);
gamma1(i) = sum2;
}
// normalize gamma1 which is prior and normalize sumxi which is transition matrix
sum = 0;
for(i = 0; i < Qmd; i++)
sum += gamma1(i);
for(i = 0; i < Qmd; i++)
gamma1(i) /= sum;
// transition probability matrix will be normalized in train_hmm function
/// clear mpfr variables
mpfr_clear(summation);
mpfr_clear(var1);
mpfr_clear(var2);
printf("forward-backward algorithm calculation is done...\n");
/* finished forward-backward algorithm */
return ll;
}
