int
mpfr_cos (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t K0, K, precy, m, k, l;
int inexact, reduce = 0;
mpfr_t r, s, xr, c;
mpfr_exp_t exps, cancel = 0, expx;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
MPFR_GROUP_DECL (group);
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_IS_INF (x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
else
{
MPFR_ASSERTD (MPFR_IS_ZERO (x));
return mpfr_set_ui (y, 1, rnd_mode);
}
}
MPFR_SAVE_EXPO_MARK (expo);
/* cos(x) = 1-x^2/2 + ..., so error < 2^(2*EXP(x)-1) */
expx = MPFR_GET_EXP (x);
MPFR_SMALL_INPUT_AFTER_SAVE_EXPO (y, __gmpfr_one, -2 * expx,
1, 0, rnd_mode, expo, {});
/* Compute initial precision */
precy = MPFR_PREC (y);
if (precy >= MPFR_SINCOS_THRESHOLD)
{
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_cos_fast (y, x, rnd_mode);
}
K0 = __gmpfr_isqrt (precy / 3);
m = precy + 2 * MPFR_INT_CEIL_LOG2 (precy) + 2 * K0;
if (expx >= 3)
{
reduce = 1;
/* As expx + m - 1 will silently be converted into mpfr_prec_t
in the mpfr_init2 call, the assert below may be useful to
avoid undefined behavior. */
MPFR_ASSERTN (expx + m - 1 <= MPFR_PREC_MAX);
mpfr_init2 (c, expx + m - 1);
mpfr_init2 (xr, m);
}
MPFR_GROUP_INIT_2 (group, m, r, s);
MPFR_ZIV_INIT (loop, m);
for (;;)
{
/* If |x| >= 4, first reduce x cmod (2*Pi) into xr, using mpfr_remainder:
let e = EXP(x) >= 3, and m the target precision:
(1) c <- 2*Pi [precision e+m-1, nearest]
(2) xr <- remainder (x, c) [precision m, nearest]
We have |c - 2*Pi| <= 1/2ulp(c) = 2^(3-e-m)
|xr - x - k c| <= 1/2ulp(xr) <= 2^(1-m)
|k| <= |x|/(2*Pi) <= 2^(e-2)
Thus |xr - x - 2kPi| <= |k| |c - 2Pi| + 2^(1-m) <= 2^(2-m).
It follows |cos(xr) - cos(x)| <= 2^(2-m). */
if (reduce)
{
mpfr_const_pi (c, MPFR_RNDN);
mpfr_mul_2ui (c, c, 1, MPFR_RNDN); /* 2Pi */
mpfr_remainder (xr, x, c, MPFR_RNDN);
if (MPFR_IS_ZERO(xr))
goto ziv_next;
/* now |xr| <= 4, thus r <= 16 below */
mpfr_mul (r, xr, xr, MPFR_RNDU); /* err <= 1 ulp */
}
else
mpfr_mul (r, x, x, MPFR_RNDU); /* err <= 1 ulp */
/* now |x| < 4 (or xr if reduce = 1), thus |r| <= 16 */
/* we need |r| < 1/2 for mpfr_cos2_aux, i.e., EXP(r) - 2K <= -1 */
K = K0 + 1 + MAX(0, MPFR_GET_EXP(r)) / 2;
/* since K0 >= 0, if EXP(r) < 0, then K >= 1, thus EXP(r) - 2K <= -3;
otherwise if EXP(r) >= 0, then K >= 1/2 + EXP(r)/2, thus
EXP(r) - 2K <= -1 */
MPFR_SET_EXP (r, MPFR_GET_EXP (r) - 2 * K); /* Can't overflow! */
/* s <- 1 - r/2! + ... + (-1)^l r^l/(2l)! */
l = mpfr_cos2_aux (s, r);
/* l is the error bound in ulps on s */
MPFR_SET_ONE (r);
for (k = 0; k < K; k++)
{
mpfr_sqr (s, s, MPFR_RNDU); /* err <= 2*olderr */
MPFR_SET_EXP (s, MPFR_GET_EXP (s) + 1); /* Can't overflow */
mpfr_sub (s, s, r, MPFR_RNDN); /* err <= 4*olderr */
if (MPFR_IS_ZERO(s))
goto ziv_next;
MPFR_ASSERTD (MPFR_GET_EXP (s) <= 1);
}
/* The absolute error on s is bounded by (2l+1/3)*2^(2K-m)
2l+1/3 <= 2l+1.
If |x| >= 4, we need to add 2^(2-m) for the argument reduction
by 2Pi: if K = 0, this amounts to add 4 to 2l+1/3, i.e., to add
2 to l; if K >= 1, this amounts to add 1 to 2*l+1/3. */
l = 2 * l + 1;
if (reduce)
l += (K == 0) ? 4 : 1;
k = MPFR_INT_CEIL_LOG2 (l) + 2*K;
/* now the error is bounded by 2^(k-m) = 2^(EXP(s)-err) */
exps = MPFR_GET_EXP (s);
if (MPFR_LIKELY (MPFR_CAN_ROUND (s, exps + m - k, precy, rnd_mode)))
break;
if (MPFR_UNLIKELY (exps == 1))
/* s = 1 or -1, and except x=0 which was already checked above,
cos(x) cannot be 1 or -1, so we can round if the error is less
than 2^(-precy) for directed rounding, or 2^(-precy-1) for rounding
to nearest. */
{
if (m > k && (m - k >= precy + (rnd_mode == MPFR_RNDN)))
{
/* If round to nearest or away, result is s = 1 or -1,
otherwise it is round(nexttoward (s, 0)). However in order to
have the inexact flag correctly set below, we set |s| to
1 - 2^(-m) in all cases. */
mpfr_nexttozero (s);
break;
}
}
if (exps < cancel)
{
m += cancel - exps;
cancel = exps;
}
ziv_next:
MPFR_ZIV_NEXT (loop, m);
MPFR_GROUP_REPREC_2 (group, m, r, s);
if (reduce)
{
mpfr_set_prec (xr, m);
mpfr_set_prec (c, expx + m - 1);
}
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (y, s, rnd_mode);
MPFR_GROUP_CLEAR (group);
if (reduce)
{
mpfr_clear (xr);
mpfr_clear (c);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inexact, rnd_mode);
}
void init(ElementType &result) const {
mpfr_init2(&result, mPrecision);
}
static void
check_specials (void)
{
mpfr_t x, y;
mpfr_init2 (x, 123L);
mpfr_init2 (y, 123L);
mpfr_set_nan (x);
mpfr_sech (y, x, GMP_RNDN);
if (! mpfr_nan_p (y))
{
printf ("Error: sech(NaN) != NaN\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_sech (y, x, GMP_RNDN);
if (! (MPFR_IS_ZERO (y) && MPFR_SIGN (y) > 0))
{
printf ("Error: sech(+Inf) != +0\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_sech (y, x, GMP_RNDN);
if (! (MPFR_IS_ZERO (y) && MPFR_SIGN (y) > 0))
{
printf ("Error: sech(-Inf) != +0\n");
exit (1);
}
/* sec(+/-0) = 1 */
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_sech (y, x, GMP_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("Error: sech(+0) != 1\n");
exit (1);
}
mpfr_neg (x, x, GMP_RNDN);
mpfr_sech (y, x, GMP_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("Error: sech(-0) != 1\n");
exit (1);
}
/* check huge x */
mpfr_set_str (x, "8e8", 10, GMP_RNDN);
mpfr_sech (y, x, GMP_RNDN);
if (! (mpfr_zero_p (y) && MPFR_SIGN (y) > 0))
{
printf ("Error: sech(8e8) != +0\n");
exit (1);
}
mpfr_set_str (x, "-8e8", 10, GMP_RNDN);
mpfr_sech (y, x, GMP_RNDN);
if (! (mpfr_zero_p (y) && MPFR_SIGN (y) > 0))
{
printf ("Error: sech(-8e8) != +0\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
int
mpfr_eint (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd)
{
int inex;
mpfr_t tmp, ump;
mp_exp_t err, te;
mp_prec_t prec;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_ZIV_DECL (loop);
MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd),
("y[%#R]=%R inexact=%d", y, y, inex));
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
{
/* exp(NaN) = exp(-Inf) = NaN */
if (MPFR_IS_NAN (x) || (MPFR_IS_INF (x) && MPFR_IS_NEG(x)))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
/* eint(+inf) = +inf */
else if (MPFR_IS_INF (x))
{
MPFR_SET_INF(y);
MPFR_SET_POS(y);
MPFR_RET(0);
}
else /* eint(+/-0) = -Inf */
{
MPFR_SET_INF(y);
MPFR_SET_NEG(y);
MPFR_RET(0);
}
}
/* eint(x) = NaN for x < 0 */
if (MPFR_IS_NEG(x))
{
MPFR_SET_NAN (y);
MPFR_RET_NAN;
}
MPFR_SAVE_EXPO_MARK (expo);
/* Since eint(x) >= exp(x)/x, we have log2(eint(x)) >= (x-log(x))/log(2).
Let's compute k <= (x-log(x))/log(2) in a low precision. If k >= emax,
then log2(eint(x)) >= emax, and eint(x) >= 2^emax, i.e. it overflows. */
mpfr_init2 (tmp, 64);
mpfr_init2 (ump, 64);
mpfr_log (tmp, x, GMP_RNDU);
mpfr_sub (ump, x, tmp, GMP_RNDD);
mpfr_const_log2 (tmp, GMP_RNDU);
mpfr_div (ump, ump, tmp, GMP_RNDD);
/* FIXME: We really need mpfr_set_exp_t and mpfr_cmp_exp_t functions. */
MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX);
if (mpfr_cmp_ui (ump, __gmpfr_emax) >= 0)
{
mpfr_clear (tmp);
mpfr_clear (ump);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (y, rnd, 1);
}
/* Init stuff */
prec = MPFR_PREC (y) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (y)) + 6;
/* eint() has a root 0.37250741078136663446..., so if x is near,
already take more bits */
if (MPFR_GET_EXP(x) == -1) /* 1/4 <= x < 1/2 */
{
double d;
d = mpfr_get_d (x, GMP_RNDN) - 0.37250741078136663;
d = (d == 0.0) ? -53 : __gmpfr_ceil_log2 (d);
prec += -d;
}
mpfr_set_prec (tmp, prec);
mpfr_set_prec (ump, prec);
MPFR_ZIV_INIT (loop, prec); /* Initialize the ZivLoop controler */
for (;;) /* Infinite loop */
{
/* We need that the smallest value of k!/x^k is smaller than 2^(-p).
The minimum is obtained for x=k, and it is smaller than e*sqrt(x)/e^x
for x>=1. */
if (MPFR_GET_EXP (x) > 0 && mpfr_cmp_d (x, ((double) prec +
0.5 * (double) MPFR_GET_EXP (x)) * LOG2 + 1.0) > 0)
err = mpfr_eint_asympt (tmp, x);
else
{
err = mpfr_eint_aux (tmp, x); /* error <= 2^err ulp(tmp) */
te = MPFR_GET_EXP(tmp);
mpfr_const_euler (ump, GMP_RNDN); /* 0.577 -> EXP(ump)=0 */
mpfr_add (tmp, tmp, ump, GMP_RNDN);
/* error <= 1/2 + 1/2*2^(EXP(ump)-EXP(tmp)) + 2^(te-EXP(tmp)+err)
<= 1/2 + 2^(MAX(EXP(ump), te+err+1) - EXP(tmp))
<= 2^(MAX(0, 1 + MAX(EXP(ump), te+err+1) - EXP(tmp))) */
err = MAX(1, te + err + 2) - MPFR_GET_EXP(tmp);
err = MAX(0, err);
te = MPFR_GET_EXP(tmp);
mpfr_log (ump, x, GMP_RNDN);
mpfr_add (tmp, tmp, ump, GMP_RNDN);
/* same formula as above, except now EXP(ump) is not 0 */
err += te + 1;
if (MPFR_LIKELY (!MPFR_IS_ZERO (ump)))
err = MAX (MPFR_GET_EXP (ump), err);
err = MAX(0, err - MPFR_GET_EXP (tmp));
}
if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp, prec - err, MPFR_PREC (y), rnd)))
break;
MPFR_ZIV_NEXT (loop, prec); /* Increase used precision */
mpfr_set_prec (tmp, prec);
mpfr_set_prec (ump, prec);
}
MPFR_ZIV_FREE (loop); /* Free the ZivLoop Controler */
inex = mpfr_set (y, tmp, rnd); /* Set y to the computed value */
mpfr_clear (tmp);
mpfr_clear (ump);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (y, inex, rnd);
}
int
mpfr_log10 (mpfr_ptr r, mpfr_srcptr a, mp_rnd_t rnd_mode)
{
int inexact;
MPFR_SAVE_EXPO_DECL (expo);
/* If a is NaN, the result is NaN */
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (a)))
{
if (MPFR_IS_NAN (a))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
/* check for infinity before zero */
else if (MPFR_IS_INF (a))
{
if (MPFR_IS_NEG (a))
/* log10(-Inf) = NaN */
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
else /* log10(+Inf) = +Inf */
{
MPFR_SET_INF (r);
MPFR_SET_POS (r);
MPFR_RET (0); /* exact */
}
}
else /* a = 0 */
{
MPFR_ASSERTD (MPFR_IS_ZERO (a));
MPFR_SET_INF (r);
MPFR_SET_NEG (r);
MPFR_RET (0); /* log10(0) is an exact -infinity */
}
}
/* If a is negative, the result is NaN */
if (MPFR_UNLIKELY (MPFR_IS_NEG (a)))
{
MPFR_SET_NAN (r);
MPFR_RET_NAN;
}
/* If a is 1, the result is 0 */
if (mpfr_cmp_ui (a, 1) == 0)
{
MPFR_SET_ZERO (r);
MPFR_SET_POS (r);
MPFR_RET (0); /* result is exact */
}
MPFR_SAVE_EXPO_MARK (expo);
/* General case */
{
/* Declaration of the intermediary variable */
mpfr_t t, tt;
MPFR_ZIV_DECL (loop);
/* Declaration of the size variable */
mp_prec_t Ny = MPFR_PREC(r); /* Precision of output variable */
mp_prec_t Nt; /* Precision of the intermediary variable */
mp_exp_t err; /* Precision of error */
/* compute the precision of intermediary variable */
/* the optimal number of bits : see algorithms.tex */
Nt = Ny + 4 + MPFR_INT_CEIL_LOG2 (Ny);
/* initialise of intermediary variables */
mpfr_init2 (t, Nt);
mpfr_init2 (tt, Nt);
/* First computation of log10 */
MPFR_ZIV_INIT (loop, Nt);
for (;;)
{
/* compute log10 */
mpfr_set_ui (t, 10, GMP_RNDN); /* 10 */
mpfr_log (t, t, GMP_RNDD); /* log(10) */
mpfr_log (tt, a, GMP_RNDN); /* log(a) */
mpfr_div (t, tt, t, GMP_RNDN); /* log(a)/log(10) */
/* estimation of the error */
err = Nt - 4;
if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
break;
/* log10(10^n) is exact:
FIXME: Can we have 10^n exactly representable as a mpfr_t
but n can't fit an unsigned long? */
if (MPFR_IS_POS (t)
&& mpfr_integer_p (t) && mpfr_fits_ulong_p (t, GMP_RNDN)
&& !mpfr_ui_pow_ui (tt, 10, mpfr_get_ui (t, GMP_RNDN), GMP_RNDN)
&& mpfr_cmp (a, tt) == 0)
break;
/* actualisation of the precision */
MPFR_ZIV_NEXT (loop, Nt);
mpfr_set_prec (t, Nt);
mpfr_set_prec (tt, Nt);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (r, t, rnd_mode);
mpfr_clear (t);
mpfr_clear (tt);
}
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (r, inexact, rnd_mode);
}
void externalPlot(char *library, mpfr_t a, mpfr_t b, mp_prec_t samplingPrecision, int random, node *func, int mode, mp_prec_t prec, char *name, int type) {
void *descr;
void (*myFunction)(mpfr_t, mpfr_t);
char *error;
mpfr_t x_h,x,y,temp,perturb,ulp,min_value;
double xd, yd;
FILE *file;
gmp_randstate_t state;
char *gplotname;
char *dataname;
char *outputname;
gmp_randinit_default (state);
if(samplingPrecision > prec) {
sollyaFprintf(stderr, "Error: you must use a sampling precision lower than the current precision\n");
return;
}
descr = dlopen(library, RTLD_NOW);
if (descr==NULL) {
sollyaFprintf(stderr, "Error: the given library (%s) is not available (%s)!\n",library,dlerror());
return;
}
dlerror(); /* Clear any existing error */
myFunction = (void (*)(mpfr_t, mpfr_t)) dlsym(descr, "f");
if ((error = dlerror()) != NULL) {
sollyaFprintf(stderr, "Error: the function f cannot be found in library %s (%s)\n",library,error);
return;
}
if(name==NULL) {
gplotname = (char *)safeCalloc(13 + strlen(PACKAGE_NAME), sizeof(char));
sprintf(gplotname,"/tmp/%s-%04d.p",PACKAGE_NAME,fileNumber);
dataname = (char *)safeCalloc(15 + strlen(PACKAGE_NAME), sizeof(char));
sprintf(dataname,"/tmp/%s-%04d.dat",PACKAGE_NAME,fileNumber);
outputname = (char *)safeCalloc(1, sizeof(char));
fileNumber++;
if (fileNumber >= NUMBEROFFILES) fileNumber=0;
}
else {
gplotname = (char *)safeCalloc(strlen(name)+3,sizeof(char));
sprintf(gplotname,"%s.p",name);
dataname = (char *)safeCalloc(strlen(name)+5,sizeof(char));
sprintf(dataname,"%s.dat",name);
outputname = (char *)safeCalloc(strlen(name)+5,sizeof(char));
if ((type==PLOTPOSTSCRIPT) || (type==PLOTPOSTSCRIPTFILE)) sprintf(outputname,"%s.eps",name);
}
/* Beginning of the interesting part of the code */
file = fopen(gplotname, "w");
if (file == NULL) {
sollyaFprintf(stderr,"Error: the file %s requested by plot could not be opened for writing: ",gplotname);
sollyaFprintf(stderr,"\"%s\".\n",strerror(errno));
return;
}
sollyaFprintf(file, "# Gnuplot script generated by %s\n",PACKAGE_NAME);
if ((type==PLOTPOSTSCRIPT) || (type==PLOTPOSTSCRIPTFILE)) sollyaFprintf(file,"set terminal postscript eps color\nset out \"%s\"\n",outputname);
sollyaFprintf(file, "set xrange [%1.50e:%1.50e]\n", mpfr_get_d(a, GMP_RNDD),mpfr_get_d(b, GMP_RNDU));
sollyaFprintf(file, "plot \"%s\" using 1:2 with dots t \"\"\n",dataname);
fclose(file);
file = fopen(dataname, "w");
if (file == NULL) {
sollyaFprintf(stderr,"Error: the file %s requested by plot could not be opened for writing: ",dataname);
sollyaFprintf(stderr,"\"%s\".\n",strerror(errno));
return;
}
mpfr_init2(x_h,samplingPrecision);
mpfr_init2(perturb, prec);
mpfr_init2(x,prec);
mpfr_init2(y,prec);
mpfr_init2(temp,prec);
mpfr_init2(ulp,prec);
mpfr_init2(min_value,53);
mpfr_sub(min_value, b, a, GMP_RNDN);
mpfr_div_2ui(min_value, min_value, 12, GMP_RNDN);
mpfr_set(x_h,a,GMP_RNDD);
while(mpfr_less_p(x_h,b)) {
mpfr_set(x, x_h, GMP_RNDN); // exact
if (mpfr_zero_p(x_h)) {
mpfr_set(x_h, min_value, GMP_RNDU);
}
else {
if (mpfr_cmpabs(x_h, min_value) < 0) mpfr_set_d(x_h, 0., GMP_RNDN);
else mpfr_nextabove(x_h);
}
if(random) {
mpfr_sub(ulp, x_h, x, GMP_RNDN);
mpfr_urandomb(perturb, state);
mpfr_mul(perturb, perturb, ulp, GMP_RNDN);
mpfr_add(x, x, perturb, GMP_RNDN);
}
(*myFunction)(temp,x);
evaluateFaithful(y, func, x,prec);
mpfr_sub(temp, temp, y, GMP_RNDN);
if(mode==RELATIVE) mpfr_div(temp, temp, y, GMP_RNDN);
xd = mpfr_get_d(x, GMP_RNDN);
if (xd >= MAX_VALUE_GNUPLOT) xd = MAX_VALUE_GNUPLOT;
if (xd <= -MAX_VALUE_GNUPLOT) xd = -MAX_VALUE_GNUPLOT;
sollyaFprintf(file, "%1.50e",xd);
if (!mpfr_number_p(temp)) {
if (verbosity >= 2) {
changeToWarningMode();
sollyaPrintf("Information: function undefined or not evaluable in point %s = ",variablename);
printValue(&x);
sollyaPrintf("\nThis point will not be plotted.\n");
restoreMode();
}
}
yd = mpfr_get_d(temp, GMP_RNDN);
if (yd >= MAX_VALUE_GNUPLOT) yd = MAX_VALUE_GNUPLOT;
if (yd <= -MAX_VALUE_GNUPLOT) yd = -MAX_VALUE_GNUPLOT;
sollyaFprintf(file, "\t%1.50e\n", yd);
}
fclose(file);
/* End of the interesting part.... */
dlclose(descr);
mpfr_clear(x);
mpfr_clear(y);
mpfr_clear(x_h);
mpfr_clear(temp);
mpfr_clear(perturb);
mpfr_clear(ulp);
mpfr_clear(min_value);
if ((name==NULL) || (type==PLOTFILE)) {
if (fork()==0) {
daemon(1,1);
execlp("gnuplot", "gnuplot", "-persist", gplotname, NULL);
perror("An error occurred when calling gnuplot ");
exit(1);
}
else wait(NULL);
}
else { /* Case we have an output: no daemon */
if (fork()==0) {
execlp("gnuplot", "gnuplot", "-persist", gplotname, NULL);
perror("An error occurred when calling gnuplot ");
exit(1);
}
else {
wait(NULL);
if((type==PLOTPOSTSCRIPT)) {
remove(gplotname);
remove(dataname);
}
}
}
free(gplotname);
free(dataname);
free(outputname);
return;
}
static void
large_arg (void)
{
mpfr_t x, y;
unsigned int flags;
mpfr_init2 (x, 88);
mpfr_init2 (y, 98);
mpfr_set_si_2exp (x, -1, 173, MPFR_RNDN);
mpfr_clear_flags ();
mpfr_erfc (y, x, MPFR_RNDN);
flags = __gmpfr_flags;
if (mpfr_cmp_ui (y, 2) != 0)
{
printf ("mpfr_erfc failed for large x (1)\n");
exit (1);
}
if (flags != MPFR_FLAGS_INEXACT)
{
printf ("mpfr_erfc sets incorrect flags for large x (1)\n");
printf ("Expected %u, got %u\n",
(unsigned int) MPFR_FLAGS_INEXACT, flags);
exit (1);
}
mpfr_set_si_2exp (x, -1, mpfr_get_emax () - 3, MPFR_RNDN);
mpfr_clear_flags ();
mpfr_erfc (y, x, MPFR_RNDN);
flags = __gmpfr_flags;
if (mpfr_cmp_ui (y, 2) != 0)
{
printf ("mpfr_erfc failed for large x (1b)\n");
exit (1);
}
if (flags != MPFR_FLAGS_INEXACT)
{
printf ("mpfr_erfc sets incorrect flags for large x (1b)\n");
printf ("Expected %u, got %u\n",
(unsigned int) MPFR_FLAGS_INEXACT, flags);
exit (1);
}
mpfr_set_prec (x, 33);
mpfr_set_prec (y, 43);
mpfr_set_str_binary (x, "1.11000101010111011000111100101001e6");
mpfr_erfc (y, x, MPFR_RNDD);
mpfr_set_prec (x, 43);
mpfr_set_str_binary (x, "100010011100101100001101100101011101101E-18579");
if (mpfr_cmp (x, y) != 0)
{
printf ("mpfr_erfc failed for large x (2)\n");
exit (1);
}
mpfr_set_prec (y, 43);
mpfr_set_si_2exp (x, 1, 11, MPFR_RNDN);
mpfr_erfc (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.1100000100100010101111001111010010001000110E-6051113");
if (mpfr_cmp (x, y) != 0)
{
printf ("mpfr_erfc failed for large x (3)\n");
exit (1);
}
mpfr_set_prec (x, 75);
mpfr_set_prec (y, 85);
mpfr_set_str_binary (x, "0.111110111111010011101011001100001010011110101010011111010010111101010001011E15");
mpfr_erfc (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("mpfr_erfc failed for large x (3b)\n");
exit (1);
}
mpfr_set_prec (x, 2);
mpfr_set_prec (y, 21);
mpfr_set_str_binary (x, "-1.0e3");
mpfr_clear_flags ();
mpfr_erfc (y, x, MPFR_RNDZ);
flags = __gmpfr_flags;
mpfr_set_prec (x, 21);
mpfr_set_str_binary (x, "1.11111111111111111111");
if (mpfr_cmp (x, y) != 0)
{
printf ("mpfr_erfc failed for large x (4)\n");
exit (1);
}
if (flags != MPFR_FLAGS_INEXACT)
{
printf ("mpfr_erfc sets incorrect flags for large x (4)\n");
printf ("Expected %u, got %u\n",
(unsigned int) MPFR_FLAGS_INEXACT, flags);
exit (1);
}
mpfr_set_prec (x, 2);
mpfr_set_prec (y, 31);
mpfr_set_str_binary (x, "-1.0e3");
mpfr_clear_flags ();
mpfr_erfc (y, x, MPFR_RNDZ);
flags = __gmpfr_flags;
mpfr_set_prec (x, 31);
mpfr_set_str_binary (x, "1.111111111111111111111111111111");
if (mpfr_cmp (x, y) != 0)
{
printf ("mpfr_erfc failed for x=-8, prec=31 (5)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
if (flags != MPFR_FLAGS_INEXACT)
{
printf ("mpfr_erfc sets incorrect flags for large x (5)\n");
printf ("Expected %u, got %u\n",
(unsigned int) MPFR_FLAGS_INEXACT, flags);
exit (1);
}
/* Reported by Christopher Creutzig on 2007-07-10. */
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_si_2exp (x, 54563, -1, MPFR_RNDN);
mpfr_erfc (y, x, MPFR_RNDZ);
mpfr_set_ui (x, 0, MPFR_RNDN);
if (! mpfr_equal_p (y, x))
{
printf ("mpfr_erfc failed for x=27281.5, prec=53 (6)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
/* same test with rounding away from zero */
mpfr_set_si_2exp (x, 54563, -1, MPFR_RNDN);
mpfr_erfc (y, x, MPFR_RNDU);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_nextabove (x);
if (! mpfr_equal_p (y, x))
{
printf ("mpfr_erfc failed for x=27281.5, prec=53 (7)\n");
printf ("expected "); mpfr_dump (x);
printf ("got "); mpfr_dump (y);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
/*Wrapper to get directly the coeffs in the Chebyshev basis
from a polynomial in the monomial basis given by a *node
We return in n = deg(f)+1;
*/
void getChebCoeffsFromPolynomial(sollya_mpfi_t**coeffs, int *n, node *f, sollya_mpfi_t x, mp_prec_t prec){
sollya_mpfi_t z1, z2, ui, vi;
node **coefficients;
int d,i;
sollya_mpfi_t *p, *c;
mpfr_t u,v;
if (isPolynomial(f) ){
getCoefficients(&d, &coefficients, f);
*n=d+1;
*coeffs= (sollya_mpfi_t *)safeMalloc((d+1)*sizeof(sollya_mpfi_t));
p=safeMalloc((d+1)*sizeof(sollya_mpfi_t));
c=safeMalloc((d+1)*sizeof(sollya_mpfi_t));
for (i=0;i<d+1;i++){
sollya_mpfi_init2((*coeffs)[i],prec);
sollya_mpfi_init2(p[i],prec);
sollya_mpfi_init2(c[i],prec);
if (coefficients[i]!= NULL) mpfi_set_node(p[i],coefficients[i], prec);
else sollya_mpfi_set_ui(p[i],0);
}
for (i=0;i<d+1;i++) {
if (coefficients[i] != NULL)
free_memory(coefficients[i]);
}
safeFree(coefficients);
/*Here we have the coeffs of the polynomial in p, over the interval x=[a,b]*/
/*we need to compute the polynomial over [-1,1]*/
/*we make the change of variable: x= y*(b-a)/2 + (b+a)/2, hence for y \in [-1,1] we have x\in [a,b]*/
/* we compute P(x)=Q(y)*/
sollya_mpfi_init2(ui, prec);
sollya_mpfi_init2(vi, prec);
mpfr_init2(u, prec);
mpfr_init2(v, prec);
sollya_mpfi_init2(z1, prec);
sollya_mpfi_init2(z2, prec);
sollya_mpfi_get_left(u,x);
sollya_mpfi_get_right(v,x);
sollya_mpfi_set_fr(ui,u);
sollya_mpfi_set_fr(vi,v);
sollya_mpfi_add(z2,ui,vi);
sollya_mpfi_sub(z1,vi,ui);
sollya_mpfi_div_ui(z1,z1,2);
sollya_mpfi_div_ui(z2,z2,2);
getTranslatedPolyCoeffs(c, p, d+1, z1,z2);
getPolyCoeffsChebBasis(*coeffs, c, d+1);
/*cleaning*/
for (i=0;i<d+1;i++){
sollya_mpfi_clear(p[i]);
sollya_mpfi_clear(c[i]);
}
safeFree(p);
safeFree(c);
sollya_mpfi_clear(ui);
sollya_mpfi_clear(vi);
mpfr_clear(u);
mpfr_clear(v);
sollya_mpfi_clear(z1);
sollya_mpfi_clear(z2);
}
else{
printMessage(1,SOLLYA_MSG_ERROR_IN_CHEBYSHEVFORM_NOT_A_POLYNOMIAL,
"The given function is not a polynomial, no modification is made.\n");
}
}
/*Wrapper to get directly the coeffs in the monomial basis
from a polynomial in the Chebyshev basis, over a given interval x*/
void getCoeffsFromChebPolynomial(sollya_mpfi_t**coeffs, sollya_mpfi_t *chebCoeffs, int n, sollya_mpfi_t x){
sollya_mpfi_t z1, z2, ui, vi, temp;
int j,i;
sollya_mpfi_t *c;
mpfr_t u,v;
mpz_t *chebMatrix;
mp_prec_t prec;
prec = sollya_mpfi_get_prec(chebCoeffs[0]);
sollya_mpfi_init2(temp, prec);
chebMatrix= (mpz_t *)safeMalloc((n*n)*sizeof(mpz_t));
for (i=0;i<n*n;i++){
mpz_init2(chebMatrix[i], prec);
}
getChebPolyCoeffs(chebMatrix, n,prec);
*coeffs= (sollya_mpfi_t *)safeMalloc((n)*sizeof(sollya_mpfi_t));
c=(sollya_mpfi_t *)safeMalloc((n)*sizeof(sollya_mpfi_t));
for (i=0;i<n;i++){
sollya_mpfi_init2((*coeffs)[i],prec);
sollya_mpfi_init2(c[i],prec);
sollya_mpfi_set_ui(c[i],0);
}
for (j=0;j<n;j++){
for (i=j;i<n;i++){
mpfi_mul_z(temp, chebCoeffs[i], chebMatrix[i*n+j]);
sollya_mpfi_add(c[j], c[j], temp);
}
}
/*we have in c_i the values of the coefs of P(2/(b-a)x- (b+a)/(b-a)) = \sum c_i (2/(b-a)x- (b+a)/(b-a))^i*/
/*we need to the translation*/
/*we compute z1=2/(b-a); z2=-(b+a)/(b-a)*/
sollya_mpfi_init2(ui, prec);
sollya_mpfi_init2(vi, prec);
mpfr_init2(u, prec);
mpfr_init2(v, prec);
sollya_mpfi_init2(z1, prec);
sollya_mpfi_init2(z2, prec);
sollya_mpfi_get_left(u,x);
sollya_mpfi_get_right(v,x);
sollya_mpfi_set_fr(ui,u);
sollya_mpfi_set_fr(vi,v);
sollya_mpfi_sub(z2,vi,ui);
sollya_mpfi_ui_div(z1,2,z2);
sollya_mpfi_add(temp, ui, vi);
sollya_mpfi_div(z2, temp, z2);
sollya_mpfi_neg(z2, z2);
getTranslatedPolyCoeffs((*coeffs), c, n, z1,z2);
/*cleaning*/
sollya_mpfi_clear(z1);
sollya_mpfi_clear(z2);
sollya_mpfi_clear(ui);
sollya_mpfi_clear(vi);
sollya_mpfi_clear(temp);
mpfr_clear(u);
mpfr_clear(v);
for (i=0;i<n*n;i++){
mpz_clear(chebMatrix[i]);
}
safeFree(chebMatrix);
for (i=0;i<n;i++){
sollya_mpfi_clear(c[i]);
}
safeFree(c);
}
static void
test1 (void)
{
mpfr_t x, y;
mpfr_init2 (x, 32);
mpfr_init2 (y, 42);
mpfr_set_str_binary (x, "1.1111111101000111011010010010100e-1");
mpfr_zeta (y, x, MPFR_RNDN); /* shouldn't crash */
mpfr_set_prec (x, 40);
mpfr_set_prec (y, 50);
mpfr_set_str_binary (x, "1.001101001101000010011010110100110000101e-1");
mpfr_zeta (y, x, MPFR_RNDU);
mpfr_set_prec (x, 50);
mpfr_set_str_binary (x, "-0.11111100011100111111101111100011110111001111111111E1");
if (mpfr_cmp (x, y))
{
printf ("Error for input on 40 bits, output on 50 bits\n");
printf ("Expected "); mpfr_print_binary (x); puts ("");
printf ("Got "); mpfr_print_binary (y); puts ("");
mpfr_set_str_binary (x, "1.001101001101000010011010110100110000101e-1");
mpfr_zeta (y, x, MPFR_RNDU);
mpfr_print_binary (x); puts ("");
mpfr_print_binary (y); puts ("");
exit (1);
}
mpfr_set_prec (x, 2);
mpfr_set_prec (y, 55);
mpfr_set_str_binary (x, "0.11e3");
mpfr_zeta (y, x, MPFR_RNDN);
mpfr_set_prec (x, 55);
mpfr_set_str_binary (x, "0.1000001000111000010011000010011000000100100100100010010E1");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_zeta (1)\n");
printf ("Expected "); mpfr_print_binary (x); puts ("");
printf ("Got "); mpfr_print_binary (y); puts ("");
exit (1);
}
mpfr_set_prec (x, 3);
mpfr_set_prec (y, 47);
mpfr_set_str_binary (x, "0.111e4");
mpfr_zeta (y, x, MPFR_RNDN);
mpfr_set_prec (x, 47);
mpfr_set_str_binary (x, "1.0000000000000100000000111001001010111100101011");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_zeta (2)\n");
exit (1);
}
/* coverage test */
mpfr_set_prec (x, 7);
mpfr_set_str_binary (x, "1.000001");
mpfr_set_prec (y, 2);
mpfr_zeta (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 64) == 0);
/* another coverage test */
mpfr_set_prec (x, 24);
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_set_prec (y, 2);
mpfr_zeta (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui_2exp (y, 3, -1) == 0);
mpfr_set_nan (x);
mpfr_zeta (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (y));
mpfr_set_inf (x, 1);
mpfr_zeta (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 1) == 0);
mpfr_set_inf (x, -1);
mpfr_zeta (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (y));
mpfr_clear (x);
mpfr_clear (y);
}
void getChebyshevExtrema(sollya_mpfi_t *chebPoints, int n, sollya_mpfi_t x){
int i;
mpfr_t u, v;
sollya_mpfi_t ui, vi, temp1, temp2, mpfiPi, mpfiPiArg;
/*print("The chebyshev extremas are:");
};
for i from 1 to n-1 do{
chebExtremas[i-1]=(cos((i)*Pi/(n)))*(u-v)/2 + (u+v)/2;
};
*/
mp_prec_t prec;
prec = sollya_mpfi_get_prec(chebPoints[0]);
sollya_mpfi_init2(ui,prec);
sollya_mpfi_init2(vi, prec);
sollya_mpfi_init2(temp1, prec);
sollya_mpfi_init2(temp2, prec);
sollya_mpfi_init2(mpfiPi, prec);
sollya_mpfi_init2(mpfiPiArg, prec);
mpfr_init2(u, prec);
mpfr_init2(v, prec);
sollya_mpfi_get_left(u,x);
sollya_mpfi_get_right(v,x);
sollya_mpfi_set_fr(ui,u);
sollya_mpfi_set_fr(vi,v);
sollya_mpfi_sub(temp1, ui, vi);
sollya_mpfi_div_ui(temp1, temp1,2);
sollya_mpfi_add(temp2, ui, vi);
sollya_mpfi_div_ui(temp2, temp2,2);
sollya_mpfi_const_pi(mpfiPi);
sollya_mpfi_div_ui(mpfiPi,mpfiPi,n);
for (i=1;i<=n-1;i++){
sollya_mpfi_mul_ui(mpfiPiArg,mpfiPi,i);
sollya_mpfi_cos(chebPoints[i-1],mpfiPiArg);
sollya_mpfi_mul( chebPoints[i-1], chebPoints[i-1], temp1);
sollya_mpfi_add( chebPoints[i-1], chebPoints[i-1], temp2);
}
sollya_mpfi_clear(ui);
sollya_mpfi_clear(vi);
sollya_mpfi_clear(temp1);
sollya_mpfi_clear(temp2);
sollya_mpfi_clear(mpfiPi);
sollya_mpfi_clear(mpfiPiArg);
mpfr_clear(u);
mpfr_clear(v);
}
/* Usage: tzeta - generic tests
tzeta s prec rnd_mode - compute zeta(s) with precision 'prec'
and rounding mode 'mode' */
int
main (int argc, char *argv[])
{
mpfr_t s, y, z;
mpfr_prec_t prec;
mpfr_rnd_t rnd_mode;
int inex;
tests_start_mpfr ();
if (argc != 1 && argc != 4)
{
printf ("Usage: tzeta\n"
" or tzeta s prec rnd_mode\n");
exit (1);
}
if (argc == 4)
{
prec = atoi(argv[2]);
mpfr_init2 (s, prec);
mpfr_init2 (z, prec);
mpfr_set_str (s, argv[1], 10, MPFR_RNDN);
rnd_mode = (mpfr_rnd_t) atoi(argv[3]);
mpfr_zeta (z, s, rnd_mode);
mpfr_out_str (stdout, 10, 0, z, MPFR_RNDN);
printf ("\n");
mpfr_clear (s);
mpfr_clear (z);
return 0;
}
test1();
mpfr_init2 (s, MPFR_PREC_MIN);
mpfr_init2 (y, MPFR_PREC_MIN);
mpfr_init2 (z, MPFR_PREC_MIN);
/* the following seems to loop */
mpfr_set_prec (s, 6);
mpfr_set_prec (z, 6);
mpfr_set_str_binary (s, "1.10010e4");
mpfr_zeta (z, s, MPFR_RNDZ);
mpfr_set_prec (s, 53);
mpfr_set_prec (y, 53);
mpfr_set_prec (z, 53);
mpfr_set_ui (s, 1, MPFR_RNDN);
mpfr_clear_divby0();
mpfr_zeta (z, s, MPFR_RNDN);
if (!mpfr_inf_p (z) || MPFR_SIGN (z) < 0 || !mpfr_divby0_p())
{
printf ("Error in mpfr_zeta for s = 1 (should be +inf) with divby0 flag\n");
exit (1);
}
mpfr_set_str_binary (s, "0.1100011101110111111111111010000110010111001011001011");
mpfr_set_str_binary (y, "-0.11111101111011001001001111111000101010000100000100100E2");
mpfr_zeta (z, s, MPFR_RNDN);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (1,RNDN)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDZ);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (1,RNDZ)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDU);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (1,RNDU)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDD);
mpfr_nexttoinf (y);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (1,RNDD)\n");
exit (1);
}
mpfr_set_str_binary (s, "0.10001011010011100110010001100100001011000010011001011");
mpfr_set_str_binary (y, "-0.11010011010010101101110111011010011101111101111010110E1");
mpfr_zeta (z, s, MPFR_RNDN);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (2,RNDN)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDZ);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (2,RNDZ)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDU);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (2,RNDU)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDD);
mpfr_nexttoinf (y);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (2,RNDD)\n");
exit (1);
}
mpfr_set_str_binary (s, "0.1100111110100001111110111000110101111001011101000101");
mpfr_set_str_binary (y, "-0.10010111010110000111011111001101100001111011000001010E3");
mpfr_zeta (z, s, MPFR_RNDN);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (3,RNDN)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDD);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (3,RNDD)\n");
exit (1);
}
mpfr_nexttozero (y);
mpfr_zeta (z, s, MPFR_RNDZ);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (3,RNDZ)\n");
exit (1);
}
mpfr_zeta (z, s, MPFR_RNDU);
if (mpfr_cmp (z, y) != 0)
{
printf ("Error in mpfr_zeta (3,RNDU)\n");
exit (1);
}
mpfr_set_str (s, "-400000001", 10, MPFR_RNDZ);
mpfr_zeta (z, s, MPFR_RNDN);
if (!(mpfr_inf_p (z) && MPFR_SIGN(z) < 0))
{
printf ("Error in mpfr_zeta (-400000001)\n");
exit (1);
}
mpfr_set_str (s, "-400000003", 10, MPFR_RNDZ);
mpfr_zeta (z, s, MPFR_RNDN);
if (!(mpfr_inf_p (z) && MPFR_SIGN(z) > 0))
{
printf ("Error in mpfr_zeta (-400000003)\n");
exit (1);
}
mpfr_set_prec (s, 34);
mpfr_set_prec (z, 34);
mpfr_set_str_binary (s, "-1.111111100001011110000010001010000e-35");
mpfr_zeta (z, s, MPFR_RNDD);
mpfr_set_str_binary (s, "-1.111111111111111111111111111111111e-2");
if (mpfr_cmp (s, z))
{
printf ("Error in mpfr_zeta, prec=34, MPFR_RNDD\n");
mpfr_dump (z);
exit (1);
}
/* bug found by nightly tests on June 7, 2007 */
mpfr_set_prec (s, 23);
mpfr_set_prec (z, 25);
mpfr_set_str_binary (s, "-1.0110110110001000000000e-27");
mpfr_zeta (z, s, MPFR_RNDN);
mpfr_set_prec (s, 25);
mpfr_set_str_binary (s, "-1.111111111111111111111111e-2");
if (mpfr_cmp (s, z))
{
printf ("Error in mpfr_zeta, prec=25, MPFR_RNDN\n");
printf ("expected "); mpfr_dump (s);
printf ("got "); mpfr_dump (z);
exit (1);
}
/* bug reported by Kevin Rauch on 26 Oct 2007 */
mpfr_set_prec (s, 128);
mpfr_set_prec (z, 128);
mpfr_set_str_binary (s, "-0.1000000000000000000000000000000000000000000000000000000000000001E64");
inex = mpfr_zeta (z, s, MPFR_RNDN);
MPFR_ASSERTN (mpfr_inf_p (z) && MPFR_SIGN (z) < 0 && inex < 0);
inex = mpfr_zeta (z, s, MPFR_RNDU);
mpfr_set_inf (s, -1);
mpfr_nextabove (s);
MPFR_ASSERTN (mpfr_equal_p (z, s) && inex > 0);
mpfr_clear (s);
mpfr_clear (y);
mpfr_clear (z);
test_generic (2, 70, 5);
test2 ();
tests_end_mpfr ();
return 0;
}
int
mpfr_ui_pow_ui (mpfr_ptr x, unsigned long int y, unsigned long int n,
mpfr_rnd_t rnd)
{
mpfr_exp_t err;
unsigned long m;
mpfr_t res;
mpfr_prec_t prec;
int size_n;
int inexact;
MPFR_ZIV_DECL (loop);
MPFR_SAVE_EXPO_DECL (expo);
if (MPFR_UNLIKELY (n <= 1))
{
if (n == 1)
return mpfr_set_ui (x, y, rnd); /* y^1 = y */
else
return mpfr_set_ui (x, 1, rnd); /* y^0 = 1 for any y */
}
else if (MPFR_UNLIKELY (y <= 1))
{
if (y == 1)
return mpfr_set_ui (x, 1, rnd); /* 1^n = 1 for any n > 0 */
else
return mpfr_set_ui (x, 0, rnd); /* 0^n = 0 for any n > 0 */
}
for (size_n = 0, m = n; m; size_n++, m >>= 1);
MPFR_SAVE_EXPO_MARK (expo);
prec = MPFR_PREC (x) + 3 + size_n;
mpfr_init2 (res, prec);
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
int i = size_n;
inexact = mpfr_set_ui (res, y, MPFR_RNDU);
err = 1;
/* now 2^(i-1) <= n < 2^i: i=1+floor(log2(n)) */
for (i -= 2; i >= 0; i--)
{
inexact |= mpfr_mul (res, res, res, MPFR_RNDU);
err++;
if (n & (1UL << i))
inexact |= mpfr_mul_ui (res, res, y, MPFR_RNDU);
}
/* since the loop is executed floor(log2(n)) times,
we have err = 1+floor(log2(n)).
Since prec >= MPFR_PREC(x) + 4 + floor(log2(n)), prec > err */
err = prec - err;
if (MPFR_LIKELY (inexact == 0
|| MPFR_CAN_ROUND (res, err, MPFR_PREC (x), rnd)))
break;
/* Actualisation of the precision */
MPFR_ZIV_NEXT (loop, prec);
mpfr_set_prec (res, prec);
}
MPFR_ZIV_FREE (loop);
inexact = mpfr_set (x, res, rnd);
mpfr_clear (res);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (x, inexact, rnd);
}
int
main (void)
{
mpfr_t x, u;
mpf_t y, z;
mp_exp_t emax;
unsigned long k, pr;
int r, inexact;
MPFR_TEST_USE_RANDS ();
tests_start_mpfr ();
mpf_init (y);
mpf_init (z);
mpf_set_d (y, 0.0);
/* check prototype of mpfr_init_set_f */
mpfr_init_set_f (x, y, GMP_RNDN);
mpfr_set_prec (x, 100);
mpfr_set_f (x, y, GMP_RNDN);
mpf_random2 (y, 10, 0);
mpfr_set_f (x, y, (mp_rnd_t) RND_RAND());
/* bug found by Jean-Pierre Merlet */
mpfr_set_prec (x, 256);
mpf_set_prec (y, 256);
mpfr_init2 (u, 256);
mpfr_set_str (u,
"7.f10872b020c49ba5e353f7ced916872b020c49ba5e353f7ced916872b020c498@2",
16, GMP_RNDN);
mpf_set_str (y, "2033033E-3", 10); /* avoid 2033.033 which is
locale-sensitive */
mpfr_set_f (x, y, GMP_RNDN);
if (mpfr_cmp (x, u))
{
printf ("mpfr_set_f failed for y=2033033E-3\n");
exit (1);
}
mpf_set_str (y, "-2033033E-3", 10); /* avoid -2033.033 which is
locale-sensitive */
mpfr_set_f (x, y, GMP_RNDN);
mpfr_neg (u, u, GMP_RNDN);
if (mpfr_cmp (x, u))
{
printf ("mpfr_set_f failed for y=-2033033E-3\n");
exit (1);
}
mpf_set_prec (y, 300);
mpf_set_str (y, "1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111", -2);
mpf_mul_2exp (y, y, 600);
mpfr_set_prec (x, 300);
mpfr_set_f (x, y, GMP_RNDN);
if (mpfr_check (x) == 0)
{
printf ("Error in mpfr_set_f: corrupted result\n");
mpfr_dump (x);
exit (1);
}
MPFR_ASSERTN(mpfr_cmp_ui_2exp (x, 1, 901) == 0);
for (k = 1; k <= 100000; k++)
{
pr = 2 + (randlimb () & 255);
mpf_set_prec (z, pr);
mpf_random2 (z, z->_mp_prec, 0);
mpfr_set_prec (x, pr);
mpfr_set_f (x, z, (mp_rnd_t) 0);
}
/* Check for +0 */
mpfr_set_prec (x, 53);
mpf_set_prec (y, 53);
mpf_set_ui (y, 0);
for (r = 0 ; r < GMP_RND_MAX ; r++)
{
int i;
for (i = -1; i <= 1; i++)
{
if (i)
mpfr_set_si (x, i, GMP_RNDN);
inexact = mpfr_set_f (x, y, (mp_rnd_t) r);
if (!MPFR_IS_ZERO(x) || !MPFR_IS_POS(x) || inexact)
{
printf ("mpfr_set_f(x,0) failed for %s, i = %d\n",
mpfr_print_rnd_mode ((mp_rnd_t) r), i);
exit (1);
}
}
}
/* coverage test */
mpf_set_prec (y, 2);
mpfr_set_prec (x, 3 * mp_bits_per_limb);
mpf_set_ui (y, 1);
for (r = 0; r < mp_bits_per_limb; r++)
{
mpfr_random (x); /* to fill low limbs with random data */
inexact = mpfr_set_f (x, y, GMP_RNDN);
MPFR_ASSERTN(inexact == 0 && mpfr_cmp_ui_2exp (x, 1, r) == 0);
mpf_mul_2exp (y, y, 1);
}
mpf_set_ui (y, 1);
mpf_mul_2exp (y, y, ULONG_MAX);
mpfr_set_f (x, y, GMP_RNDN);
mpfr_set_ui (u, 1, GMP_RNDN);
mpfr_mul_2ui (u, u, ULONG_MAX, GMP_RNDN);
if (!mpfr_equal_p (x, u))
{
printf ("Error: mpfr_set_f (x, y, GMP_RNDN) for y = 2^ULONG_MAX\n");
exit (1);
}
emax = mpfr_get_emax ();
/* For mpf_mul_2exp, emax must fit in an unsigned long! */
if (emax >= 0 && emax <= ULONG_MAX)
{
mpf_set_ui (y, 1);
mpf_mul_2exp (y, y, emax);
mpfr_set_f (x, y, GMP_RNDN);
mpfr_set_ui_2exp (u, 1, emax, GMP_RNDN);
if (!mpfr_equal_p (x, u))
{
printf ("Error: mpfr_set_f (x, y, GMP_RNDN) for y = 2^emax\n");
exit (1);
}
}
/* For mpf_mul_2exp, emax - 1 must fit in an unsigned long! */
if (emax >= 1 && emax - 1 <= ULONG_MAX)
{
mpf_set_ui (y, 1);
mpf_mul_2exp (y, y, emax - 1);
mpfr_set_f (x, y, GMP_RNDN);
mpfr_set_ui_2exp (u, 1, emax - 1, GMP_RNDN);
if (!mpfr_equal_p (x, u))
{
printf ("Error: mpfr_set_f (x, y, GMP_RNDN) for y = 2^(emax-1)\n");
exit (1);
}
}
mpfr_clear (x);
mpfr_clear (u);
mpf_clear (y);
mpf_clear (z);
tests_end_mpfr ();
return 0;
}
static void
test_urandom (long nbtests, mpfr_prec_t prec, mpfr_rnd_t rnd, long bit_index,
int verbose)
{
mpfr_t x;
int *tab, size_tab, k, sh, xn;
double d, av = 0, var = 0, chi2 = 0, th;
mpfr_exp_t emin;
mp_size_t limb_index = 0;
mp_limb_t limb_mask = 0;
long count = 0;
int i;
int inex = 1;
size_tab = (nbtests >= 1000 ? nbtests / 50 : 20);
tab = (int *) calloc (size_tab, sizeof(int));
if (tab == NULL)
{
fprintf (stderr, "trandom: can't allocate memory in test_urandom\n");
exit (1);
}
mpfr_init2 (x, prec);
xn = 1 + (prec - 1) / mp_bits_per_limb;
sh = xn * mp_bits_per_limb - prec;
if (bit_index >= 0 && bit_index < prec)
{
/* compute the limb index and limb mask to fetch the bit #bit_index */
limb_index = (prec - bit_index) / mp_bits_per_limb;
i = 1 + bit_index - (bit_index / mp_bits_per_limb) * mp_bits_per_limb;
limb_mask = MPFR_LIMB_ONE << (mp_bits_per_limb - i);
}
for (k = 0; k < nbtests; k++)
{
i = mpfr_urandom (x, RANDS, rnd);
inex = (i != 0) && inex;
/* check that lower bits are zero */
if (MPFR_MANT(x)[0] & MPFR_LIMB_MASK(sh) && !MPFR_IS_ZERO (x))
{
printf ("Error: mpfr_urandom() returns invalid numbers:\n");
mpfr_dump (x);
exit (1);
}
/* check that the value is in [0,1] */
if (mpfr_cmp_ui (x, 0) < 0 || mpfr_cmp_ui (x, 1) > 0)
{
printf ("Error: mpfr_urandom() returns number outside [0, 1]:\n");
mpfr_dump (x);
exit (1);
}
d = mpfr_get_d1 (x); av += d; var += d*d;
i = (int)(size_tab * d);
if (d == 1.0) i --;
tab[i]++;
if (limb_mask && (MPFR_MANT (x)[limb_index] & limb_mask))
count ++;
}
if (inex == 0)
{
/* one call in the loop pretended to return an exact number! */
printf ("Error: mpfr_urandom() returns a zero ternary value.\n");
exit (1);
}
/* coverage test */
emin = mpfr_get_emin ();
for (k = 0; k < 5; k++)
{
set_emin (k+1);
inex = mpfr_urandom (x, RANDS, rnd);
if (( (rnd == MPFR_RNDZ || rnd == MPFR_RNDD)
&& (!MPFR_IS_ZERO (x) || inex != -1))
|| ((rnd == MPFR_RNDU || rnd == MPFR_RNDA)
&& (mpfr_cmp_ui (x, 1 << k) != 0 || inex != +1))
|| (rnd == MPFR_RNDN
&& (k > 0 || mpfr_cmp_ui (x, 1 << k) != 0 || inex != +1)
&& (!MPFR_IS_ZERO (x) || inex != -1)))
{
printf ("Error: mpfr_urandom() does not handle correctly"
" a restricted exponent range.\nemin = %d\n"
"rounding mode: %s\nternary value: %d\nrandom value: ",
k+1, mpfr_print_rnd_mode (rnd), inex);
mpfr_dump (x);
exit (1);
}
}
set_emin (emin);
mpfr_clear (x);
if (!verbose)
{
free(tab);
return;
}
av /= nbtests;
var = (var / nbtests) - av * av;
th = (double)nbtests / size_tab;
printf ("Average = %.5f\nVariance = %.5f\n", av, var);
printf ("Repartition for urandom with rounding mode %s. "
"Each integer should be close to %d.\n",
mpfr_print_rnd_mode (rnd), (int)th);
for (k = 0; k < size_tab; k++)
{
chi2 += (tab[k] - th) * (tab[k] - th) / th;
printf("%d ", tab[k]);
if (((k+1) & 7) == 0)
printf("\n");
}
printf("\nChi2 statistics value (with %d degrees of freedom) : %.5f\n",
size_tab - 1, chi2);
if (limb_mask)
printf ("Bit #%ld is set %ld/%ld = %.1f %% of time\n",
bit_index, count, nbtests, count * 100.0 / nbtests);
puts ("");
free(tab);
return;
}
/*Get the derivative of a polynomial in Chebyshev basis, using classical formula*/
void getChebCoeffsDerivativePolynomial(sollya_mpfi_t*coeffs, sollya_mpfi_t *chebCoeffs, int n, sollya_mpfi_t x){
sollya_mpfi_t z1, z2, ui, vi;
int i;
sollya_mpfi_t *c;
mpfr_t u,v;
mp_prec_t prec;
prec =sollya_mpfi_get_prec(coeffs[0]);
c=(sollya_mpfi_t *)safeMalloc((n-1)*sizeof(sollya_mpfi_t));
for (i=0;i<n-1;i++){
sollya_mpfi_init2(c[i],prec);
sollya_mpfi_set_ui(c[i],0);
}
if(n>1) {
sollya_mpfi_mul_ui(c[n-2],chebCoeffs[n-1],2*(n-1));
}
if(n>2) {
sollya_mpfi_mul_ui(c[n-3],chebCoeffs[n-2],2*(n-2));
}
for (i=n-3;i>0;i--){
sollya_mpfi_mul_ui(c[i-1],chebCoeffs[i],2*i);
sollya_mpfi_add(c[i-1],c[i-1],c[i+1]);
}
sollya_mpfi_div_ui(c[0],c[0],2);
/*we have in c_i the values of the coefs of P'(y) = \sum c_i T_i(x)*/
/*we have to multiply by y'(x), which is z1=2/(b-a) */
/*we compute z1=2/(b-a)*/
sollya_mpfi_init2(ui, prec);
sollya_mpfi_init2(vi, prec);
mpfr_init2(u, prec);
mpfr_init2(v, prec);
sollya_mpfi_init2(z1, prec);
sollya_mpfi_init2(z2, prec);
sollya_mpfi_get_left(u,x);
sollya_mpfi_get_right(v,x);
sollya_mpfi_set_fr(ui,u);
sollya_mpfi_set_fr(vi,v);
sollya_mpfi_sub(z2,vi,ui);
sollya_mpfi_ui_div(z1,2,z2);
for (i=0;i<n-1;i++){
sollya_mpfi_mul(c[i], c[i],z1);
}
for (i=0;i<n-1;i++){
sollya_mpfi_set(coeffs[i], c[i]);
}
for (i=0;i<n-1;i++){
sollya_mpfi_clear(c[i]);
}
safeFree(c);
sollya_mpfi_clear(z1);
sollya_mpfi_clear(z2);
sollya_mpfi_clear(ui);
sollya_mpfi_clear(vi);
mpfr_clear(u);
mpfr_clear(v);
}
static void
check_max(void)
{
mpfr_t xx, yy, zz;
mp_exp_t emin;
mpfr_init2(xx, 4);
mpfr_init2(yy, 4);
mpfr_init2(zz, 4);
mpfr_set_str1 (xx, "0.68750");
mpfr_mul_2si(xx, xx, MPFR_EMAX_DEFAULT/2, GMP_RNDN);
mpfr_set_str1 (yy, "0.68750");
mpfr_mul_2si(yy, yy, MPFR_EMAX_DEFAULT - MPFR_EMAX_DEFAULT/2 + 1, GMP_RNDN);
mpfr_clear_flags();
mpfr_mul(zz, xx, yy, GMP_RNDU);
if (!(mpfr_overflow_p() && MPFR_IS_INF(zz)))
{
printf("check_max failed (should be an overflow)\n");
exit(1);
}
mpfr_clear_flags();
mpfr_mul(zz, xx, yy, GMP_RNDD);
if (mpfr_overflow_p() || MPFR_IS_INF(zz))
{
printf("check_max failed (should NOT be an overflow)\n");
exit(1);
}
mpfr_set_str1 (xx, "0.93750");
mpfr_mul_2si(xx, xx, MPFR_EMAX_DEFAULT, GMP_RNDN);
if (!(MPFR_IS_FP(xx) && MPFR_IS_FP(zz)))
{
printf("check_max failed (internal error)\n");
exit(1);
}
if (mpfr_cmp(xx, zz) != 0)
{
printf("check_max failed: got ");
mpfr_out_str(stdout, 2, 0, zz, GMP_RNDZ);
printf(" instead of ");
mpfr_out_str(stdout, 2, 0, xx, GMP_RNDZ);
printf("\n");
exit(1);
}
/* check underflow */
emin = mpfr_get_emin ();
set_emin (0);
mpfr_set_str_binary (xx, "0.1E0");
mpfr_set_str_binary (yy, "0.1E0");
mpfr_mul (zz, xx, yy, GMP_RNDN);
/* exact result is 0.1E-1, which should round to 0 */
MPFR_ASSERTN(mpfr_cmp_ui (zz, 0) == 0 && MPFR_IS_POS(zz));
set_emin (emin);
/* coverage test for mpfr_powerof2_raw */
emin = mpfr_get_emin ();
set_emin (0);
mpfr_set_prec (xx, mp_bits_per_limb + 1);
mpfr_set_str_binary (xx, "0.1E0");
mpfr_nextabove (xx);
mpfr_set_str_binary (yy, "0.1E0");
mpfr_mul (zz, xx, yy, GMP_RNDN);
/* exact result is just above 0.1E-1, which should round to minfloat */
MPFR_ASSERTN(mpfr_cmp (zz, yy) == 0);
set_emin (emin);
mpfr_clear(xx);
mpfr_clear(yy);
mpfr_clear(zz);
}
/*Computes the antiderivative of a polynomial in Chebyshev basis.
NOTE: the constant coefficient is set to zero, but it should be viewed as a constant*/
void getChebCoeffsIntegrationPolynomial(sollya_mpfi_t*coeffs, sollya_mpfi_t *chebCoeffs, int n, sollya_mpfi_t x){
sollya_mpfi_t z1, z2, ui, vi;
int i;
sollya_mpfi_t *c;
mpfr_t u,v;
mp_prec_t prec;
prec = sollya_mpfi_get_prec(coeffs[0]);
c=(sollya_mpfi_t *)safeMalloc((n+1)*sizeof(sollya_mpfi_t));
for (i=0;i<n+1;i++){
sollya_mpfi_init2(c[i],prec);
sollya_mpfi_set_ui(c[i],0);
}
if(n>0){
sollya_mpfi_div_ui(c[1],chebCoeffs[2],2);
sollya_mpfi_sub(c[1],chebCoeffs[0], c[1]);
}
for (i=2;i<n-1;i++){
sollya_mpfi_sub(c[i],chebCoeffs[i-1],chebCoeffs[i+1]);
sollya_mpfi_div_ui(c[i],c[i],2*i);
}
if(n>1){
sollya_mpfi_set(c[n-1],chebCoeffs[n-2]);
sollya_mpfi_div_ui(c[n-1],c[n-1],2*(n-1));
}
if(n>0){
sollya_mpfi_set(c[n],chebCoeffs[n-1]);
sollya_mpfi_div_ui(c[n],c[n],2*(n));
}
/*we have in c_i the values of the coefs of \int P(y) = \sum c_i T_i(x) (the constant of integration in c_0 is not computed*/
/*we have to multiply by 1/y'(x), which is z1=(b-a)/2 */
/*we compute z1=(b-a)/2*/
sollya_mpfi_init2(ui, prec);
sollya_mpfi_init2(vi, prec);
mpfr_init2(u, prec);
mpfr_init2(v, prec);
sollya_mpfi_init2(z1, prec);
sollya_mpfi_init2(z2, prec);
sollya_mpfi_get_left(u,x);
sollya_mpfi_get_right(v,x);
sollya_mpfi_set_fr(ui,u);
sollya_mpfi_set_fr(vi,v);
sollya_mpfi_sub(z2,vi,ui);
sollya_mpfi_div_ui(z1,z2,2);
for (i=1;i<n+1;i++){
sollya_mpfi_mul(c[i], c[i],z1);
}
for (i=0;i<n+1;i++){
sollya_mpfi_set(coeffs[i], c[i]);
}
for (i=0;i<n+1;i++){
sollya_mpfi_clear(c[i]);
}
safeFree(c);
sollya_mpfi_clear(z1);
sollya_mpfi_clear(z2);
sollya_mpfi_clear(ui);
sollya_mpfi_clear(vi);
mpfr_clear(u);
mpfr_clear(v);
}
static void
special_erf (void)
{
mpfr_t x, y;
int inex;
mpfr_init2 (x, 53);
mpfr_init2 (y, 53);
/* erf(NaN) = NaN */
mpfr_set_nan (x);
mpfr_erf (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("mpfr_erf failed for x=NaN\n");
exit (1);
}
/* erf(+Inf) = 1 */
mpfr_set_inf (x, 1);
mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("mpfr_erf failed for x=+Inf\n");
printf ("expected 1.0, got ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
exit (1);
}
/* erf(-Inf) = -1 */
mpfr_set_inf (x, -1);
mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_si (y, -1))
{
printf ("mpfr_erf failed for x=-Inf\n");
exit (1);
}
/* erf(+0) = +0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("mpfr_erf failed for x=+0\n");
exit (1);
}
/* erf(-0) = -0 */
mpfr_neg (x, x, MPFR_RNDN);
mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0)
{
printf ("mpfr_erf failed for x=-0\n");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
mpfr_set_str_binary (y, "0.11010111101110110011110100111010000010000100010001011");
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=1.0, rnd=MPFR_RNDN\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_str (x, "6.6", 10, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp_ui (x, 1))
{
printf ("mpfr_erf failed for x=6.6, rnd=MPFR_RNDN\n");
printf ("expected 1\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_str (x, "-6.6", 10, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp_si (x, -1))
{
printf ("mpfr_erf failed for x=-6.6, rnd=MPFR_RNDN\n");
printf ("expected -1\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_str (x, "6.6", 10, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDZ);
mpfr_set_str_binary (y, "0.11111111111111111111111111111111111111111111111111111");
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=6.6, rnd=MPFR_RNDZ\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_str (x, "4.5", 10, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
mpfr_set_str_binary (y, "0.1111111111111111111111111111111100100111110100011");
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=4.5, rnd=MPFR_RNDN\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 120);
mpfr_set_prec (y, 120);
mpfr_set_str_binary (x, "0.110100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011E3");
mpfr_erf (x, x, MPFR_RNDN);
mpfr_set_str_binary (y, "0.11111111111111111111111111111111111111111111111111111111111111111100111111000100111011111011010000110101111100011001101");
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=6.6, rnd=MPFR_RNDN\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
mpfr_set_prec (x, 8);
mpfr_set_prec (y, 8);
mpfr_set_ui (x, 50, MPFR_RNDN);
inex = mpfr_erf (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 1))
{
printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDN\n");
printf ("expected 1, got ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
exit (1);
}
if (inex <= 0)
{
printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDN: wrong ternary value\n"
"expected positive, got %d\n", inex);
exit (1);
}
inex = mpfr_erf (x, x, MPFR_RNDZ);
mpfr_nextbelow (y);
if (mpfr_cmp (x, y))
{
printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDZ\n");
printf ("expected ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
printf ("got ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\n");
exit (1);
}
if (inex >= 0)
{
printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDN: wrong ternary value\n"
"expected negative, got %d\n", inex);
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 32);
mpfr_set_str_binary (x, "0.1010100100111011001111100101E-1");
mpfr_set_str_binary (y, "0.10111000001110011010110001101011E-1");
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (1)\n");
exit (1);
}
mpfr_set_str_binary (x, "-0.10110011011010111110010001100001");
mpfr_set_str_binary (y, "-0.1010110110101011100010111000111");
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (2)\n");
mpfr_print_binary (x); printf ("\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110000111");
mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (3)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110000111");
mpfr_erf (x, x, MPFR_RNDZ);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (4)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110000111");
mpfr_erf (x, x, MPFR_RNDU);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (5)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110001000");
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (6)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110001000");
mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
mpfr_erf (x, x, MPFR_RNDZ);
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (7)\n");
exit (1);
}
mpfr_set_str_binary (x, "100.10001110011110100000110001000");
mpfr_erf (x, x, MPFR_RNDU);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (8)\n");
exit (1);
}
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDN);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (9)\n");
exit (1);
}
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDU);
if (mpfr_cmp_ui (x, 1))
{
printf ("Error: erf for prec=32 (10)\n");
exit (1);
}
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDZ);
mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (11)\n");
exit (1);
}
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_erf (x, x, MPFR_RNDD);
mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=32 (12)\n");
exit (1);
}
mpfr_set_prec (x, 43);
mpfr_set_prec (y, 64);
mpfr_set_str_binary (x, "-0.1101110110101111100101011101110101101001001e3");
mpfr_erf (y, x, MPFR_RNDU);
mpfr_set_prec (x, 64);
mpfr_set_str_binary (x, "-0.1111111111111111111111111111111111111111111111111111111111111111");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for prec=43,64 (13)\n");
exit (1);
}
/* worst cases */
mpfr_set_prec (x, 53);
mpfr_set_prec (y, 53);
mpfr_set_str_binary (x, "1.0000000000000000000000000000000000000110000000101101");
mpfr_erf (y, x, MPFR_RNDN);
mpfr_set_str_binary (x, "0.110101111011101100111101001110100000101011000011001");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for worst case (1)\n");
exit (1);
}
mpfr_set_str_binary (x, "1.0000000000000000000000000000011000111010101101011010");
mpfr_erf (y, x, MPFR_RNDU);
mpfr_set_str_binary (x, "0.11010111101110110011110100111100100111100011111000110");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for worst case (2a)\n");
exit (1);
}
mpfr_set_str_binary (x, "1.0000000000000000000000000000011000111010101101011010");
mpfr_erf (y, x, MPFR_RNDD);
mpfr_set_str_binary (x, "0.11010111101110110011110100111100100111100011111000101");
if (mpfr_cmp (x, y))
{
printf ("Error: erf for worst case (2b)\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
/* This function computes an interval bound for a polynomial in cheb basis.
by using Clenshaw's method --
The n coefficients are given in coeffs.*/
void evaluateChebPolynomialClenshaw(sollya_mpfi_t bound, int n, sollya_mpfi_t *coeffs, mpfi_t x,mpfi_t x0){
int i;
sollya_mpfi_t z, zz, z1,b0,b1;
mpfr_t a, b;
mp_prec_t prec;
prec = sollya_mpfi_get_prec(bound);
sollya_mpfi_init2(z, prec);
sollya_mpfi_init2(zz, prec);
sollya_mpfi_init2(z1, prec);
sollya_mpfi_init2(b0, prec);
sollya_mpfi_init2(b1, prec);
mpfr_init2(a, prec);
mpfr_init2(b, prec);
sollya_mpfi_get_right(b,x);
sollya_mpfi_get_left(a,x);
sollya_mpfi_set_fr(z1,b);
sollya_mpfi_sub_fr(z1,z1,a);
sollya_mpfi_inv(z1,z1);
sollya_mpfi_mul_ui(z,z1,2);
/*z=2/(b-a)*/
sollya_mpfi_set_fr(zz,b);
mpfi_add_fr(zz,zz,a);
sollya_mpfi_mul(zz,zz,z1);
/*zz=(b+a)/(b-a)*/
sollya_mpfi_mul(z,z,x0);
sollya_mpfi_sub(z,z,zz);
/*z=2/(b-a) * x0 - (b+a)/(b-a)*/
/*Do the clenshaw algo*/
/*b1:=[0.,0.];
b0:=[0.,0.];
for i from n to 2 by -1 do
bb:=(((2&*z)&*b0) &-b1) &+L[i];
b1:=b0;
b0:=bb;
end do;
bb:=((z&*b0) &-b1) &+L[1];
return bb;
*/
sollya_mpfi_set_ui(b0,0);
sollya_mpfi_set_ui(b1,0);
for(i=n-1;i>0; i--){
sollya_mpfi_mul(zz,z,b0);
sollya_mpfi_mul_ui(zz,zz,2);
sollya_mpfi_sub(zz,zz,b1);
sollya_mpfi_add(zz,zz,coeffs[i]);
sollya_mpfi_set(b1,b0);
sollya_mpfi_set(b0,zz);
}
sollya_mpfi_mul(zz,z,b0);
sollya_mpfi_sub(zz,zz,b1);
sollya_mpfi_add(zz,zz,coeffs[0]);
sollya_mpfi_set(bound, zz);
sollya_mpfi_clear(zz);
sollya_mpfi_clear(z);
sollya_mpfi_clear(z1);
sollya_mpfi_clear(b0);
sollya_mpfi_clear(b1);
mpfr_clear(b); mpfr_clear(a);
}
int
main (void)
{
mpfr_t a;
mp_limb_t *p, tmp;
mp_size_t s;
mpfr_prec_t pr;
int max;
tests_start_mpfr ();
for(pr = MPFR_PREC_MIN ; pr < 500 ; pr++)
{
mpfr_init2 (a, pr);
if (!mpfr_check(a)) ERROR("for init");
/* Check special cases */
MPFR_SET_NAN(a);
if (!mpfr_check(a)) ERROR("for nan");
MPFR_SET_POS(a);
MPFR_SET_INF(a);
if (!mpfr_check(a)) ERROR("for inf");
MPFR_SET_ZERO(a);
if (!mpfr_check(a)) ERROR("for zero");
/* Check var */
mpfr_set_ui(a, 2, MPFR_RNDN);
if (!mpfr_check(a)) ERROR("for set_ui");
mpfr_clear_overflow();
max = 1000; /* Allows max 2^1000 bits for the exponent */
while ((!mpfr_overflow_p()) && (max>0))
{
mpfr_mul(a, a, a, MPFR_RNDN);
if (!mpfr_check(a)) ERROR("for mul");
max--;
}
if (max==0) ERROR("can't reach overflow");
mpfr_set_ui(a, 2137, MPFR_RNDN);
/* Corrupt a and check for it */
MPFR_SIGN(a) = 2;
if (mpfr_check(a)) ERROR("sgn");
MPFR_SET_POS(a);
/* Check prec */
MPFR_PREC(a) = 1;
if (mpfr_check(a)) ERROR("precmin");
#if MPFR_VERSION_MAJOR < 3
/* Disable the test with MPFR >= 3 since mpfr_prec_t is now signed.
The "if" below is sufficient, but the MPFR_PREC_MAX+1 generates
a warning with GCC 4.4.4 even though the test is always false. */
if ((mpfr_prec_t) 0 - 1 > 0)
{
MPFR_PREC(a) = MPFR_PREC_MAX+1;
if (mpfr_check(a)) ERROR("precmax");
}
#endif
MPFR_PREC(a) = pr;
if (!mpfr_check(a)) ERROR("prec");
/* Check exponent */
MPFR_EXP(a) = MPFR_EXP_INVALID;
if (mpfr_check(a)) ERROR("exp invalid");
MPFR_EXP(a) = -MPFR_EXP_INVALID;
if (mpfr_check(a)) ERROR("-exp invalid");
MPFR_EXP(a) = 0;
if (!mpfr_check(a)) ERROR("exp 0");
/* Check Mantissa */
p = MPFR_MANT(a);
MPFR_MANT(a) = NULL;
if (mpfr_check(a)) ERROR("Mantissa Null Ptr");
MPFR_MANT(a) = p;
/* Check size */
s = MPFR_GET_ALLOC_SIZE(a);
MPFR_SET_ALLOC_SIZE(a, 0);
if (mpfr_check(a)) ERROR("0 size");
MPFR_SET_ALLOC_SIZE(a, MP_SIZE_T_MIN);
if (mpfr_check(a)) ERROR("min size");
MPFR_SET_ALLOC_SIZE(a, MPFR_LIMB_SIZE(a)-1 );
if (mpfr_check(a)) ERROR("size < prec");
MPFR_SET_ALLOC_SIZE(a, s);
/* Check normal form */
tmp = MPFR_MANT(a)[0];
if ((pr % GMP_NUMB_BITS) != 0)
{
MPFR_MANT(a)[0] = ~0;
if (mpfr_check(a)) ERROR("last bits non 0");
}
MPFR_MANT(a)[0] = tmp;
MPFR_MANT(a)[MPFR_LIMB_SIZE(a)-1] &= MPFR_LIMB_MASK (GMP_NUMB_BITS-1);
if (mpfr_check(a)) ERROR("last bits non 0");
/* Final */
mpfr_set_ui(a, 2137, MPFR_RNDN);
if (!mpfr_check(a)) ERROR("after last set");
mpfr_clear (a);
if (mpfr_check(a)) ERROR("after clear");
}
tests_end_mpfr ();
return 0;
}
static void
coverage_03032011 (void)
{
mpfr_t in, out, cmp;
int status;
int precIn;
char strData[(GMP_NUMB_BITS * 4)+256];
precIn = GMP_NUMB_BITS * 4;
mpfr_init2 (in, precIn);
mpfr_init2 (out, GMP_NUMB_BITS);
mpfr_init2 (cmp, GMP_NUMB_BITS);
/* cmp = "0.1EprecIn+2" */
/* The buffer size is sufficient, as precIn is small in practice. */
sprintf (strData, "0.1E%d", precIn+2);
mpfr_set_str_binary (cmp, strData);
/* in = "0.10...01EprecIn+2" use all (precIn) significand bits */
memset ((void *)strData, '0', precIn+2);
strData[1] = '.';
strData[2] = '1';
sprintf (&strData[precIn+1], "1E%d", precIn+2);
mpfr_set_str_binary (in, strData);
status = mpfr_rint (out, in, MPFR_RNDN);
if ((mpfr_cmp (out, cmp) != 0) || (status >= 0))
{
printf("mpfr_rint error :\n status is %d instead of 0\n", status);
printf(" out value is ");
mpfr_dump(out);
printf(" instead of ");
mpfr_dump(cmp);
exit (1);
}
mpfr_clear (cmp);
mpfr_clear (out);
mpfr_init2 (out, GMP_NUMB_BITS);
mpfr_init2 (cmp, GMP_NUMB_BITS);
/* cmp = "0.10...01EprecIn+2" use all (GMP_NUMB_BITS) significand bits */
strcpy (&strData[GMP_NUMB_BITS+1], &strData[precIn+1]);
mpfr_set_str_binary (cmp, strData);
(MPFR_MANT(in))[2] = MPFR_LIMB_HIGHBIT;
status = mpfr_rint (out, in, MPFR_RNDN);
if ((mpfr_cmp (out, cmp) != 0) || (status <= 0))
{
printf("mpfr_rint error :\n status is %d instead of 0\n", status);
printf(" out value is\n");
mpfr_dump(out);
printf(" instead of\n");
mpfr_dump(cmp);
exit (1);
}
mpfr_clear (cmp);
mpfr_clear (out);
mpfr_clear (in);
}
int
mpfr_asin (mpfr_ptr asin, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
mpfr_t xp;
mpfr_t arcs;
int signe, suplement;
mpfr_t tmp;
int Prec;
int prec_asin;
int good = 0;
int realprec;
int estimated_delta;
int compared;
/* Trivial cases */
if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
{
MPFR_SET_NAN(asin);
MPFR_RET_NAN;
}
/* Set x_p=|x| */
signe = MPFR_SIGN(x);
mpfr_init2 (xp, MPFR_PREC(x));
mpfr_set (xp, x, rnd_mode);
if (signe == -1)
MPFR_CHANGE_SIGN(xp);
compared = mpfr_cmp_ui (xp, 1);
if (compared > 0) /* asin(x) = NaN for |x| > 1 */
{
MPFR_SET_NAN(asin);
mpfr_clear (xp);
MPFR_RET_NAN;
}
if (compared == 0) /* x = 1 or x = -1 */
{
if (signe > 0) /* asin(+1) = Pi/2 */
mpfr_const_pi (asin, rnd_mode);
else /* asin(-1) = -Pi/2 */
{
if (rnd_mode == GMP_RNDU)
rnd_mode = GMP_RNDD;
else if (rnd_mode == GMP_RNDD)
rnd_mode = GMP_RNDU;
mpfr_const_pi (asin, rnd_mode);
mpfr_neg (asin, asin, rnd_mode);
}
MPFR_EXP(asin)--;
mpfr_clear (xp);
return 1; /* inexact */
}
if (MPFR_IS_ZERO(x)) /* x = 0 */
{
mpfr_set_ui (asin, 0, GMP_RNDN);
mpfr_clear(xp);
return 0; /* exact result */
}
prec_asin = MPFR_PREC(asin);
mpfr_ui_sub (xp, 1, xp, GMP_RNDD);
suplement = 2 - MPFR_EXP(xp);
#ifdef DEBUG
printf("suplement=%d\n", suplement);
#endif
realprec = prec_asin + 10;
while (!good)
{
estimated_delta = 1 + suplement;
Prec = realprec+estimated_delta;
/* Initialisation */
mpfr_init2 (tmp, Prec);
mpfr_init2 (arcs, Prec);
#ifdef DEBUG
printf("Prec=%d\n", Prec);
printf(" x=");
mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
printf ("\n");
#endif
mpfr_mul (tmp, x, x, GMP_RNDN);
#ifdef DEBUG
printf(" x^2=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_ui_sub (tmp, 1, tmp, GMP_RNDN);
#ifdef DEBUG
printf(" 1-x^2=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
printf("10: 1-x^2=");
mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_sqrt (tmp, tmp, GMP_RNDN);
#ifdef DEBUG
printf(" sqrt(1-x^2)=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
printf("10: sqrt(1-x^2)=");
mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_div (tmp, x, tmp, GMP_RNDN);
#ifdef DEBUG
printf("x/sqrt(1-x^2)=");
mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
printf ("\n");
#endif
mpfr_atan (arcs, tmp, GMP_RNDN);
#ifdef DEBUG
printf("atan(x/..x^2)=");
mpfr_out_str (stdout, 2, 0, arcs, GMP_RNDN);
printf ("\n");
#endif
if (mpfr_can_round (arcs, realprec, GMP_RNDN, rnd_mode, MPFR_PREC(asin)))
{
mpfr_set (asin, arcs, rnd_mode);
#ifdef DEBUG
printf("asin =");
mpfr_out_str (stdout, 2, prec_asin, asin, GMP_RNDN);
printf ("\n");
#endif
good = 1;
}
else
{
realprec += _mpfr_ceil_log2 ((double) realprec);
#ifdef DEBUG
printf("RETRY\n");
#endif
}
mpfr_clear (tmp);
mpfr_clear (arcs);
}
mpfr_clear (xp);
return 1; /* inexact result */
}
int main (int argc, char *argv[]){
mpfr_t *lambda, *kappa;
char f_out_name[BUFSIZ];
int d,iters,n, k, nk,nf,na,nb;
double *lambdas, *kappas, *f,*a,*b;
param_file_type param[Nparam] =
{{"d:" , "%d", &d, NULL, sizeof(int)},
{"iter:" , "%d", &iters, NULL, sizeof(int)},
{"lambda:", "DATA_FILE", &lambdas, &n , sizeof(double)},
{"kappa:", "DATA_FILE", &kappas, &nk , sizeof(double)}, /*psi*/
{"h:", "DATA_FILE", &f, &nf , sizeof(double)}, /*odf*/
{"a:", "DATA_FILE", &a, &na , sizeof(double)}, /*pdf a*/
{"bc:", "DATA_FILE", &b, &nb , sizeof(double)}, /*pdf sqrt(b^2 + c^2)*/
{"res1:","%s ", &f_out_name,NULL, 0}};
FILE *f_param;
FILE *f_out;
if (argc<2) {
printf("Error! Missing parameter - parameter_file.\n");
printf("%s\n",argv[0]);
abort();
}
/* read parameter file */
f_param = check_fopen(argv[1],"r");
if (read_param_file(f_param,param,Nparam,argc==2)<Nparam){
/*printf("Some parameters not found!");*/
/*abort();*/
}
fclose(f_param);
/* precission & delta */
init_prec(d);
long int prec = d;
if (nk>0) { /* kappas given*/
mpfr_t C;
kappa = (mpfr_t*) malloc (nk*sizeof(mpfr_t));
for(k=0;k<nk;k++){
mpfr_init2(kappa[k],prec);
mpfr_init_set_d(kappa[k], kappas[k],prec);
}
mhyper(C, kappa, nk);
/* gmp_printf("C: %.*Fe \n ", 20, C); */
if (nf>0) /* eval odf values*/
{
eval_exp_Ah(C,f,nf);
f_out = check_fopen(f_out_name,"wb");
fwrite(f,sizeof(double),nf,f_out);
fclose(f_out);
}
if ( na > 0) {/* eval pdf values*/
/* testing BesselI[0,a]
mpfr_t in, out;
for(k=0;k<na;k++){
mpfr_init2(in, prec);
mpfr_set_d(in, a[k],prec);
mpfr_init2(out, prec);
mpfr_i0(out, in, prec);
mpfr_printf ("%.1028RNf\ndd", out);
a[k] = mpfr_get_d(out,prec);
}
f_out = check_fopen(f_out_name,"wb");
fwrite(a,sizeof(double),na,f_out);
fclose(f_out);
*/
eval_exp_besseli(a,b,C,na);
f_out = check_fopen(f_out_name,"wb");
fwrite(a,sizeof(double),na,f_out);
fclose(f_out);
}
if (nf == 0 && na == 0) { /* only return constant */
double CC = mpfr_get_d(C,prec);
f_out = check_fopen(f_out_name,"wb");
fwrite(&CC,sizeof(double),1,f_out);
fclose(f_out);
}
} else { /* solve kappas */
/* copy input variables */
lambda = (mpfr_t*) malloc (n*sizeof(mpfr_t));
kappa = (mpfr_t*) malloc (n*sizeof(mpfr_t));
for(k=0;k<n;k++){
mpfr_init_set_ui(kappa[k],0,prec);
mpfr_init_set_d(lambda[k],lambdas[k],prec);
}
if(iters>0){
/* check input */
mpfr_t tmp;
mpfr_init(tmp);
mpfr_set_d(tmp,0,prec);
for(k=0;k<n;k++){
mpfr_add(tmp,tmp,lambda[k],prec);
}
mpfr_ui_sub(tmp,1,tmp,prec);
mpfr_div_ui(tmp,tmp,n,prec);
for(k=0;k<n;k++){
mpfr_add(lambda[k],lambda[k],tmp,prec);
}
mpfr_init2(tmp,prec);
for(k=0;k<n;k++){
mpfr_add(tmp,tmp,lambda[k],prec);
}
mpfr_init2(tmp,prec);
if( mpfr_cmp(lambda[min_N(lambda,n)],tmp) < 0 ){
printf("not well formed! sum should be exactly 1 and no lambda negativ");
exit(0);
}
/* solve the problem */
newton(iters,kappa, lambda, n);
} else {
guessinitial(kappa, lambda, n);
}
for(k=0;k<n;k++){
lambdas[k] = mpfr_get_d(kappa[k],GMP_RNDN); /* something wents wront in matlab for 473.66316276431799;*/
/* % bug: lambda= [0.97 0.01 0.001];*/
}
f_out = check_fopen(f_out_name,"wb");
fwrite(lambdas,sizeof(double),n,f_out);
fclose(f_out);
free_N(lambda,n);
free_N(kappa,n);
}
return EXIT_SUCCESS;
}
int
main (void)
{
mpfr_t x;
mpfr_exp_t emax;
tests_start_mpfr ();
mpfr_init (x);
mpfr_set_nan (x);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x));
mpfr_set_inf (x, 1);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_inf (x, -1);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x));
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_NEG(x));
emax = mpfr_get_emax ();
set_emax (0);
mpfr_set_prec (x, 3);
mpfr_set_str_binary (x, "0.111");
mpfr_prec_round (x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
set_emax (emax);
mpfr_set_prec (x, mp_bits_per_limb + 2);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_nextbelow (x);
mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 1) == 0);
mpfr_set_prec (x, 3);
mpfr_set_ui (x, 5, MPFR_RNDN);
mpfr_prec_round (x, 2, MPFR_RNDN);
if (mpfr_cmp_ui(x, 4))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of 4\n");
exit (1);
}
/* check case when reallocation is needed */
mpfr_set_prec (x, 3);
mpfr_set_ui (x, 5, MPFR_RNDN); /* exact */
mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
if (mpfr_cmp_ui(x, 5))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of 5\n");
exit (1);
}
mpfr_clear(x);
mpfr_init2 (x, 3);
mpfr_set_si (x, -5, MPFR_RNDN); /* exact */
mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
if (mpfr_cmp_si(x, -5))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of -5\n");
exit (1);
}
/* check case when new precision needs less limbs */
mpfr_set_prec (x, mp_bits_per_limb + 1);
mpfr_set_ui (x, 5, MPFR_RNDN); /* exact */
mpfr_prec_round (x, 3, MPFR_RNDN); /* exact */
if (mpfr_cmp_ui(x, 5))
{
printf ("Error in tround: got ");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
printf (" instead of 5\n");
exit (1);
}
mpfr_clear(x);
tests_end_mpfr ();
return 0;
}
int
mpfr_yn (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
int inex;
unsigned long absn;
MPFR_SAVE_EXPO_DECL (expo);
MPFR_LOG_FUNC
(("n=%ld x[%Pu]=%.*Rg rnd=%d", n, mpfr_get_prec (z), mpfr_log_prec, z, r),
("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (res), mpfr_log_prec, res, inex));
absn = SAFE_ABS (unsigned long, n);
if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (z)))
{
if (MPFR_IS_NAN (z))
{
MPFR_SET_NAN (res); /* y(n,NaN) = NaN */
MPFR_RET_NAN;
}
/* y(n,z) tends to zero when z goes to +Inf, oscillating around
0. We choose to return +0 in that case. */
else if (MPFR_IS_INF (z))
{
if (MPFR_SIGN(z) > 0)
return mpfr_set_ui (res, 0, r);
else /* y(n,-Inf) = NaN */
{
MPFR_SET_NAN (res);
MPFR_RET_NAN;
}
}
else /* y(n,z) tends to -Inf for n >= 0 or n even, to +Inf otherwise,
when z goes to zero */
{
MPFR_SET_INF(res);
if (n >= 0 || ((unsigned long) n & 1) == 0)
MPFR_SET_NEG(res);
else
MPFR_SET_POS(res);
mpfr_set_divby0 ();
MPFR_RET(0);
}
}
/* for z < 0, y(n,z) is imaginary except when j(n,|z|) = 0, which we
assume does not happen for a rational z. */
if (MPFR_SIGN(z) < 0)
{
MPFR_SET_NAN (res);
MPFR_RET_NAN;
}
/* now z is not singular, and z > 0 */
MPFR_SAVE_EXPO_MARK (expo);
/* Deal with tiny arguments. We have:
y0(z) = 2 log(z)/Pi + 2 (euler - log(2))/Pi + O(log(z)*z^2), more
precisely for 0 <= z <= 1/2, with g(z) = 2/Pi + 2(euler-log(2))/Pi/log(z),
g(z) - 0.41*z^2 < y0(z)/log(z) < g(z)
thus since log(z) is negative:
g(z)*log(z) < y0(z) < (g(z) - z^2/2)*log(z)
and since |g(z)| >= 0.63 for 0 <= z <= 1/2, the relative error on
y0(z)/log(z) is bounded by 0.41*z^2/0.63 <= 0.66*z^2.
Note: we use both the main term in log(z) and the constant term, because
otherwise the relative error would be only in 1/log(|log(z)|).
*/
if (n == 0 && MPFR_EXP(z) < - (mpfr_exp_t) (MPFR_PREC(res) / 2))
{
mpfr_t l, h, t, logz;
mpfr_prec_t prec;
int ok, inex2;
prec = MPFR_PREC(res) + 10;
mpfr_init2 (l, prec);
mpfr_init2 (h, prec);
mpfr_init2 (t, prec);
mpfr_init2 (logz, prec);
/* first enclose log(z) + euler - log(2) = log(z/2) + euler */
mpfr_log (logz, z, MPFR_RNDD); /* lower bound of log(z) */
mpfr_set (h, logz, MPFR_RNDU); /* exact */
mpfr_nextabove (h); /* upper bound of log(z) */
mpfr_const_euler (t, MPFR_RNDD); /* lower bound of euler */
mpfr_add (l, logz, t, MPFR_RNDD); /* lower bound of log(z) + euler */
mpfr_nextabove (t); /* upper bound of euler */
mpfr_add (h, h, t, MPFR_RNDU); /* upper bound of log(z) + euler */
mpfr_const_log2 (t, MPFR_RNDU); /* upper bound of log(2) */
mpfr_sub (l, l, t, MPFR_RNDD); /* lower bound of log(z/2) + euler */
mpfr_nextbelow (t); /* lower bound of log(2) */
mpfr_sub (h, h, t, MPFR_RNDU); /* upper bound of log(z/2) + euler */
mpfr_const_pi (t, MPFR_RNDU); /* upper bound of Pi */
mpfr_div (l, l, t, MPFR_RNDD); /* lower bound of (log(z/2)+euler)/Pi */
mpfr_nextbelow (t); /* lower bound of Pi */
mpfr_div (h, h, t, MPFR_RNDD); /* upper bound of (log(z/2)+euler)/Pi */
mpfr_mul_2ui (l, l, 1, MPFR_RNDD); /* lower bound on g(z)*log(z) */
mpfr_mul_2ui (h, h, 1, MPFR_RNDU); /* upper bound on g(z)*log(z) */
/* we now have l <= g(z)*log(z) <= h, and we need to add -z^2/2*log(z)
to h */
mpfr_mul (t, z, z, MPFR_RNDU); /* upper bound on z^2 */
/* since logz is negative, a lower bound corresponds to an upper bound
for its absolute value */
mpfr_neg (t, t, MPFR_RNDD);
mpfr_div_2ui (t, t, 1, MPFR_RNDD);
mpfr_mul (t, t, logz, MPFR_RNDU); /* upper bound on z^2/2*log(z) */
mpfr_add (h, h, t, MPFR_RNDU);
inex = mpfr_prec_round (l, MPFR_PREC(res), r);
inex2 = mpfr_prec_round (h, MPFR_PREC(res), r);
/* we need h=l and inex=inex2 */
ok = (inex == inex2) && mpfr_equal_p (l, h);
if (ok)
mpfr_set (res, h, r); /* exact */
mpfr_clear (l);
mpfr_clear (h);
mpfr_clear (t);
mpfr_clear (logz);
if (ok)
goto end;
}
/* small argument check for y1(z) = -2/Pi/z + O(log(z)):
for 0 <= z <= 1, |y1(z) + 2/Pi/z| <= 0.25 */
if (n == 1 && MPFR_EXP(z) + 1 < - (mpfr_exp_t) MPFR_PREC(res))
{
mpfr_t y;
mpfr_prec_t prec;
mpfr_exp_t err1;
int ok;
MPFR_BLOCK_DECL (flags);
/* since 2/Pi > 0.5, and |y1(z)| >= |2/Pi/z|, if z <= 2^(-emax-1),
then |y1(z)| > 2^emax */
prec = MPFR_PREC(res) + 10;
mpfr_init2 (y, prec);
mpfr_const_pi (y, MPFR_RNDU); /* Pi*(1+u)^2, where here and below u
represents a quantity <= 1/2^prec */
mpfr_mul (y, y, z, MPFR_RNDU); /* Pi*z * (1+u)^4, upper bound */
MPFR_BLOCK (flags, mpfr_ui_div (y, 2, y, MPFR_RNDZ));
/* 2/Pi/z * (1+u)^6, lower bound, with possible overflow */
if (MPFR_OVERFLOW (flags))
{
mpfr_clear (y);
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_overflow (res, r, -1);
}
mpfr_neg (y, y, MPFR_RNDN);
/* (1+u)^6 can be written 1+7u [for another value of u], thus the
error on 2/Pi/z is less than 7ulp(y). The truncation error is less
than 1/4, thus if ulp(y)>=1/4, the total error is less than 8ulp(y),
otherwise it is less than 1/4+7/8 <= 2. */
if (MPFR_EXP(y) + 2 >= MPFR_PREC(y)) /* ulp(y) >= 1/4 */
err1 = 3;
else /* ulp(y) <= 1/8 */
err1 = (mpfr_exp_t) MPFR_PREC(y) - MPFR_EXP(y) + 1;
ok = MPFR_CAN_ROUND (y, prec - err1, MPFR_PREC(res), r);
if (ok)
inex = mpfr_set (res, y, r);
mpfr_clear (y);
if (ok)
goto end;
}
/* we can use the asymptotic expansion as soon as z > p log(2)/2,
but to get some margin we use it for z > p/2 */
if (mpfr_cmp_ui (z, MPFR_PREC(res) / 2 + 3) > 0)
{
inex = mpfr_yn_asympt (res, n, z, r);
if (inex != 0)
goto end;
}
/* General case */
{
mpfr_prec_t prec;
mpfr_exp_t err1, err2, err3;
mpfr_t y, s1, s2, s3;
MPFR_ZIV_DECL (loop);
mpfr_init (y);
mpfr_init (s1);
mpfr_init (s2);
mpfr_init (s3);
prec = MPFR_PREC(res) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (res)) + 13;
MPFR_ZIV_INIT (loop, prec);
for (;;)
{
mpfr_set_prec (y, prec);
mpfr_set_prec (s1, prec);
mpfr_set_prec (s2, prec);
mpfr_set_prec (s3, prec);
mpfr_mul (y, z, z, MPFR_RNDN);
mpfr_div_2ui (y, y, 2, MPFR_RNDN); /* z^2/4 */
/* store (z/2)^n temporarily in s2 */
mpfr_pow_ui (s2, z, absn, MPFR_RNDN);
mpfr_div_2si (s2, s2, absn, MPFR_RNDN);
/* compute S1 * (z/2)^(-n) */
if (n == 0)
{
mpfr_set_ui (s1, 0, MPFR_RNDN);
err1 = 0;
}
else
err1 = mpfr_yn_s1 (s1, y, absn - 1);
mpfr_div (s1, s1, s2, MPFR_RNDN); /* (z/2)^(-n) * S1 */
/* See algorithms.tex: the relative error on s1 is bounded by
(3n+3)*2^(e+1-prec). */
err1 = MPFR_INT_CEIL_LOG2 (3 * absn + 3) + err1 + 1;
/* rel_err(s1) <= 2^(err1-prec), thus err(s1) <= 2^err1 ulps */
/* compute (z/2)^n * S3 */
mpfr_neg (y, y, MPFR_RNDN); /* -z^2/4 */
err3 = mpfr_yn_s3 (s3, y, s2, absn); /* (z/2)^n * S3 */
/* the error on s3 is bounded by 2^err3 ulps */
/* add s1+s3 */
err1 += MPFR_EXP(s1);
mpfr_add (s1, s1, s3, MPFR_RNDN);
/* the error is bounded by 1/2 + 2^err1*2^(- EXP(s1))
+ 2^err3*2^(EXP(s3) - EXP(s1)) */
err3 += MPFR_EXP(s3);
err1 = (err3 > err1) ? err3 + 1 : err1 + 1;
err1 -= MPFR_EXP(s1);
err1 = (err1 >= 0) ? err1 + 1 : 1;
/* now the error on s1 is bounded by 2^err1*ulp(s1) */
/* compute S2 */
mpfr_div_2ui (s2, z, 1, MPFR_RNDN); /* z/2 */
mpfr_log (s2, s2, MPFR_RNDN); /* log(z/2) */
mpfr_const_euler (s3, MPFR_RNDN);
err2 = MPFR_EXP(s2) > MPFR_EXP(s3) ? MPFR_EXP(s2) : MPFR_EXP(s3);
mpfr_add (s2, s2, s3, MPFR_RNDN); /* log(z/2) + gamma */
err2 -= MPFR_EXP(s2);
mpfr_mul_2ui (s2, s2, 1, MPFR_RNDN); /* 2*(log(z/2) + gamma) */
mpfr_jn (s3, absn, z, MPFR_RNDN); /* Jn(z) */
mpfr_mul (s2, s2, s3, MPFR_RNDN); /* 2*(log(z/2) + gamma)*Jn(z) */
err2 += 4; /* the error on s2 is bounded by 2^err2 ulps, see
algorithms.tex */
/* add all three sums */
err1 += MPFR_EXP(s1); /* the error on s1 is bounded by 2^err1 */
err2 += MPFR_EXP(s2); /* the error on s2 is bounded by 2^err2 */
mpfr_sub (s2, s2, s1, MPFR_RNDN); /* s2 - (s1+s3) */
err2 = (err1 > err2) ? err1 + 1 : err2 + 1;
err2 -= MPFR_EXP(s2);
err2 = (err2 >= 0) ? err2 + 1 : 1;
/* now the error on s2 is bounded by 2^err2*ulp(s2) */
mpfr_const_pi (y, MPFR_RNDN); /* error bounded by 1 ulp */
mpfr_div (s2, s2, y, MPFR_RNDN); /* error bounded by
2^(err2+1)*ulp(s2) */
err2 ++;
if (MPFR_LIKELY (MPFR_CAN_ROUND (s2, prec - err2, MPFR_PREC(res), r)))
break;
MPFR_ZIV_NEXT (loop, prec);
}
MPFR_ZIV_FREE (loop);
/* Assume two's complement for the test n & 1 */
inex = mpfr_set4 (res, s2, r, n >= 0 || (n & 1) == 0 ?
MPFR_SIGN (s2) : - MPFR_SIGN (s2));
mpfr_clear (y);
mpfr_clear (s1);
mpfr_clear (s2);
mpfr_clear (s3);
}
end:
MPFR_SAVE_EXPO_FREE (expo);
return mpfr_check_range (res, inex, r);
}
static void
overflowed_sech0 (void)
{
mpfr_t x, y;
int emax, i, inex, rnd, err = 0;
mp_exp_t old_emax;
old_emax = mpfr_get_emax ();
mpfr_init2 (x, 8);
mpfr_init2 (y, 8);
for (emax = -1; emax <= 0; emax++)
{
mpfr_set_ui_2exp (y, 1, emax, GMP_RNDN);
mpfr_nextbelow (y);
set_emax (emax); /* 1 is not representable. */
/* and if emax < 0, 1 - eps is not representable either. */
for (i = -1; i <= 1; i++)
RND_LOOP (rnd)
{
mpfr_set_si_2exp (x, i, -512 * ABS (i), GMP_RNDN);
mpfr_clear_flags ();
inex = mpfr_sech (x, x, (mp_rnd_t) rnd);
if ((i == 0 || emax < 0 || rnd == GMP_RNDN || rnd == GMP_RNDU) &&
! mpfr_overflow_p ())
{
printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
" The overflow flag is not set.\n",
i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
err = 1;
}
if (rnd == GMP_RNDZ || rnd == GMP_RNDD)
{
if (inex >= 0)
{
printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
" The inexact value must be negative.\n",
i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
err = 1;
}
if (! mpfr_equal_p (x, y))
{
printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
" Got ", i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
mpfr_print_binary (x);
printf (" instead of 0.11111111E%d.\n", emax);
err = 1;
}
}
else
{
if (inex <= 0)
{
printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
" The inexact value must be positive.\n",
i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
err = 1;
}
if (! (mpfr_inf_p (x) && MPFR_SIGN (x) > 0))
{
printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
" Got ", i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
mpfr_print_binary (x);
printf (" instead of +Inf.\n");
err = 1;
}
}
}
set_emax (old_emax);
}
if (err)
exit (1);
mpfr_clear (x);
mpfr_clear (y);
}
/* compute in s an approximation of
S3 = c*sum((h(k)+h(n+k))*y^k/k!/(n+k)!,k=0..infinity)
where h(k) = 1 + 1/2 + ... + 1/k
k=0: h(n)
k=1: 1+h(n+1)
k=2: 3/2+h(n+2)
Returns e such that the error is bounded by 2^e ulp(s).
*/
static mpfr_exp_t
mpfr_yn_s3 (mpfr_ptr s, mpfr_srcptr y, mpfr_srcptr c, unsigned long n)
{
unsigned long k, zz;
mpfr_t t, u;
mpz_t p, q; /* p/q will store h(k)+h(n+k) */
mpfr_exp_t exps, expU;
zz = mpfr_get_ui (y, MPFR_RNDU); /* y = z^2/4 */
MPFR_ASSERTN (zz < ULONG_MAX - 2);
zz += 2; /* z^2 <= 2^zz */
mpz_init_set_ui (p, 0);
mpz_init_set_ui (q, 1);
/* initialize p/q to h(n) */
for (k = 1; k <= n; k++)
{
/* p/q + 1/k = (k*p+q)/(q*k) */
mpz_mul_ui (p, p, k);
mpz_add (p, p, q);
mpz_mul_ui (q, q, k);
}
mpfr_init2 (t, MPFR_PREC(s));
mpfr_init2 (u, MPFR_PREC(s));
mpfr_fac_ui (t, n, MPFR_RNDN);
mpfr_div (t, c, t, MPFR_RNDN); /* c/n! */
mpfr_mul_z (u, t, p, MPFR_RNDN);
mpfr_div_z (s, u, q, MPFR_RNDN);
exps = MPFR_EXP (s);
expU = exps;
for (k = 1; ;k ++)
{
/* update t */
mpfr_mul (t, t, y, MPFR_RNDN);
mpfr_div_ui (t, t, k, MPFR_RNDN);
mpfr_div_ui (t, t, n + k, MPFR_RNDN);
/* update p/q:
p/q + 1/k + 1/(n+k) = [p*k*(n+k) + q*(n+k) + q*k]/(q*k*(n+k)) */
mpz_mul_ui (p, p, k);
mpz_mul_ui (p, p, n + k);
mpz_addmul_ui (p, q, n + 2 * k);
mpz_mul_ui (q, q, k);
mpz_mul_ui (q, q, n + k);
mpfr_mul_z (u, t, p, MPFR_RNDN);
mpfr_div_z (u, u, q, MPFR_RNDN);
exps = MPFR_EXP (u);
if (exps > expU)
expU = exps;
mpfr_add (s, s, u, MPFR_RNDN);
exps = MPFR_EXP (s);
if (exps > expU)
expU = exps;
if (MPFR_EXP (u) + (mpfr_exp_t) MPFR_PREC (u) < MPFR_EXP (s) &&
zz / (2 * k) < k + n)
break;
}
mpfr_clear (t);
mpfr_clear (u);
mpz_clear (p);
mpz_clear (q);
exps = expU - MPFR_EXP (s);
/* the error is bounded by (6k^2+33/2k+11) 2^exps ulps
<= 8*(k+2)^2 2^exps ulps */
return 3 + 2 * MPFR_INT_CEIL_LOG2(k + 2) + exps;
}
static void
test_urandomb (long nbtests, mpfr_prec_t prec, int verbose)
{
mpfr_t x;
int *tab, size_tab, k, sh, xn;
double d, av = 0, var = 0, chi2 = 0, th;
mpfr_exp_t emin;
size_tab = (nbtests >= 1000 ? nbtests / 50 : 20);
tab = (int *) calloc (size_tab, sizeof(int));
if (tab == NULL)
{
fprintf (stderr, "trandom: can't allocate memory in test_urandomb\n");
exit (1);
}
mpfr_init2 (x, prec);
xn = 1 + (prec - 1) / mp_bits_per_limb;
sh = xn * mp_bits_per_limb - prec;
for (k = 0; k < nbtests; k++)
{
mpfr_urandomb (x, RANDS);
/* check that lower bits are zero */
if (MPFR_MANT(x)[0] & MPFR_LIMB_MASK(sh))
{
printf ("Error: mpfr_urandomb() returns invalid numbers:\n");
mpfr_print_binary (x); puts ("");
exit (1);
}
d = mpfr_get_d1 (x); av += d; var += d*d;
tab[(int)(size_tab * d)]++;
}
/* coverage test */
emin = mpfr_get_emin ();
set_emin (1); /* the generated number in [0,1[ is not in the exponent
range, except if it is zero */
k = mpfr_urandomb (x, RANDS);
if (MPFR_IS_ZERO(x) == 0 && (k == 0 || mpfr_nan_p (x) == 0))
{
printf ("Error in mpfr_urandomb, expected NaN, got ");
mpfr_dump (x);
exit (1);
}
set_emin (emin);
mpfr_clear (x);
if (!verbose)
{
free(tab);
return;
}
av /= nbtests;
var = (var / nbtests) - av * av;
th = (double)nbtests / size_tab;
printf("Average = %.5f\nVariance = %.5f\n", av, var);
printf("Repartition for urandomb. Each integer should be close to %d.\n",
(int)th);
for (k = 0; k < size_tab; k++)
{
chi2 += (tab[k] - th) * (tab[k] - th) / th;
printf("%d ", tab[k]);
if (((k+1) & 7) == 0)
printf("\n");
}
printf("\nChi2 statistics value (with %d degrees of freedom) : %.5f\n\n",
size_tab - 1, chi2);
free(tab);
return;
}
/* Input: s - a floating-point number >= 1/2.
rnd_mode - a rounding mode.
Assumes s is neither NaN nor Infinite.
Output: z - Zeta(s) rounded to the precision of z with direction rnd_mode
*/
static int
mpfr_zeta_pos (mpfr_t z, mpfr_srcptr s, mpfr_rnd_t rnd_mode)
{
mpfr_t b, c, z_pre, f, s1;
double beta, sd, dnep;
mpfr_t *tc1;
mpfr_prec_t precz, precs, d, dint;
int p, n, l, add;
int inex;
MPFR_GROUP_DECL (group);
MPFR_ZIV_DECL (loop);
MPFR_ASSERTD (MPFR_IS_POS (s) && MPFR_GET_EXP (s) >= 0);
precz = MPFR_PREC (z);
precs = MPFR_PREC (s);
/* Zeta(x) = 1+1/2^x+1/3^x+1/4^x+1/5^x+O(1/6^x)
so with 2^(EXP(x)-1) <= x < 2^EXP(x)
So for x > 2^3, k^x > k^8, so 2/k^x < 2/k^8
Zeta(x) = 1 + 1/2^x*(1+(2/3)^x+(2/4)^x+...)
= 1 + 1/2^x*(1+sum((2/k)^x,k=3..infinity))
<= 1 + 1/2^x*(1+sum((2/k)^8,k=3..infinity))
And sum((2/k)^8,k=3..infinity) = -257+128*Pi^8/4725 ~= 0.0438035
So Zeta(x) <= 1 + 1/2^x*2 for x >= 8
The error is < 2^(-x+1) <= 2^(-2^(EXP(x)-1)+1) */
if (MPFR_GET_EXP (s) > 3)
{
mpfr_exp_t err;
err = MPFR_GET_EXP (s) - 1;
if (err > (mpfr_exp_t) (sizeof (mpfr_exp_t)*CHAR_BIT-2))
err = MPFR_EMAX_MAX;
else
err = ((mpfr_exp_t)1) << err;
err = 1 - (-err+1); /* GET_EXP(one) - (-err+1) = err :) */
MPFR_FAST_COMPUTE_IF_SMALL_INPUT (z, __gmpfr_one, err, 0, 1,
rnd_mode, {});
}
d = precz + MPFR_INT_CEIL_LOG2(precz) + 10;
/* we want that s1 = s-1 is exact, i.e. we should have PREC(s1) >= EXP(s) */
dint = (mpfr_uexp_t) MPFR_GET_EXP (s);
mpfr_init2 (s1, MAX (precs, dint));
inex = mpfr_sub (s1, s, __gmpfr_one, MPFR_RNDN);
MPFR_ASSERTD (inex == 0);
/* case s=1 should have already been handled */
MPFR_ASSERTD (!MPFR_IS_ZERO (s1));
MPFR_GROUP_INIT_4 (group, MPFR_PREC_MIN, b, c, z_pre, f);
MPFR_ZIV_INIT (loop, d);
for (;;)
{
/* Principal loop: we compute, in z_pre,
an approximation of Zeta(s), that we send to can_round */
if (MPFR_GET_EXP (s1) <= -(mpfr_exp_t) ((mpfr_prec_t) (d-3)/2))
/* Branch 1: when s-1 is very small, one
uses the approximation Zeta(s)=1/(s-1)+gamma,
where gamma is Euler's constant */
{
dint = MAX (d + 3, precs);
MPFR_TRACE (printf ("branch 1\ninternal precision=%lu\n",
(unsigned long) dint));
MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f);
mpfr_div (z_pre, __gmpfr_one, s1, MPFR_RNDN);
mpfr_const_euler (f, MPFR_RNDN);
mpfr_add (z_pre, z_pre, f, MPFR_RNDN);
}
else /* Branch 2 */
{
size_t size;
MPFR_TRACE (printf ("branch 2\n"));
/* Computation of parameters n, p and working precision */
dnep = (double) d * LOG2;
sd = mpfr_get_d (s, MPFR_RNDN);
/* beta = dnep + 0.61 + sd * log (6.2832 / sd);
but a larger value is ok */
#define LOG6dot2832 1.83787940484160805532
beta = dnep + 0.61 + sd * (LOG6dot2832 - LOG2 *
__gmpfr_floor_log2 (sd));
if (beta <= 0.0)
{
p = 0;
/* n = 1 + (int) (exp ((dnep - LOG2) / sd)); */
n = 1 + (int) __gmpfr_ceil_exp2 ((d - 1.0) / sd);
}
else
{
p = 1 + (int) beta / 2;
n = 1 + (int) ((sd + 2.0 * (double) p - 1.0) / 6.2832);
}
MPFR_TRACE (printf ("\nn=%d\np=%d\n",n,p));
/* add = 4 + floor(1.5 * log(d) / log (2)).
We should have add >= 10, which is always fulfilled since
d = precz + 11 >= 12, thus ceil(log2(d)) >= 4 */
add = 4 + (3 * MPFR_INT_CEIL_LOG2 (d)) / 2;
MPFR_ASSERTD(add >= 10);
dint = d + add;
if (dint < precs)
dint = precs;
MPFR_TRACE (printf ("internal precision=%lu\n",
(unsigned long) dint));
size = (p + 1) * sizeof(mpfr_t);
tc1 = (mpfr_t*) (*__gmp_allocate_func) (size);
for (l=1; l<=p; l++)
mpfr_init2 (tc1[l], dint);
MPFR_GROUP_REPREC_4 (group, dint, b, c, z_pre, f);
MPFR_TRACE (printf ("precision of z = %lu\n",
(unsigned long) precz));
/* Computation of the coefficients c_k */
mpfr_zeta_c (p, tc1);
/* Computation of the 3 parts of the fonction Zeta. */
mpfr_zeta_part_a (z_pre, s, n);
mpfr_zeta_part_b (b, s, n, p, tc1);
/* s1 = s-1 is already computed above */
mpfr_div (c, __gmpfr_one, s1, MPFR_RNDN);
mpfr_ui_pow (f, n, s1, MPFR_RNDN);
mpfr_div (c, c, f, MPFR_RNDN);
MPFR_TRACE (MPFR_DUMP (c));
mpfr_add (z_pre, z_pre, c, MPFR_RNDN);
mpfr_add (z_pre, z_pre, b, MPFR_RNDN);
for (l=1; l<=p; l++)
mpfr_clear (tc1[l]);
(*__gmp_free_func) (tc1, size);
/* End branch 2 */
}
MPFR_TRACE (MPFR_DUMP (z_pre));
if (MPFR_LIKELY (MPFR_CAN_ROUND (z_pre, d-3, precz, rnd_mode)))
break;
MPFR_ZIV_NEXT (loop, d);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (z, z_pre, rnd_mode);
MPFR_GROUP_CLEAR (group);
mpfr_clear (s1);
return inex;
}
