static void
check_pow_si (void)
{
mpfr_t x;
mpfr_init (x);
mpfr_set_nan (x);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_nan_p (x));
mpfr_set_inf (x, 1);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x));
mpfr_set_inf (x, -1);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_NEG(x));
mpfr_set_inf (x, -1);
mpfr_pow_si (x, x, -2, GMP_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x));
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_neg (x, x, GMP_RNDN);
mpfr_pow_si (x, x, -1, GMP_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);
mpfr_set_ui (x, 0, GMP_RNDN);
mpfr_neg (x, x, GMP_RNDN);
mpfr_pow_si (x, x, -2, GMP_RNDN);
MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
mpfr_set_si (x, 2, GMP_RNDN);
mpfr_pow_si (x, x, LONG_MAX, GMP_RNDN); /* 2^LONG_MAX */
if (LONG_MAX > mpfr_get_emax () - 1) /* LONG_MAX + 1 > emax */
{
MPFR_ASSERTN (mpfr_inf_p (x));
}
else
{
MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 1, LONG_MAX));
}
mpfr_set_si (x, 2, GMP_RNDN);
mpfr_pow_si (x, x, LONG_MIN, GMP_RNDN); /* 2^LONG_MIN */
if (LONG_MIN + 1 < mpfr_get_emin ())
{
MPFR_ASSERTN (mpfr_zero_p (x));
}
else
{
MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 1, LONG_MIN));
}
mpfr_set_si (x, 2, GMP_RNDN);
mpfr_pow_si (x, x, LONG_MIN + 1, GMP_RNDN); /* 2^(LONG_MIN+1) */
if (mpfr_nan_p (x))
{
printf ("Error in pow_si(2, LONG_MIN+1): got NaN\n");
exit (1);
}
if (LONG_MIN + 2 < mpfr_get_emin ())
{
MPFR_ASSERTN (mpfr_zero_p (x));
}
else
{
MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 1, LONG_MIN + 1));
}
mpfr_set_si_2exp (x, 1, -1, GMP_RNDN); /* 0.5 */
mpfr_pow_si (x, x, LONG_MIN, GMP_RNDN); /* 2^(-LONG_MIN) */
if (LONG_MIN < 1 - mpfr_get_emax ()) /* 1 - LONG_MIN > emax */
{
MPFR_ASSERTN (mpfr_inf_p (x));
}
else
{
MPFR_ASSERTN (mpfr_cmp_si_2exp (x, 2, - (LONG_MIN + 1)));
}
mpfr_clear (x);
}
static void
special (void)
{
mpfr_t x, y;
unsigned xprec, yprec;
mpfr_init (x);
mpfr_init (y);
mpfr_set_prec (x, 32);
mpfr_set_prec (y, 32);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_div_ui (y, x, 3, MPFR_RNDN);
mpfr_set_prec (x, 100);
mpfr_set_prec (y, 100);
mpfr_urandomb (x, RANDS);
mpfr_div_ui (y, x, 123456, MPFR_RNDN);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_div_ui (y, x, 123456789, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0))
{
printf ("mpfr_div_ui gives non-zero for 0/ui\n");
exit (1);
}
/* bug found by Norbert Mueller, 21 Aug 2001 */
mpfr_set_prec (x, 110);
mpfr_set_prec (y, 60);
mpfr_set_str_binary (x, "0.110101110011111110011111001110011001110111000000111110001000111011000011E-44");
mpfr_div_ui (y, x, 17, MPFR_RNDN);
mpfr_set_str_binary (x, "0.11001010100101100011101110000001100001010110101001010011011E-48");
if (mpfr_cmp (x, y))
{
printf ("Error in x/17 for x=1/16!\n");
printf ("Expected ");
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf ("\nGot ");
mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf ("\n");
exit (1);
}
/* corner case */
mpfr_set_prec (x, 2 * mp_bits_per_limb);
mpfr_set_prec (y, 2);
mpfr_set_ui (x, 4, MPFR_RNDN);
mpfr_nextabove (x);
mpfr_div_ui (y, x, 2, MPFR_RNDN); /* exactly in the middle */
MPFR_ASSERTN(mpfr_cmp_ui (y, 2) == 0);
mpfr_set_prec (x, 3 * mp_bits_per_limb);
mpfr_set_prec (y, 2);
mpfr_set_ui (x, 2, MPFR_RNDN);
mpfr_nextabove (x);
mpfr_div_ui (y, x, 2, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp_ui (y, 1) == 0);
mpfr_set_prec (x, 3 * mp_bits_per_limb);
mpfr_set_prec (y, 2);
mpfr_set_si (x, -4, MPFR_RNDN);
mpfr_nextbelow (x);
mpfr_div_ui (y, x, 2, MPFR_RNDD);
MPFR_ASSERTN(mpfr_cmp_si (y, -3) == 0);
for (xprec = 53; xprec <= 128; xprec++)
{
mpfr_set_prec (x, xprec);
mpfr_set_str_binary (x, "0.1100100100001111110011111000000011011100001100110111E2");
for (yprec = 53; yprec <= 128; yprec++)
{
mpfr_set_prec (y, yprec);
mpfr_div_ui (y, x, 1, MPFR_RNDN);
if (mpfr_cmp(x,y))
{
printf ("division by 1.0 fails for xprec=%u, yprec=%u\n", xprec, yprec);
printf ("expected "); mpfr_print_binary (x); puts ("");
printf ("got "); mpfr_print_binary (y); puts ("");
exit (1);
}
}
}
/* Bug reported by Mark Dickinson, 6 Nov 2007 */
mpfr_set_si (x, 0, MPFR_RNDN);
mpfr_set_si (y, -1, MPFR_RNDN);
mpfr_div_ui (y, x, 4, MPFR_RNDN);
MPFR_ASSERTN(MPFR_IS_ZERO(y) && MPFR_IS_POS(y));
mpfr_clear (x);
mpfr_clear (y);
}
static void
check_random (FILE *fout, int nb_tests)
{
int i;
mpfr_t x;
mp_rnd_t rnd;
char flag[] =
{
'-',
'+',
' ',
'#',
'0', /* no ambiguity: first zeros are flag zero*/
'\''
};
char specifier[] =
{
'a',
'b',
'e',
'f',
'g'
};
mp_exp_t old_emin, old_emax;
old_emin = mpfr_get_emin ();
old_emax = mpfr_get_emax ();
mpfr_init (x);
for (i = 0; i < nb_tests; ++i)
{
int ret;
int j, jmax;
int spec, prec;
#define FMT_SIZE 13
char fmt[FMT_SIZE]; /* at most something like "%-+ #0'.*R*f" */
char *ptr = fmt;
tests_default_random (x, 256, MPFR_EMIN_MIN, MPFR_EMAX_MAX);
rnd = RND_RAND ();
spec = (int) (randlimb () % 5);
jmax = (spec == 3 || spec == 4) ? 6 : 5; /* ' flag only with %f or %g */
/* advantage small precision */
prec = (int) (randlimb () % ((randlimb () % 2) ? 10 : prec_max_printf));
if (spec == 3
&& (mpfr_get_exp (x) > prec_max_printf
|| mpfr_get_exp (x) < -prec_max_printf))
/* change style 'f' to style 'e' when number x is large */
--spec;
*ptr++ = '%';
for (j = 0; j < jmax; j++)
{
if (randlimb () % 3 == 0)
*ptr++ = flag[j];
}
*ptr++ = '.';
*ptr++ = '*';
*ptr++ = 'R';
*ptr++ = '*';
*ptr++ = specifier[spec];
*ptr = '\0';
MPFR_ASSERTD (ptr - fmt < FMT_SIZE);
mpfr_fprintf (fout, "mpfr_fprintf(fout, \"%s\", %d, %s, %Re)\n",
fmt, prec, mpfr_print_rnd_mode (rnd), x);
ret = mpfr_fprintf (fout, fmt, prec, rnd, x);
if (ret == -1)
{
if (spec == 3
&& (MPFR_GET_EXP (x) > INT_MAX || MPFR_GET_EXP (x) < -INT_MAX))
/* normal failure: x is too large to be output with full precision */
{
mpfr_fprintf (fout, "too large !");
}
else
{
mpfr_printf ("Error in mpfr_fprintf(fout, \"%s\", %d, %s, %Re)\n",
fmt, prec, mpfr_print_rnd_mode (rnd), x);
exit (1);
}
}
mpfr_fprintf (fout, "\n");
}
mpfr_set_emin (old_emin);
mpfr_set_emax (old_emax);
mpfr_clear (x);
}
static void
check_parse (void)
{
mpfr_t x;
char *s;
int res;
mpfr_init (x);
/* Invalid data */
mpfr_set_si (x, -1, MPFR_RNDN);
res = mpfr_strtofr (x, " invalid", NULL, 10, MPFR_RNDN);
if (MPFR_NOTZERO (x) || MPFR_IS_NEG (x))
{
printf ("Failed parsing ' invalid' (1)\n X=");
mpfr_dump (x);
exit (1);
}
MPFR_ASSERTN (res == 0);
mpfr_set_si (x, -1, MPFR_RNDN);
res = mpfr_strtofr (x, " invalid", &s, 0, MPFR_RNDN);
if (MPFR_NOTZERO (x) || MPFR_IS_NEG (x) || strcmp (s, " invalid"))
{
printf ("Failed parsing ' invalid' (2)\n S=%s\n X=", s);
mpfr_dump (x);
exit (1);
}
MPFR_ASSERTN (res == 0);
/* Check if it stops correctly */
mpfr_strtofr (x, "15*x", &s, 10, MPFR_RNDN);
if (mpfr_cmp_ui (x, 15) || strcmp (s, "*x"))
{
printf ("Failed parsing '15*x'\n S=%s\n X=", s);
mpfr_dump (x);
exit (1);
}
/* Check for leading spaces */
mpfr_strtofr (x, " 1.5E-10 *x^2", &s, 10, MPFR_RNDN);
if (mpfr_cmp_str1 (x, "1.5E-10") || strcmp (s, " *x^2"))
{
printf ("Failed parsing '1.5E-10*x^2'\n S=%s\n X=", s);
mpfr_dump (x);
exit (1);
}
/* Check for leading sign */
mpfr_strtofr (x, " +17.5E-42E ", &s, 10, MPFR_RNDN);
if (mpfr_cmp_str1 (x, "17.5E-42") || strcmp (s, "E "))
{
printf ("Failed parsing '+17.5E-42E '\n S=%s\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "-17.5E+42E\n", &s, 10, MPFR_RNDN);
if (mpfr_cmp_str1 (x, "-17.5E42") || strcmp (s, "E\n"))
{
printf ("Failed parsing '-17.5E+42\\n'\n S=%s\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
/* P form */
mpfr_strtofr (x, "0x42P17", &s, 16, MPFR_RNDN);
if (mpfr_cmp_str (x, "8650752", 10, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '0x42P17' (base = 16)\n S='%s'\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "-0X42p17", &s, 16, MPFR_RNDN);
if (mpfr_cmp_str (x, "-8650752", 10, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '-0x42p17' (base = 16)\n S='%s'\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "42p17", &s, 16, MPFR_RNDN);
if (mpfr_cmp_str (x, "8650752", 10, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '42p17' (base = 16)\n S='%s'\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "-42P17", &s, 16, MPFR_RNDN);
if (mpfr_cmp_str (x, "-8650752", 10, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '-42P17' (base = 16)\n S='%s'\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "0b1001P17", &s, 2, MPFR_RNDN);
if (mpfr_cmp_str (x, "1179648", 10, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '0b1001P17' (base = 2)\n S='%s'\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "-0B1001p17", &s, 2, MPFR_RNDN);
if (mpfr_cmp_str (x, "-1179648", 10, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '-0B1001p17' (base = 2)\n S='%s'\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "1001p17", &s, 2, MPFR_RNDN);
if (mpfr_cmp_str (x, "1179648", 10, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '1001p17' (base = 2)\n S='%s'\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "-1001P17", &s, 2, MPFR_RNDN);
if (mpfr_cmp_str (x, "-1179648", 10, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '-1001P17' (base = 2)\n S='%s'\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
/* Check for auto-detection of the base */
mpfr_strtofr (x, "+0x42P17", &s, 0, MPFR_RNDN);
if (mpfr_cmp_str (x, "42P17", 16, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '+0x42P17'\n S=%s\n X=", s);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "-42E17", &s, 0, MPFR_RNDN);
if (mpfr_cmp_str (x, "-42E17", 10, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '-42E17'\n S=%s\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "-42P17", &s, 0, MPFR_RNDN);
if (mpfr_cmp_str (x, "-42", 10, MPFR_RNDN) || strcmp (s, "P17"))
{
printf ("Failed parsing '-42P17' (base = 0)\n S='%s'\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, " [email protected]", &s, 0, MPFR_RNDN);
if (mpfr_cmp_str (x, "[email protected]", 2, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '[email protected]'\n S=%s\n X=", s);
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, " 0b0101.011P42", &s, 0, MPFR_RNDN);
if (mpfr_cmp_str (x, "[email protected]", 2, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '[email protected]'\n S=%s\n X=", s);
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "[email protected]", &s, 0, MPFR_RNDN);
if (mpfr_cmp_str (x, "[email protected]", 16, MPFR_RNDN) || *s != 0)
{
printf ("Failed parsing '+0x42P17'\n S=%s\n X=", s);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
/* Check for space inside the mantissa */
mpfr_strtofr (x, "+0x4 [email protected]", &s, 0, MPFR_RNDN);
if (mpfr_cmp_ui (x, 4) || strcmp(s," [email protected]"))
{
printf ("Failed parsing '+0x4 [email protected]'\n S=%s\n X=", s);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "+0x42 P17", &s, 0, MPFR_RNDN);
if (mpfr_cmp_ui (x, 0x42) || strcmp(s," P17"))
{
printf ("Failed parsing '+0x42 P17'\n S=%s\n X=", s);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
/* Space between mantissa and exponent */
mpfr_strtofr (x, " -0b0101P 17", &s, 0, MPFR_RNDN);
if (mpfr_cmp_si (x, -5) || strcmp(s,"P 17"))
{
printf ("Failed parsing '-0b0101P 17'\n S=%s\n X=", s);
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
/* Check for Invalid exponent. */
mpfr_strtofr (x, " -0b0101PF17", &s, 0, MPFR_RNDN);
if (mpfr_cmp_si (x, -5) || strcmp(s,"PF17"))
{
printf ("Failed parsing '-0b0101PF17'\n S=%s\n X=", s);
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
/* At least one digit in the mantissa. */
mpfr_strtofr (x, " .E10", &s, 0, MPFR_RNDN);
if (strcmp(s," .E10"))
{
printf ("Failed parsing ' .E10'\n S=%s\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
/* Check 2 '.': 2.3.4 */
mpfr_strtofr (x, "-1.2.3E4", &s, 0, MPFR_RNDN);
if (mpfr_cmp_str1 (x, "-1.2") || strcmp(s,".3E4"))
{
printf ("Failed parsing '-1.2.3E4'\n S=%s\n X=", s);
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
/* Check for 0x and 0b */
mpfr_strtofr (x, " 0xG", &s, 0, MPFR_RNDN);
if (mpfr_cmp_ui (x, 0) || strcmp(s,"xG"))
{
printf ("Failed parsing ' 0xG'\n S=%s\n X=", s);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, " 0b2", &s, 0, MPFR_RNDN);
if (mpfr_cmp_ui (x, 0) || strcmp(s,"b2"))
{
printf ("Failed parsing ' 0b2'\n S=%s\n X=", s);
mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, "[email protected]", &s, 0, MPFR_RNDN);
if (mpfr_cmp_si (x, -0x23) || strcmp(s,"Z33"))
{
printf ("Failed parsing '[email protected]'\n S=%s\n X=", s);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_strtofr (x, " 0x", &s, 0, MPFR_RNDN);
if (mpfr_cmp_ui (x, 0) || strcmp(s,"x"))
{
printf ("Failed parsing ' 0x'\n S=%s\n X=", s);
mpfr_out_str (stdout, 16, 0, x, MPFR_RNDN); putchar ('\n');
exit (1);
}
mpfr_clear (x);
}
int
main (int argc, char *argv[])
{
mpfr_t x, y;
mpfr_exp_t emin, emax;
tests_start_mpfr ();
test_set_underflow ();
test_set_overflow ();
check_default_rnd();
mpfr_init (x);
mpfr_init (y);
emin = mpfr_get_emin ();
emax = mpfr_get_emax ();
if (emin >= emax)
{
printf ("Error: emin >= emax\n");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_mul_2exp (x, x, 1024, MPFR_RNDN);
mpfr_set_double_range ();
mpfr_check_range (x, 0, MPFR_RNDN);
if (!mpfr_inf_p (x) || (mpfr_sgn(x) <= 0))
{
printf ("Error: 2^1024 rounded to nearest should give +Inf\n");
exit (1);
}
set_emax (1025);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_mul_2exp (x, x, 1024, MPFR_RNDN);
mpfr_set_double_range ();
mpfr_check_range (x, 0, MPFR_RNDD);
if (!mpfr_number_p (x))
{
printf ("Error: 2^1024 rounded down should give a normal number\n");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_mul_2exp (x, x, 1023, MPFR_RNDN);
mpfr_add (x, x, x, MPFR_RNDN);
if (!mpfr_inf_p (x) || (mpfr_sgn(x) <= 0))
{
printf ("Error: x+x rounded to nearest for x=2^1023 should give +Inf\n");
printf ("emax = %ld\n", mpfr_get_emax ());
printf ("got ");
mpfr_print_binary (x);
puts ("");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_mul_2exp (x, x, 1023, MPFR_RNDN);
mpfr_add (x, x, x, MPFR_RNDD);
if (!mpfr_number_p (x))
{
printf ("Error: x+x rounded down for x=2^1023 should give"
" a normal number\n");
exit (1);
}
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_div_2exp (x, x, 1022, MPFR_RNDN);
mpfr_set_str_binary (y, "1.1e-1022"); /* y = 3/2*x */
mpfr_sub (y, y, x, MPFR_RNDZ);
if (mpfr_cmp_ui (y, 0))
{
printf ("Error: y-x rounded to zero should give 0"
" for y=3/2*2^(-1022), x=2^(-1022)\n");
printf ("y=");
mpfr_print_binary (y);
puts ("");
exit (1);
}
set_emin (-1026);
mpfr_set_ui (x, 1, MPFR_RNDN);
mpfr_div_2exp (x, x, 1025, MPFR_RNDN);
mpfr_set_double_range ();
mpfr_check_range (x, 0, MPFR_RNDN);
if (!MPFR_IS_ZERO (x) )
{
printf ("Error: x rounded to nearest for x=2^-1024 should give Zero\n");
printf ("emin = %ld\n", mpfr_get_emin ());
printf ("got ");
mpfr_dump (x);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
set_emin (emin);
set_emax (emax);
check_emin_emax();
check_flags();
check_set_get_prec ();
check_powerof2 ();
check_set ();
tests_end_mpfr ();
return 0;
}
static void
normal (void)
{
int inexact;
mpfr_t x, y;
mpfr_init (x);
mpfr_init (y);
/* x1 = 2^-3 */
mpfr_set_str (x, "1p-3", 2, MPFR_RNDD);
mpfr_li2 (x, x, MPFR_RNDN);
if (mpfr_cmp_str (x, "0x1087a7a9e42141p-55", 16, MPFR_RNDN) != 0)
{
printf ("Error for li2(x1)\n");
exit (1);
}
/* check MPFR_FAST_COMPUTE_IF_SMALL_INPUT */
mpfr_set_prec (x, 2);
mpfr_set_prec (y, 20);
mpfr_set_ui_2exp (x, 1, -21, MPFR_RNDN);
mpfr_li2 (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp (y, x) == 0);
mpfr_set_si_2exp (x, -1, -21, MPFR_RNDN);
mpfr_li2 (y, x, MPFR_RNDN);
MPFR_ASSERTN(mpfr_cmp (y, x) == 0);
/* worst case */
/* x2 = 0x7F18EA6537E00E983196CDDC6EFAC57Fp-129
Li2(x2) = 2^-2 + 2^-6 + 2^-120 */
mpfr_set_prec (x, 128);
mpfr_set_str (x, "7F18EA6537E00E983196CDDC6EFAC57Fp-129", 16, MPFR_RNDN);
/* round to nearest mode and 4 bits of precision,
it should be rounded to 2^-2 + 2^-5 and */
mpfr_set_prec (y, 4);
inexact = mpfr_li2 (y, x, MPFR_RNDN);
if (inexact != 1 || mpfr_cmp_str (y, "0.1001p-1", 2, MPFR_RNDN) != 0)
{
printf ("Error for li2(x2, RNDN)\n");
exit (1);
}
/* round toward zero mode and 5 bits of precision,
it should be rounded to 2^-2 + 2^-6 */
mpfr_set_prec (y, 5);
inexact = mpfr_li2 (y, x, MPFR_RNDZ);
if (inexact != -1 || mpfr_cmp_str (y, "0.10001p-1", 2, MPFR_RNDN) != 0)
{
printf ("Error for li2(x2, RNDZ)\n");
exit (1);
}
/* round away from zero mode and 5 bits of precision,
it should be rounded to 2^-2 + 2^-5 */
inexact = mpfr_li2 (y, x, MPFR_RNDU);
if (inexact != 1 || mpfr_cmp_str (y, "0.10010p-1", 2, MPFR_RNDN) != 0)
{
printf ("Error for li2(x2, RNDU)\n");
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
void EigenLib_cplx_mpType_Print(const char * Title, mpCplxMatrixPtr xPtr)
{
int mRows = xPtr->rows();
int mCols = xPtr->cols();
cplx_mpType x;
printf ("\n");
printf (Title);
printf ("\n");
#if defined (Use_Mpfi)
mpfr_t real_fL;
mpfr_init(real_fL);
mpfr_t real_fR;
mpfr_init(real_fR);
mpfr_t imag_fL;
mpfr_init(imag_fL);
mpfr_t imag_fR;
mpfr_init(imag_fR);
#endif // defined (Use_Mpfi)
for (int i=1; i<=mRows; i++)
{
for (int j=1; j<=mCols; j++)
{
EigenLib_cplx_mpType_GetCoeff(&x, i-1, j-1, xPtr);
#if defined (Use_Float)
__mingw_printf("(%.8E,%.8E) ", real(x), imag(x));
#endif
#if defined (Use_Double)
__mingw_printf("(%.16E,%.16E) ", real(x), imag(x));
#endif
#if defined (Use_LongDouble)
__mingw_printf("(%.20LE,%.20LE) ", real(x), imag(x));
#endif
#if defined (Use_Mpfr)
mpfr_printf("(%.RE,%.RE) ", real(x).mpfr_ptr(), imag(x).mpfr_ptr());
#endif
#if defined (Use_Mpfi)
mpfi_get_left(real_fL, real(x).mpfi_ptr());
mpfi_get_right(real_fR, real(x).mpfi_ptr());
mpfi_get_left(imag_fL, imag(x).mpfi_ptr());
mpfi_get_right(imag_fR, imag(x).mpfi_ptr());
mpfr_printf("([%.RE,%.RE] [%.RE,%.RE]) ", real_fL, real_fR, imag_fL, imag_fR);
#endif
#if defined (Use_Mpdec)
char *s1 = mpd_to_sci(real(x).mpd_ptr(), 1);
char *s2 = mpd_to_sci(imag(x).mpd_ptr(), 1);
printf("(%s,%s)", s1, s2);
mpd_free(s1);
mpd_free(s2);
#endif
}
printf("\n");
}
#if defined (Use_Mpfi)
mpfr_clear(real_fL);
mpfr_clear(real_fR);
mpfr_clear(imag_fL);
mpfr_clear(imag_fR);
#endif // defined (Use_Mpfi)
}
int
mpc_div (mpc_ptr a, mpc_srcptr b, mpc_srcptr c, mpc_rnd_t rnd)
{
int ok_re = 0, ok_im = 0;
mpc_t res, c_conj;
mpfr_t q;
mpfr_prec_t prec;
int inex, inexact_prod, inexact_norm, inexact_re, inexact_im, loops = 0;
int underflow_norm, overflow_norm, underflow_prod, overflow_prod;
int underflow_re = 0, overflow_re = 0, underflow_im = 0, overflow_im = 0;
mpfr_rnd_t rnd_re = MPC_RND_RE (rnd), rnd_im = MPC_RND_IM (rnd);
int saved_underflow, saved_overflow;
int tmpsgn;
mpfr_exp_t e, emin, emax, emid; /* for scaling of exponents */
mpc_t b_scaled, c_scaled;
mpfr_t b_re, b_im, c_re, c_im;
/* According to the C standard G.3, there are three types of numbers: */
/* finite (both parts are usual real numbers; contains 0), infinite */
/* (at least one part is a real infinity) and all others; the latter */
/* are numbers containing a nan, but no infinity, and could reasonably */
/* be called nan. */
/* By G.5.1.4, infinite/finite=infinite; finite/infinite=0; */
/* all other divisions that are not finite/finite return nan+i*nan. */
/* Division by 0 could be handled by the following case of division by */
/* a real; we handle it separately instead. */
if (mpc_zero_p (c)) /* both Re(c) and Im(c) are zero */
return mpc_div_zero (a, b, c, rnd);
else if (mpc_inf_p (b) && mpc_fin_p (c)) /* either Re(b) or Im(b) is infinite
and both Re(c) and Im(c) are ordinary */
return mpc_div_inf_fin (a, b, c);
else if (mpc_fin_p (b) && mpc_inf_p (c))
return mpc_div_fin_inf (a, b, c);
else if (!mpc_fin_p (b) || !mpc_fin_p (c)) {
mpc_set_nan (a);
return MPC_INEX (0, 0);
}
else if (mpfr_zero_p(mpc_imagref(c)))
return mpc_div_real (a, b, c, rnd);
else if (mpfr_zero_p(mpc_realref(c)))
return mpc_div_imag (a, b, c, rnd);
prec = MPC_MAX_PREC(a);
mpc_init2 (res, 2);
mpfr_init (q);
/* compute scaling of exponents: none of Re(c) and Im(c) can be zero,
but one of Re(b) or Im(b) could be zero */
e = mpfr_get_exp (mpc_realref (c));
emin = emax = e;
e = mpfr_get_exp (mpc_imagref (c));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
if (!mpfr_zero_p (mpc_realref (b)))
{
e = mpfr_get_exp (mpc_realref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
if (!mpfr_zero_p (mpc_imagref (b)))
{
e = mpfr_get_exp (mpc_imagref (b));
if (e > emax)
emax = e;
else if (e < emin)
emin = e;
}
/* all input exponents are in [emin, emax] */
emid = emin / 2 + emax / 2;
/* scale the inputs */
b_re[0] = mpc_realref (b)[0];
if (!mpfr_zero_p (mpc_realref (b)))
MPFR_EXP(b_re) = MPFR_EXP(mpc_realref (b)) - emid;
b_im[0] = mpc_imagref (b)[0];
if (!mpfr_zero_p (mpc_imagref (b)))
MPFR_EXP(b_im) = MPFR_EXP(mpc_imagref (b)) - emid;
c_re[0] = mpc_realref (c)[0];
MPFR_EXP(c_re) = MPFR_EXP(mpc_realref (c)) - emid;
c_im[0] = mpc_imagref (c)[0];
MPFR_EXP(c_im) = MPFR_EXP(mpc_imagref (c)) - emid;
/* create the scaled inputs without allocating new memory */
mpc_realref (b_scaled)[0] = b_re[0];
mpc_imagref (b_scaled)[0] = b_im[0];
mpc_realref (c_scaled)[0] = c_re[0];
mpc_imagref (c_scaled)[0] = c_im[0];
/* create the conjugate of c in c_conj without allocating new memory */
mpc_realref (c_conj)[0] = mpc_realref (c_scaled)[0];
mpc_imagref (c_conj)[0] = mpc_imagref (c_scaled)[0];
MPFR_CHANGE_SIGN (mpc_imagref (c_conj));
/* save the underflow or overflow flags from MPFR */
saved_underflow = mpfr_underflow_p ();
saved_overflow = mpfr_overflow_p ();
do {
loops ++;
prec += loops <= 2 ? mpc_ceil_log2 (prec) + 5 : prec / 2;
mpc_set_prec (res, prec);
mpfr_set_prec (q, prec);
/* first compute norm(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_norm = mpc_norm (q, c_scaled, MPFR_RNDU);
underflow_norm = mpfr_underflow_p ();
overflow_norm = mpfr_overflow_p ();
if (underflow_norm)
mpfr_set_ui (q, 0ul, MPFR_RNDN);
/* to obtain divisions by 0 later on */
/* now compute b_scaled*conjugate(c_scaled) */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_prod = mpc_mul (res, b_scaled, c_conj, MPC_RNDZZ);
inexact_re = MPC_INEX_RE (inexact_prod);
inexact_im = MPC_INEX_IM (inexact_prod);
underflow_prod = mpfr_underflow_p ();
overflow_prod = mpfr_overflow_p ();
/* unfortunately, does not distinguish between under-/overflow
in real or imaginary parts
hopefully, the side-effects of mpc_mul do indeed raise the
mpfr exceptions */
if (overflow_prod) {
/* FIXME: in case overflow_norm is also true, the code below is wrong,
since the after division by the norm, we might end up with finite
real and/or imaginary parts. A workaround would be to scale the
inputs (in case the exponents are within the same range). */
int isinf = 0;
/* determine if the real part of res is the maximum or the minimum
representable number */
tmpsgn = mpfr_sgn (mpc_realref(res));
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextbelow (mpc_realref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_realref(res));
isinf = mpfr_inf_p (mpc_realref(res));
mpfr_nextabove (mpc_realref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_realref(res), tmpsgn);
overflow_re = 1;
}
/* same for the imaginary part */
tmpsgn = mpfr_sgn (mpc_imagref(res));
isinf = 0;
if (tmpsgn > 0)
{
mpfr_nextabove (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextbelow (mpc_imagref(res));
}
else if (tmpsgn < 0)
{
mpfr_nextbelow (mpc_imagref(res));
isinf = mpfr_inf_p (mpc_imagref(res));
mpfr_nextabove (mpc_imagref(res));
}
if (isinf)
{
mpfr_set_inf (mpc_imagref(res), tmpsgn);
overflow_im = 1;
}
mpc_set (a, res, rnd);
goto end;
}
/* divide the product by the norm */
if (inexact_norm == 0 && (inexact_re == 0 || inexact_im == 0)) {
/* The division has good chances to be exact in at least one part. */
/* Since this can cause problems when not rounding to the nearest, */
/* we use the division code of mpfr, which handles the situation. */
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_div (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_div (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
else {
/* The division is inexact, so for efficiency reasons we invert q */
/* only once and multiply by the inverse. */
if (mpfr_ui_div (q, 1ul, q, MPFR_RNDZ) || inexact_norm) {
/* if 1/q is inexact, the approximations of the real and
imaginary part below will be inexact, unless RE(res)
or IM(res) is zero */
inexact_re |= !mpfr_zero_p (mpc_realref (res));
inexact_im |= !mpfr_zero_p (mpc_imagref (res));
}
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_re |= mpfr_mul (mpc_realref (res), mpc_realref (res), q, MPFR_RNDZ);
underflow_re = mpfr_underflow_p ();
overflow_re = mpfr_overflow_p ();
ok_re = !inexact_re || underflow_re || overflow_re
|| mpfr_can_round (mpc_realref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_RE(a) + (rnd_re == MPFR_RNDN));
if (ok_re) /* compute imaginary part */ {
mpfr_clear_underflow ();
mpfr_clear_overflow ();
inexact_im |= mpfr_mul (mpc_imagref (res), mpc_imagref (res), q, MPFR_RNDZ);
underflow_im = mpfr_underflow_p ();
overflow_im = mpfr_overflow_p ();
ok_im = !inexact_im || underflow_im || overflow_im
|| mpfr_can_round (mpc_imagref (res), prec - 4, MPFR_RNDN,
MPFR_RNDZ, MPC_PREC_IM(a) + (rnd_im == MPFR_RNDN));
}
}
} while ((!ok_re || !ok_im) && !underflow_norm && !overflow_norm
&& !underflow_prod && !overflow_prod);
inex = mpc_set (a, res, rnd);
inexact_re = MPC_INEX_RE (inex);
inexact_im = MPC_INEX_IM (inex);
end:
/* fix values and inexact flags in case of overflow/underflow */
/* FIXME: heuristic, certainly does not cover all cases */
if (overflow_re || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_realref (a), mpfr_sgn (mpc_realref (res)));
inexact_re = mpfr_sgn (mpc_realref (res));
}
else if (underflow_re || (overflow_norm && !overflow_prod)) {
inexact_re = mpfr_signbit (mpc_realref (res)) ? 1 : -1;
mpfr_set_zero (mpc_realref (a), -inexact_re);
}
if (overflow_im || (underflow_norm && !underflow_prod)) {
mpfr_set_inf (mpc_imagref (a), mpfr_sgn (mpc_imagref (res)));
inexact_im = mpfr_sgn (mpc_imagref (res));
}
else if (underflow_im || (overflow_norm && !overflow_prod)) {
inexact_im = mpfr_signbit (mpc_imagref (res)) ? 1 : -1;
mpfr_set_zero (mpc_imagref (a), -inexact_im);
}
mpc_clear (res);
mpfr_clear (q);
/* restore underflow and overflow flags from MPFR */
if (saved_underflow)
mpfr_set_underflow ();
if (saved_overflow)
mpfr_set_overflow ();
return MPC_INEX (inexact_re, inexact_im);
}
static void
special_test (void)
{
int inex;
mpf_t x;
mpfr_t y;
mpfr_init (y);
mpf_init (x);
mpfr_set_nan (y);
mpfr_clear_flags ();
mpfr_get_f (x, y, MPFR_RNDN);
if (! mpfr_erangeflag_p ())
{
printf ("Error: mpfr_get_f(NaN) should raise erange flag\n");
exit (1);
}
mpfr_set_inf (y, +1);
mpfr_clear_flags ();
inex = mpfr_get_f (x, y, MPFR_RNDN);
if (inex >= 0)
{
printf ("Error: mpfr_get_f(+Inf) should return a negative ternary"
"value\n");
exit (1);
}
if (! mpfr_erangeflag_p ())
{
printf ("Error: mpfr_get_f(+Inf) should raise erange flag\n");
exit (1);
}
mpfr_set_inf (y, -1);
mpfr_clear_flags ();
inex = mpfr_get_f (x, y, MPFR_RNDN);
if (inex <= 0)
{
printf ("Error: mpfr_get_f(-Inf) should return a positive ternary"
"value\n");
exit (1);
}
if (! mpfr_erangeflag_p ())
{
printf ("Error: mpfr_get_f(-Inf) should raise erange flag\n");
exit (1);
}
mpfr_set_ui (y, 0, MPFR_RNDN);
if (mpfr_get_f (x, y, MPFR_RNDN) != 0 || mpf_cmp_ui (x, 0))
{
printf ("Error: mpfr_get_f(+0) fails\n");
exit (1);
}
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_neg (y, y, MPFR_RNDN);
if (mpfr_get_f (x, y, MPFR_RNDN) != 0 || mpf_cmp_ui (x, 0))
{
printf ("Error: mpfr_get_f(-0) fails\n");
exit (1);
}
mpfr_clear (y);
mpf_clear (x);
}
int
main (void)
{
double x, y;
mpfr_t xx, yy;
int c;
long i;
mp_prec_t p;
tests_start_mpfr ();
mpfr_init (xx);
mpfr_init (yy);
mpfr_set_prec (xx, 2);
mpfr_set_prec (yy, 2);
mpfr_set_str_binary(xx, "-0.10E0");
mpfr_set_str_binary(yy, "-0.10E0");
if ((mpfr_cmp) (xx, yy))
{
printf ("mpfr_cmp (xx, yy) returns non-zero for prec=2\n");
exit (1);
}
mpfr_set_prec (xx, 65);
mpfr_set_prec (yy, 65);
mpfr_set_str_binary(xx, "0.10011010101000110101010000000011001001001110001011101011111011101E623");
mpfr_set_str_binary(yy, "0.10011010101000110101010000000011001001001110001011101011111011100E623");
p = 0;
if (mpfr_cmp2 (xx, yy, &p) <= 0 || p != 64)
{
printf ("Error (1) in mpfr_cmp2\n");
exit (1);
}
mpfr_set_str_binary(xx, "0.10100010001110110111000010001000010011111101000100011101000011100");
mpfr_set_str_binary(yy, "0.10100010001110110111000010001000010011111101000100011101000011011");
p = 0;
if (mpfr_cmp2 (xx, yy, &p) <= 0 || p != 64)
{
printf ("Error (2) in mpfr_cmp2\n");
exit (1);
}
mpfr_set_prec (xx, 160); mpfr_set_prec (yy, 160);
mpfr_set_str_binary (xx, "0.1E1");
mpfr_set_str_binary (yy, "0.1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111100000110001110100");
p = 0;
if (mpfr_cmp2 (xx, yy, &p) <= 0 || p != 144)
{
printf ("Error (3) in mpfr_cmp2\n");
exit (1);
}
mpfr_set_prec (xx, 53);
mpfr_set_prec (yy, 200);
mpfr_set_ui (xx, 1, (mp_rnd_t) 0);
mpfr_set_ui (yy, 1, (mp_rnd_t) 0);
if (mpfr_cmp (xx, yy) != 0)
{
printf ("Error in mpfr_cmp: 1.0 != 1.0\n");
exit (1);
}
mpfr_set_prec (yy, 31);
mpfr_set_str (xx, "1.0000000002", 10, (mp_rnd_t) 0);
mpfr_set_ui (yy, 1, (mp_rnd_t) 0);
if (!(mpfr_cmp (xx,yy)>0))
{
printf ("Error in mpfr_cmp: not 1.0000000002 > 1.0\n");
exit (1);
}
mpfr_set_prec (yy, 53);
/* bug found by Gerardo Ballabio */
mpfr_set_ui(xx, 0, GMP_RNDN);
mpfr_set_str (yy, "0.1", 10, GMP_RNDN);
if ((c = mpfr_cmp (xx, yy)) >= 0)
{
printf ("Error in mpfr_cmp(0.0, 0.1), gives %d\n", c);
exit (1);
}
mpfr_set_inf (xx, 1);
mpfr_set_str (yy, "-23489745.0329", 10, GMP_RNDN);
if ((c = mpfr_cmp (xx, yy)) <= 0)
{
printf ("Error in mpfr_cmp(Infp, 23489745.0329), gives %d\n", c);
exit (1);
}
mpfr_set_inf (xx, 1);
mpfr_set_inf (yy, -1);
if ((c = mpfr_cmp (xx, yy)) <= 0)
{
printf ("Error in mpfr_cmp(Infp, Infm), gives %d\n", c);
exit (1);
}
mpfr_set_inf (xx, -1);
mpfr_set_inf (yy, 1);
if ((c = mpfr_cmp (xx, yy)) >= 0)
{
printf ("Error in mpfr_cmp(Infm, Infp), gives %d\n", c);
exit (1);
}
mpfr_set_inf (xx, 1);
mpfr_set_inf (yy, 1);
if ((c = mpfr_cmp (xx, yy)) != 0)
{
printf ("Error in mpfr_cmp(Infp, Infp), gives %d\n", c);
exit (1);
}
mpfr_set_inf (xx, -1);
mpfr_set_inf (yy, -1);
if ((c = mpfr_cmp (xx, yy)) != 0)
{
printf ("Error in mpfr_cmp(Infm, Infm), gives %d\n", c);
exit (1);
}
mpfr_set_inf (xx, -1);
mpfr_set_str (yy, "2346.09234", 10, GMP_RNDN);
if ((c = mpfr_cmp (xx, yy)) >= 0)
{
printf ("Error in mpfr_cmp(Infm, 2346.09234), gives %d\n", c);
exit (1);
}
mpfr_set_ui (xx, 0, GMP_RNDN);
mpfr_set_ui (yy, 1, GMP_RNDN);
if ((c = mpfr_cmp3 (xx, yy, 1)) >= 0)
{
printf ("Error: mpfr_cmp3 (0, 1, 1) gives %d instead of"
" a negative value\n", c);
exit (1);
}
if ((c = mpfr_cmp3 (xx, yy, -1)) <= 0)
{
printf ("Error: mpfr_cmp3 (0, 1, -1) gives %d instead of"
" a positive value\n", c);
exit (1);
}
for (i=0; i<500000; )
{
x = DBL_RAND ();
y = DBL_RAND ();
if (!Isnan(x) && !Isnan(y))
{
i++;
mpfr_set_d (xx, x, GMP_RNDN);
mpfr_set_d (yy, y, GMP_RNDN);
c = mpfr_cmp (xx,yy);
if ((c>0 && x<=y) || (c==0 && x!=y) || (c<0 && x>=y))
{
printf ("Error in mpfr_cmp with x=%1.20e, y=%1.20e"
" mpfr_cmp(x,y)=%d\n", x, y, c);
exit (1);
}
}
}
/* Check for NAN */
mpfr_set_nan (xx);
mpfr_clear_erangeflag ();
c = (mpfr_cmp) (xx, yy);
if (c != 0 || !mpfr_erangeflag_p () )
{
printf ("NAN error (1)\n");
exit (1);
}
mpfr_clear_erangeflag ();
c = (mpfr_cmp) (yy, xx);
if (c != 0 || !mpfr_erangeflag_p () )
{
printf ("NAN error (2)\n");
exit (1);
}
mpfr_clear_erangeflag ();
c = (mpfr_cmp) (xx, xx);
if (c != 0 || !mpfr_erangeflag_p () )
{
printf ("NAN error (3)\n");
exit (1);
}
mpfr_clear (xx);
mpfr_clear (yy);
tests_end_mpfr ();
return 0;
}
/* Implements asymptotic expansion for jn or yn (formulae 9.2.5 and 9.2.6
from Abramowitz & Stegun).
Assumes |z| > p log(2)/2, where p is the target precision
(z can be negative only for jn).
Return 0 if the expansion does not converge enough (the value 0 as inexact
flag should not happen for normal input).
*/
static int
FUNCTION (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
mpfr_t s, c, P, Q, t, iz, err_t, err_s, err_u;
mpfr_prec_t w;
long k;
int inex, stop, diverge = 0;
mpfr_exp_t err2, err;
MPFR_ZIV_DECL (loop);
mpfr_init (c);
w = MPFR_PREC(res) + MPFR_INT_CEIL_LOG2(MPFR_PREC(res)) + 4;
MPFR_ZIV_INIT (loop, w);
for (;;)
{
mpfr_set_prec (c, w);
mpfr_init2 (s, w);
mpfr_init2 (P, w);
mpfr_init2 (Q, w);
mpfr_init2 (t, w);
mpfr_init2 (iz, w);
mpfr_init2 (err_t, 31);
mpfr_init2 (err_s, 31);
mpfr_init2 (err_u, 31);
/* Approximate sin(z) and cos(z). In the following, err <= k means that
the approximate value y and the true value x are related by
y = x * (1 + u)^k with |u| <= 2^(-w), following Higham's method. */
mpfr_sin_cos (s, c, z, MPFR_RNDN);
if (MPFR_IS_NEG(z))
mpfr_neg (s, s, MPFR_RNDN); /* compute jn/yn(|z|), fix sign later */
/* The absolute error on s/c is bounded by 1/2 ulp(1/2) <= 2^(-w-1). */
mpfr_add (t, s, c, MPFR_RNDN);
mpfr_sub (c, s, c, MPFR_RNDN);
mpfr_swap (s, t);
/* now s approximates sin(z)+cos(z), and c approximates sin(z)-cos(z),
with total absolute error bounded by 2^(1-w). */
/* precompute 1/(8|z|) */
mpfr_si_div (iz, MPFR_IS_POS(z) ? 1 : -1, z, MPFR_RNDN); /* err <= 1 */
mpfr_div_2ui (iz, iz, 3, MPFR_RNDN);
/* compute P and Q */
mpfr_set_ui (P, 1, MPFR_RNDN);
mpfr_set_ui (Q, 0, MPFR_RNDN);
mpfr_set_ui (t, 1, MPFR_RNDN); /* current term */
mpfr_set_ui (err_t, 0, MPFR_RNDN); /* error on t */
mpfr_set_ui (err_s, 0, MPFR_RNDN); /* error on P and Q (sum of errors) */
for (k = 1, stop = 0; stop < 4; k++)
{
/* compute next term: t(k)/t(k-1) = (2n+2k-1)(2n-2k+1)/(8kz) */
mpfr_mul_si (t, t, 2 * (n + k) - 1, MPFR_RNDN); /* err <= err_k + 1 */
mpfr_mul_si (t, t, 2 * (n - k) + 1, MPFR_RNDN); /* err <= err_k + 2 */
mpfr_div_ui (t, t, k, MPFR_RNDN); /* err <= err_k + 3 */
mpfr_mul (t, t, iz, MPFR_RNDN); /* err <= err_k + 5 */
/* the relative error on t is bounded by (1+u)^(5k)-1, which is
bounded by 6ku for 6ku <= 0.02: first |5 log(1+u)| <= |5.5u|
for |u| <= 0.15, then |exp(5.5u)-1| <= 6u for |u| <= 0.02. */
mpfr_mul_ui (err_t, t, 6 * k, MPFR_IS_POS(t) ? MPFR_RNDU : MPFR_RNDD);
mpfr_abs (err_t, err_t, MPFR_RNDN); /* exact */
/* the absolute error on t is bounded by err_t * 2^(-w) */
mpfr_abs (err_u, t, MPFR_RNDU);
mpfr_mul_2ui (err_u, err_u, w, MPFR_RNDU); /* t * 2^w */
mpfr_add (err_u, err_u, err_t, MPFR_RNDU); /* max|t| * 2^w */
if (stop >= 2)
{
/* take into account the neglected terms: t * 2^w */
mpfr_div_2ui (err_s, err_s, w, MPFR_RNDU);
if (MPFR_IS_POS(t))
mpfr_add (err_s, err_s, t, MPFR_RNDU);
else
mpfr_sub (err_s, err_s, t, MPFR_RNDU);
mpfr_mul_2ui (err_s, err_s, w, MPFR_RNDU);
stop ++;
}
/* if k is odd, add to Q, otherwise to P */
else if (k & 1)
{
/* if k = 1 mod 4, add, otherwise subtract */
if ((k & 2) == 0)
mpfr_add (Q, Q, t, MPFR_RNDN);
else
mpfr_sub (Q, Q, t, MPFR_RNDN);
/* check if the next term is smaller than ulp(Q): if EXP(err_u)
<= EXP(Q), since the current term is bounded by
err_u * 2^(-w), it is bounded by ulp(Q) */
if (MPFR_EXP(err_u) <= MPFR_EXP(Q))
stop ++;
else
stop = 0;
}
else
{
/* if k = 0 mod 4, add, otherwise subtract */
if ((k & 2) == 0)
mpfr_add (P, P, t, MPFR_RNDN);
else
mpfr_sub (P, P, t, MPFR_RNDN);
/* check if the next term is smaller than ulp(P) */
if (MPFR_EXP(err_u) <= MPFR_EXP(P))
stop ++;
else
stop = 0;
}
mpfr_add (err_s, err_s, err_t, MPFR_RNDU);
/* the sum of the rounding errors on P and Q is bounded by
err_s * 2^(-w) */
/* stop when start to diverge */
if (stop < 2 &&
((MPFR_IS_POS(z) && mpfr_cmp_ui (z, (k + 1) / 2) < 0) ||
(MPFR_IS_NEG(z) && mpfr_cmp_si (z, - ((k + 1) / 2)) > 0)))
{
/* if we have to stop the series because it diverges, then
increasing the precision will most probably fail, since
we will stop to the same point, and thus compute a very
similar approximation */
diverge = 1;
stop = 2; /* force stop */
}
}
/* the sum of the total errors on P and Q is bounded by err_s * 2^(-w) */
/* Now combine: the sum of the rounding errors on P and Q is bounded by
err_s * 2^(-w), and the absolute error on s/c is bounded by 2^(1-w) */
if ((n & 1) == 0) /* n even: P * (sin + cos) + Q (cos - sin) for jn
Q * (sin + cos) + P (sin - cos) for yn */
{
#ifdef MPFR_JN
mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#else
mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#endif
err = MPFR_EXP(c);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
#ifdef MPFR_JN
mpfr_sub (s, s, c, MPFR_RNDN);
#else
mpfr_add (s, s, c, MPFR_RNDN);
#endif
}
else /* n odd: P * (sin - cos) + Q (cos + sin) for jn,
Q * (sin - cos) - P (cos + sin) for yn */
{
#ifdef MPFR_JN
mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#else
mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#endif
err = MPFR_EXP(c);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
#ifdef MPFR_JN
mpfr_add (s, s, c, MPFR_RNDN);
#else
mpfr_sub (s, c, s, MPFR_RNDN);
#endif
}
if ((n & 2) != 0)
mpfr_neg (s, s, MPFR_RNDN);
if (MPFR_EXP(s) > err)
err = MPFR_EXP(s);
/* the absolute error on s is bounded by P*err(s/c) + Q*err(s/c)
+ err(P)*(s/c) + err(Q)*(s/c) + 3 * 2^(err - w - 1)
<= (|P|+|Q|) * 2^(1-w) + err_s * 2^(1-w) + 2^err * 2^(1-w),
since |c|, |old_s| <= 2. */
err2 = (MPFR_EXP(P) >= MPFR_EXP(Q)) ? MPFR_EXP(P) + 2 : MPFR_EXP(Q) + 2;
/* (|P| + |Q|) * 2^(1 - w) <= 2^(err2 - w) */
err = MPFR_EXP(err_s) >= err ? MPFR_EXP(err_s) + 2 : err + 2;
/* err_s * 2^(1-w) + 2^old_err * 2^(1-w) <= 2^err * 2^(-w) */
err2 = (err >= err2) ? err + 1 : err2 + 1;
/* now the absolute error on s is bounded by 2^(err2 - w) */
/* multiply by sqrt(1/(Pi*z)) */
mpfr_const_pi (c, MPFR_RNDN); /* Pi, err <= 1 */
mpfr_mul (c, c, z, MPFR_RNDN); /* err <= 2 */
mpfr_si_div (c, MPFR_IS_POS(z) ? 1 : -1, c, MPFR_RNDN); /* err <= 3 */
mpfr_sqrt (c, c, MPFR_RNDN); /* err<=5/2, thus the absolute error is
bounded by 3*u*|c| for |u| <= 0.25 */
mpfr_mul (err_t, c, s, MPFR_SIGN(c)==MPFR_SIGN(s) ? MPFR_RNDU : MPFR_RNDD);
mpfr_abs (err_t, err_t, MPFR_RNDU);
mpfr_mul_ui (err_t, err_t, 3, MPFR_RNDU);
/* 3*2^(-w)*|old_c|*|s| [see below] is bounded by err_t * 2^(-w) */
err2 += MPFR_EXP(c);
/* |old_c| * 2^(err2 - w) [see below] is bounded by 2^(err2-w) */
mpfr_mul (c, c, s, MPFR_RNDN); /* the absolute error on c is bounded by
1/2 ulp(c) + 3*2^(-w)*|old_c|*|s|
+ |old_c| * 2^(err2 - w) */
/* compute err_t * 2^(-w) + 1/2 ulp(c) = (err_t + 2^EXP(c)) * 2^(-w) */
err = (MPFR_EXP(err_t) > MPFR_EXP(c)) ? MPFR_EXP(err_t) + 1 : MPFR_EXP(c) + 1;
/* err_t * 2^(-w) + 1/2 ulp(c) <= 2^(err - w) */
/* now err_t * 2^(-w) bounds 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| */
err = (err >= err2) ? err + 1 : err2 + 1;
/* the absolute error on c is bounded by 2^(err - w) */
mpfr_clear (s);
mpfr_clear (P);
mpfr_clear (Q);
mpfr_clear (t);
mpfr_clear (iz);
mpfr_clear (err_t);
mpfr_clear (err_s);
mpfr_clear (err_u);
err -= MPFR_EXP(c);
if (MPFR_LIKELY (MPFR_CAN_ROUND (c, w - err, MPFR_PREC(res), r)))
break;
if (diverge != 0)
{
mpfr_set (c, z, r); /* will force inex=0 below, which means the
asymptotic expansion failed */
break;
}
MPFR_ZIV_NEXT (loop, w);
}
MPFR_ZIV_FREE (loop);
inex = (MPFR_IS_POS(z) || ((n & 1) == 0)) ? mpfr_set (res, c, r)
: mpfr_neg (res, c, r);
mpfr_clear (c);
return inex;
}
static void
test_generic_ui (mpfr_prec_t p0, mpfr_prec_t p1, unsigned int N)
{
mpfr_prec_t prec, yprec;
mpfr_t x, y, z, t;
INTEGER_TYPE u;
mpfr_rnd_t rnd;
int inexact, compare, compare2;
unsigned int n;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
/* generic test */
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
for (n = 0; n <= N; n++)
{
if (n > 1 || prec < p1)
RAND_FUNCTION (x);
else
{
/* Special cases tested in precision p1 if n <= 1. */
mpfr_set_si (x, n == 0 ? 1 : -1, MPFR_RNDN);
mpfr_set_exp (x, mpfr_get_emin ());
}
u = INT_RAND_FUNCTION ();
rnd = RND_RAND ();
mpfr_set_prec (y, yprec);
compare = TEST_FUNCTION (y, x, u, rnd);
if (mpfr_can_round (y, yprec, rnd, rnd, prec))
{
mpfr_set (t, y, rnd);
inexact = TEST_FUNCTION (z, x, u, rnd);
if (mpfr_cmp (t, z))
{
printf ("results differ for x=");
mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN);
printf ("\nu=%lu", (unsigned long) u);
printf (" prec=%lu rnd_mode=%s\n",
(unsigned long ) prec, mpfr_print_rnd_mode (rnd));
#ifdef TEST_FUNCTION_NAME
printf ("Function: %s\n", TEST_FUNCTION_NAME);
#endif
printf ("got ");
mpfr_out_str (stdout, 2, prec, z, MPFR_RNDN);
puts ("");
printf ("expected ");
mpfr_out_str (stdout, 2, prec, t, MPFR_RNDN);
puts ("");
printf ("approx ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
compare2 = mpfr_cmp (t, y);
/* if rounding to nearest, cannot know the sign of t - f(x)
because of composed rounding: y = o(f(x)) and t = o(y) */
if (compare * compare2 >= 0)
compare = compare + compare2;
else
compare = inexact; /* cannot determine sign(t-f(x)) */
if (((inexact == 0) && (compare != 0)) ||
((inexact > 0) && (compare <= 0)) ||
((inexact < 0) && (compare >= 0)))
{
printf ("Wrong inexact flag for rnd=%s: expected %d, got %d"
"\n", mpfr_print_rnd_mode (rnd), compare, inexact);
printf ("x="); mpfr_print_binary (x); puts ("");
printf ("u=%lu", (unsigned long) u);
printf ("y="); mpfr_print_binary (y); puts ("");
printf ("t="); mpfr_print_binary (t); puts ("");
exit (1);
}
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
}
/* checks that the inexact return value is correct */
static void
check_exact (void)
{
mpfr_t a, b, c, d;
mpfr_prec_t prec;
int i, inexact;
mpfr_rnd_t rnd;
mpfr_init (a);
mpfr_init (b);
mpfr_init (c);
mpfr_init (d);
mpfr_set_prec (a, 17);
mpfr_set_prec (b, 17);
mpfr_set_prec (c, 32);
mpfr_set_str_binary (a, "1.1000111011000100e-1");
mpfr_set_str_binary (b, "1.0010001111100111e-1");
if (test_mul (c, a, b, MPFR_RNDZ))
{
printf ("wrong return value (1)\n");
exit (1);
}
for (prec = 2; prec < 100; prec++)
{
mpfr_set_prec (a, prec);
mpfr_set_prec (b, prec);
mpfr_set_prec (c, 2 * prec - 2);
mpfr_set_prec (d, 2 * prec);
for (i = 0; i < 1000; i++)
{
mpfr_urandomb (a, RANDS);
mpfr_urandomb (b, RANDS);
rnd = RND_RAND ();
inexact = test_mul (c, a, b, rnd);
if (test_mul (d, a, b, rnd)) /* should be always exact */
{
printf ("unexpected inexact return value\n");
exit (1);
}
if ((inexact == 0) && mpfr_cmp (c, d))
{
printf ("inexact=0 but results differ\n");
exit (1);
}
else if (inexact && (mpfr_cmp (c, d) == 0))
{
printf ("inexact!=0 but results agree\n");
printf ("prec=%u rnd=%s a=", (unsigned int) prec,
mpfr_print_rnd_mode (rnd));
mpfr_out_str (stdout, 2, 0, a, rnd);
printf ("\nb=");
mpfr_out_str (stdout, 2, 0, b, rnd);
printf ("\nc=");
mpfr_out_str (stdout, 2, 0, c, rnd);
printf ("\nd=");
mpfr_out_str (stdout, 2, 0, d, rnd);
printf ("\n");
exit (1);
}
}
}
mpfr_clear (a);
mpfr_clear (b);
mpfr_clear (c);
mpfr_clear (d);
}
static void
check_inexact (mp_prec_t p)
{
mpfr_t x, y, z, t;
unsigned long u;
mp_prec_t q;
int inexact, cmp;
int rnd;
mpfr_init2 (x, p);
mpfr_init (y);
mpfr_init (z);
mpfr_init (t);
mpfr_random (x);
u = randlimb () % 2;
for (q = 2; q <= p; q++)
for (rnd = 0; rnd < GMP_RND_MAX; rnd++)
{
mpfr_set_prec (y, q);
mpfr_set_prec (z, q + 10);
mpfr_set_prec (t, q);
inexact = mpfr_pow_ui (y, x, u, (mp_rnd_t) rnd);
cmp = mpfr_pow_ui (z, x, u, (mp_rnd_t) rnd);
if (mpfr_can_round (z, q + 10, (mp_rnd_t) rnd, (mp_rnd_t) rnd, q))
{
cmp = mpfr_set (t, z, (mp_rnd_t) rnd) || cmp;
if (mpfr_cmp (y, t))
{
printf ("results differ for u=%lu rnd=%s\n",
u, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
printf ("x=");
mpfr_print_binary (x);
puts ("");
printf ("y=");
mpfr_print_binary (y);
puts ("");
printf ("t=");
mpfr_print_binary (t);
puts ("");
printf ("z=");
mpfr_print_binary (z);
puts ("");
exit (1);
}
if (((inexact == 0) && (cmp != 0)) ||
((inexact != 0) && (cmp == 0)))
{
printf ("Wrong inexact flag for p=%u, q=%u, rnd=%s\n",
(unsigned int) p, (unsigned int) q,
mpfr_print_rnd_mode ((mp_rnd_t) rnd));
printf ("expected %d, got %d\n", cmp, inexact);
printf ("u=%lu x=", u);
mpfr_print_binary (x);
puts ("");
printf ("y=");
mpfr_print_binary (y);
puts ("");
exit (1);
}
}
}
/* check exact power */
mpfr_set_prec (x, p);
mpfr_set_prec (y, p);
mpfr_set_prec (z, p);
mpfr_set_ui (x, 4, GMP_RNDN);
mpfr_set_str (y, "0.5", 10, GMP_RNDN);
test_pow (z, x, y, GMP_RNDZ);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (t);
}
static void
special (void)
{
mpfr_t x, y;
mpq_t q;
mpz_t z;
int res = 0;
mpfr_init (x);
mpfr_init (y);
mpq_init (q);
mpz_init (z);
/* cancellation in mpfr_add_q */
mpfr_set_prec (x, 60);
mpfr_set_prec (y, 20);
mpz_set_str (mpq_numref (q), "-187207494", 10);
mpz_set_str (mpq_denref (q), "5721", 10);
mpfr_set_str_binary (x, "11111111101001011011100101100011011110010011100010000100001E-44");
mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("cancelation in add_q", mpfr_cmp_ui_2exp (y, 256783, -64) == 0);
mpfr_set_prec (x, 19);
mpfr_set_str_binary (x, "0.1011110101110011100E0");
mpz_set_str (mpq_numref (q), "187207494", 10);
mpz_set_str (mpq_denref (q), "5721", 10);
mpfr_set_prec (y, 29);
mpfr_add_q (y, x, q, MPFR_RNDD);
mpfr_set_prec (x, 29);
mpfr_set_str_binary (x, "11111111101001110011010001001E-14");
CHECK_FOR ("cancelation in add_q", mpfr_cmp (x,y) == 0);
/* Inf */
mpfr_set_inf (x, 1);
mpz_set_str (mpq_numref (q), "395877315", 10);
mpz_set_str (mpq_denref (q), "3508975966", 10);
mpfr_set_prec (y, 118);
mpfr_add_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("inf", mpfr_inf_p (y) && mpfr_sgn (y) > 0);
mpfr_sub_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("inf", mpfr_inf_p (y) && mpfr_sgn (y) > 0);
/* Nan */
MPFR_SET_NAN (x);
mpfr_add_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("nan", mpfr_nan_p (y));
mpfr_sub_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("nan", mpfr_nan_p (y));
/* Exact value */
mpfr_set_prec (x, 60);
mpfr_set_prec (y, 60);
mpfr_set_str1 (x, "0.5");
mpz_set_str (mpq_numref (q), "3", 10);
mpz_set_str (mpq_denref (q), "2", 10);
res = mpfr_add_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("0.5+3/2", mpfr_cmp_ui(y, 2)==0 && res==0);
res = mpfr_sub_q (y, x, q, MPFR_RNDU);
CHECK_FOR ("0.5-3/2", mpfr_cmp_si(y, -1)==0 && res==0);
/* Inf Rationnal */
mpq_set_ui (q, 1, 0);
mpfr_set_str1 (x, "0.5");
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5+1/0", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5-1/0", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0);
mpq_set_si (q, -1, 0);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5+ -1/0", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5- -1/0", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0);
res = mpfr_div_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("0.5 / (-1/0)", mpfr_zero_p (y) && MPFR_IS_NEG (y) && res == 0);
mpq_set_ui (q, 1, 0);
mpfr_set_inf (x, 1);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("+Inf + +Inf", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("+Inf - +Inf", MPFR_IS_NAN (y) && res == 0);
mpfr_set_inf (x, -1);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("-Inf + +Inf", MPFR_IS_NAN (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("-Inf - +Inf", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0);
mpq_set_si (q, -1, 0);
mpfr_set_inf (x, 1);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("+Inf + -Inf", MPFR_IS_NAN (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("+Inf - -Inf", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0);
mpfr_set_inf (x, -1);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("-Inf + -Inf", mpfr_inf_p (y) && MPFR_IS_NEG (y) && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("-Inf - -Inf", MPFR_IS_NAN (y) && res == 0);
/* 0 */
mpq_set_ui (q, 0, 1);
mpfr_set_ui (x, 42, MPFR_RNDN);
res = mpfr_add_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("42+0/1", mpfr_cmp_ui (y, 42) == 0 && res == 0);
res = mpfr_sub_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("42-0/1", mpfr_cmp_ui (y, 42) == 0 && res == 0);
res = mpfr_mul_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("42*0/1", mpfr_zero_p (y) && MPFR_IS_POS (y) && res == 0);
mpfr_clear_flags ();
res = mpfr_div_q (y, x, q, MPFR_RNDN);
CHECK_FOR ("42/(0/1)", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0
&& mpfr_divby0_p ());
mpz_set_ui (z, 0);
mpfr_clear_flags ();
res = mpfr_div_z (y, x, z, MPFR_RNDN);
CHECK_FORZ ("42/0", mpfr_inf_p (y) && MPFR_IS_POS (y) && res == 0
&& mpfr_divby0_p ());
mpz_clear (z);
mpq_clear (q);
mpfr_clear (x);
mpfr_clear (y);
}
int
main (void)
{
mpf_t x;
mpfr_t y, z;
unsigned long i;
mpfr_exp_t e;
int inex;
tests_start_mpfr ();
mpfr_init (y);
mpfr_init (z);
mpf_init (x);
i = 1;
while (i)
{
mpfr_set_ui (y, i, MPFR_RNDN);
if (mpfr_get_f (x, y, MPFR_RNDN) != 0 || mpf_cmp_ui (x, i))
{
printf ("Error: mpfr_get_f(%lu) fails\n", i);
exit (1);
}
if (i <= - (unsigned long) LONG_MIN)
{
long j = i < - (unsigned long) LONG_MIN ? - (long) i : LONG_MIN;
mpfr_set_si (y, j, MPFR_RNDN);
if (mpfr_get_f (x, y, MPFR_RNDN) != 0 || mpf_cmp_si (x, j))
{
printf ("Error: mpfr_get_f(-%lu) fails\n", i);
exit (1);
}
}
i *= 2;
}
/* same tests, but with a larger precision for y, which requires to
round it */
mpfr_set_prec (y, 100);
i = 1;
while (i)
{
mpfr_set_ui (y, i, MPFR_RNDN);
inex = mpfr_get_f (x, y, MPFR_RNDN);
if (! SAME_SIGN (inex, - mpfr_cmp_f (y, x)) || mpf_cmp_ui (x, i))
{
printf ("Error: mpfr_get_f(%lu) fails\n", i);
exit (1);
}
mpfr_set_si (y, (signed long) -i, MPFR_RNDN);
inex = mpfr_get_f (x, y, MPFR_RNDN);
if (! SAME_SIGN (inex, - mpfr_cmp_f (y, x))
|| mpf_cmp_si (x, (signed long) -i))
{
printf ("Error: mpfr_get_f(-%lu) fails\n", i);
exit (1);
}
i *= 2;
}
/* bug reported by Jim White */
for (e = 0; e <= 2 * GMP_NUMB_BITS; e++)
{
/* test with 2^(-e) */
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_div_2exp (y, y, e, MPFR_RNDN);
inex = mpfr_get_f (x, y, MPFR_RNDN);
mpf_mul_2exp (x, x, e);
if (inex != 0 || mpf_cmp_ui (x, 1) != 0)
{
printf ("Error: mpfr_get_f(x,y,MPFR_RNDN) fails\n");
printf ("y=");
mpfr_dump (y);
printf ("x=");
mpf_div_2exp (x, x, e);
mpf_out_str (stdout, 2, 0, x);
exit (1);
}
/* test with 2^(e) */
mpfr_set_ui (y, 1, MPFR_RNDN);
mpfr_mul_2exp (y, y, e, MPFR_RNDN);
inex = mpfr_get_f (x, y, MPFR_RNDN);
mpf_div_2exp (x, x, e);
if (inex != 0 || mpf_cmp_ui (x, 1) != 0)
{
printf ("Error: mpfr_get_f(x,y,MPFR_RNDN) fails\n");
printf ("y=");
mpfr_dump (y);
printf ("x=");
mpf_mul_2exp (x, x, e);
mpf_out_str (stdout, 2, 0, x);
exit (1);
}
}
/* Bug reported by Yury Lukach on 2006-04-05 */
mpfr_set_prec (y, 32);
mpfr_set_prec (z, 32);
mpf_set_prec (x, 32);
mpfr_set_ui_2exp (y, 0xc1234567, -30, MPFR_RNDN);
mpfr_get_f (x, y, MPFR_RNDN);
inex = mpfr_set_f (z, x, MPFR_RNDN);
if (inex != 0 || ! mpfr_equal_p (y, z))
{
printf ("Error in mpfr_get_f:\n inex = %d, y = ", inex);
mpfr_dump (z);
printf ("Expected:\n inex = 0, y = ");
mpfr_dump (y);
exit (1);
}
mpfr_clear (y);
mpfr_clear (z);
mpf_clear (x);
special_test ();
prec_test ();
ternary_test ();
tests_end_mpfr ();
return 0;
}
void mexFunction( int nlhs, mxArray *plhs[],
int nrhs, const mxArray *prhs[] )
{
double *prec,*eoutr,*eouti;
int mrows,ncols;
char *input_buf;
char *w1,*w2;
int buflen,status;
mpfr_t xr,xi,yr,yi,zr,zi,temp,temp1;
mp_exp_t expptr;
/* Check for proper number of arguments. */
if(nrhs!=5) {
mexErrMsgTxt("5 inputs required.");
} else if(nlhs>4) {
mexErrMsgTxt("Too many output arguments");
}
/* The input must be a noncomplex scalar double.*/
mrows = mxGetM(prhs[0]);
ncols = mxGetN(prhs[0]);
if( !mxIsDouble(prhs[0]) || mxIsComplex(prhs[0]) ||
!(mrows==1 && ncols==1) ) {
mexErrMsgTxt("Input must be a noncomplex scalar double.");
}
/* Set precision and initialize mpfr variables */
prec = mxGetPr(prhs[0]);
mpfr_set_default_prec(*prec);
mpfr_init(xr); mpfr_init(xi);
mpfr_init(yr); mpfr_init(yi);
mpfr_init(zr); mpfr_init(zi);
mpfr_init(temp); mpfr_init(temp1);
/* Read the input strings into mpfr x real */
buflen = (mxGetM(prhs[1]) * mxGetN(prhs[1])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[1], input_buf, buflen);
mpfr_set_str(xr,input_buf,10,GMP_RNDN);
/* Read the input strings into mpfr x imag */
buflen = (mxGetM(prhs[2]) * mxGetN(prhs[2])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[2], input_buf, buflen);
mpfr_set_str(xi,input_buf,10,GMP_RNDN);
/* Read the input strings into mpfr y real */
buflen = (mxGetM(prhs[3]) * mxGetN(prhs[3])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[3], input_buf, buflen);
mpfr_set_str(yr,input_buf,10,GMP_RNDN);
/* Read the input strings into mpfr y imag */
buflen = (mxGetM(prhs[4]) * mxGetN(prhs[4])) + 1;
input_buf=mxCalloc(buflen, sizeof(char));
status = mxGetString(prhs[4], input_buf, buflen);
mpfr_set_str(yi,input_buf,10,GMP_RNDN);
/* Mathematical operation */
/* denominator */
mpfr_mul(temp,yr,yr,GMP_RNDN);
mpfr_mul(temp1,yi,yi,GMP_RNDN);
mpfr_add(temp,temp,temp1,GMP_RNDN);
/* real part */
mpfr_mul(temp1,xr,yr,GMP_RNDN);
mpfr_mul(zr,xi,yi,GMP_RNDN);
mpfr_add(zr,temp1,zr,GMP_RNDN);
/* imag part */
mpfr_mul(temp1,xi,yr,GMP_RNDN);
mpfr_mul(zi,xr,yi,GMP_RNDN);
mpfr_sub(zi,temp1,zi,GMP_RNDN);
/* divide by denominator */
mpfr_div(zr,zr,temp,GMP_RNDN);
mpfr_div(zi,zi,temp,GMP_RNDN);
/* Retrieve results */
mxFree(input_buf);
input_buf=mpfr_get_str (NULL, &expptr, 10, 0, zr, GMP_RNDN);
w1=malloc(strlen(input_buf)+20);
w2=malloc(strlen(input_buf)+20);
if (strncmp(input_buf, "-", 1)==0){
strcpy(w2,&input_buf[1]);
sprintf(w1,"-.%se%i",w2,expptr);
} else {
strcpy(w2,&input_buf[0]);
sprintf(w1,"+.%se%i",w2,expptr);
}
plhs[0] = mxCreateString(w1);
/* plhs[1] = mxCreateDoubleMatrix(mrows,ncols, mxREAL); */
/* eoutr=mxGetPr(plhs[1]); */
/* *eoutr=expptr; */
mpfr_free_str(input_buf);
input_buf=mpfr_get_str (NULL, &expptr, 10, 0, zi, GMP_RNDN);
free(w1);
free(w2);
w1=malloc(strlen(input_buf)+20);
w2=malloc(strlen(input_buf)+20);
if (strncmp(input_buf, "-", 1)==0){
strcpy(w2,&input_buf[1]);
sprintf(w1,"-.%se%i",w2,expptr);
} else {
strcpy(w2,&input_buf[0]);
sprintf(w1,"+.%se%i",w2,expptr);
}
plhs[1] = mxCreateString(w1);
/* plhs[3] = mxCreateDoubleMatrix(mrows,ncols, mxREAL); */
/* eouti=mxGetPr(plhs[3]); */
/* *eouti=expptr; */
mpfr_clear(xr); mpfr_clear(xi);
mpfr_clear(yr); mpfr_clear(yi);
mpfr_clear(zr); mpfr_clear(zi);
mpfr_clear(temp); mpfr_clear(temp1);
mpfr_free_str(input_buf);
free(w1);
free(w2);
}
int
mpc_sqr (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
int ok;
mpfr_t u, v;
mpfr_t x;
/* temporary variable to hold the real part of op,
needed in the case rop==op */
mpfr_prec_t prec;
int inex_re, inex_im, inexact;
mpfr_exp_t emin;
int saved_underflow;
/* special values: NaN and infinities */
if (!mpc_fin_p (op)) {
if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op))) {
mpfr_set_nan (mpc_realref (rop));
mpfr_set_nan (mpc_imagref (rop));
}
else if (mpfr_inf_p (mpc_realref (op))) {
if (mpfr_inf_p (mpc_imagref (op))) {
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_nan (mpc_realref (rop));
}
else {
if (mpfr_zero_p (mpc_imagref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), +1);
}
}
else /* IM(op) is infinity, RE(op) is not */ {
if (mpfr_zero_p (mpc_realref (op)))
mpfr_set_nan (mpc_imagref (rop));
else
mpfr_set_inf (mpc_imagref (rop),
MPFR_SIGN (mpc_realref (op)) * MPFR_SIGN (mpc_imagref (op)));
mpfr_set_inf (mpc_realref (rop), -1);
}
return MPC_INEX (0, 0); /* exact */
}
prec = MPC_MAX_PREC(rop);
/* Check for real resp. purely imaginary number */
if (mpfr_zero_p (mpc_imagref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = mpfr_sqr (mpc_realref(rop), mpc_realref(op), MPC_RND_RE(rnd));
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (mpfr_zero_p (mpc_realref(op))) {
int same_sign = mpfr_signbit (mpc_realref (op)) == mpfr_signbit (mpc_imagref (op));
inex_re = -mpfr_sqr (mpc_realref(rop), mpc_imagref(op), INV_RND (MPC_RND_RE(rnd)));
mpfr_neg (mpc_realref(rop), mpc_realref(rop), MPFR_RNDN);
inex_im = mpfr_set_ui (mpc_imagref(rop), 0ul, MPFR_RNDN);
if (!same_sign)
mpc_conj (rop, rop, MPC_RNDNN);
return MPC_INEX(inex_re, inex_im);
}
if (rop == op)
{
mpfr_init2 (x, MPC_PREC_RE (op));
mpfr_set (x, op->re, MPFR_RNDN);
}
else
x [0] = op->re [0];
/* From here on, use x instead of op->re and safely overwrite rop->re. */
/* Compute real part of result. */
if (SAFE_ABS (mpfr_exp_t,
mpfr_get_exp (mpc_realref (op)) - mpfr_get_exp (mpc_imagref (op)))
> (mpfr_exp_t) MPC_MAX_PREC (op) / 2) {
/* If the real and imaginary parts of the argument have very different
exponents, it is not reasonable to use Karatsuba squaring; compute
exactly with the standard formulae instead, even if this means an
additional multiplication. Using the approach copied from mul, over-
and underflows are also handled correctly. */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
}
else {
/* Karatsuba squaring: we compute the real part as (x+y)*(x-y) and the
imaginary part as 2*x*y, with a total of 2M instead of 2S+1M for the
naive algorithm, which computes x^2-y^2 and 2*y*y */
mpfr_init (u);
mpfr_init (v);
emin = mpfr_get_emin ();
do
{
prec += mpc_ceil_log2 (prec) + 5;
mpfr_set_prec (u, prec);
mpfr_set_prec (v, prec);
/* Let op = x + iy. We need u = x+y and v = x-y, rounded away. */
/* The error is bounded above by 1 ulp. */
/* We first let inexact be 1 if the real part is not computed */
/* exactly and determine the sign later. */
inexact = mpfr_add (u, x, mpc_imagref (op), MPFR_RNDA)
| mpfr_sub (v, x, mpc_imagref (op), MPFR_RNDA);
/* compute the real part as u*v, rounded away */
/* determine also the sign of inex_re */
if (mpfr_sgn (u) == 0 || mpfr_sgn (v) == 0) {
/* as we have rounded away, the result is exact */
mpfr_set_ui (mpc_realref (rop), 0, MPFR_RNDN);
inex_re = 0;
ok = 1;
}
else {
inexact |= mpfr_mul (u, u, v, MPFR_RNDA); /* error 5 */
if (mpfr_get_exp (u) == emin || mpfr_inf_p (u)) {
/* under- or overflow */
inex_re = mpfr_fsss (rop->re, x, op->im, MPC_RND_RE (rnd));
ok = 1;
}
else {
ok = (!inexact) | mpfr_can_round (u, prec - 3,
MPFR_RNDA, MPFR_RNDZ,
MPC_PREC_RE (rop) + (MPC_RND_RE (rnd) == MPFR_RNDN));
if (ok) {
inex_re = mpfr_set (mpc_realref (rop), u, MPC_RND_RE (rnd));
if (inex_re == 0)
/* remember that u was already rounded */
inex_re = inexact;
}
}
}
}
while (!ok);
mpfr_clear (u);
mpfr_clear (v);
}
saved_underflow = mpfr_underflow_p ();
mpfr_clear_underflow ();
inex_im = mpfr_mul (rop->im, x, op->im, MPC_RND_IM (rnd));
if (!mpfr_underflow_p ())
inex_im |= mpfr_mul_2ui (rop->im, rop->im, 1, MPC_RND_IM (rnd));
/* We must not multiply by 2 if rop->im has been set to the smallest
representable number. */
if (saved_underflow)
mpfr_set_underflow ();
if (rop == op)
mpfr_clear (x);
return MPC_INEX (inex_re, inex_im);
}
int
main (int argc, char *argv[])
{
mpfr_t x;
int p;
mpfr_rnd_t rnd;
tests_start_mpfr ();
p = (argc>1) ? atoi(argv[1]) : 53;
rnd = (argc>2) ? (mpfr_rnd_t) atoi(argv[2]) : MPFR_RNDZ;
mpfr_init (x);
check (2, 1000);
/* check precision of 2 bits */
mpfr_set_prec (x, 2);
mpfr_const_log2 (x, MPFR_RNDN);
if (mpfr_cmp_ui_2exp(x, 3, -2)) /* 3*2^-2 */
{
printf ("mpfr_const_log2 failed for prec=2, rnd=MPFR_RNDN\n"
"expected 0.75, got ");
mpfr_out_str(stdout, 10, 0, x, MPFR_RNDN);
putchar('\n');
exit (1);
}
if (argc>=2)
{
mpfr_set_prec (x, p);
mpfr_const_log2 (x, rnd);
printf ("log(2)=");
mpfr_out_str (stdout, 10, 0, x, rnd);
puts ("");
}
mpfr_set_prec (x, 53);
mpfr_const_log2 (x, MPFR_RNDZ);
if (mpfr_cmp_str1 (x, "6.9314718055994530941e-1") )
{
printf ("mpfr_const_log2 failed for prec=53\n");
exit (1);
}
mpfr_set_prec (x, 32);
mpfr_const_log2 (x, MPFR_RNDN);
if (mpfr_cmp_str1 (x, "0.69314718060195446"))
{
printf ("mpfr_const_log2 failed for prec=32\n");
exit (1);
}
mpfr_clear(x);
check_large();
check_cache ();
test_generic (2, 200, 1);
tests_end_mpfr ();
return 0;
}
int
main (int argc, char *argv[])
{
mpfr_t x, y, z;
mpfr_prec_t prec, yprec;
mpfr_t t, s;
mpfr_rnd_t rnd;
int inexact, compare, compare2;
unsigned int n, err;
mpfr_prec_t p0=2, p1=100;
unsigned int N=25;
tests_start_mpfr ();
mpfr_init (x);
mpfr_init2 (y,sizeof(unsigned long int)*CHAR_BIT);
mpfr_init (z);
mpfr_init (s);
mpfr_init (t);
/* generic test */
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (s, sizeof(unsigned long int)*CHAR_BIT);
mpfr_set_prec (z, prec);
mpfr_set_prec (t, prec);
yprec = prec + 10;
for (n=0; n<N; n++)
{
mpfr_urandomb (x, RANDS);
mpfr_urandomb (s, RANDS);
if (randlimb () % 2)
mpfr_neg (s, s, MPFR_RNDN);
rnd = RND_RAND ();
mpfr_set_prec (y, yprec);
compare = mpfr_pow (y, x, s, rnd);
err = (rnd == MPFR_RNDN) ? yprec + 1 : yprec;
if (mpfr_can_round (y, err, rnd, rnd, prec))
{
mpfr_set (t, y, rnd);
inexact = mpfr_pow (z, x, s, rnd);
if (mpfr_cmp (t, z))
{
printf ("results differ for x^y with x=");
mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN);
printf (" y=");
mpfr_out_str (stdout, 2, 0, s, MPFR_RNDN);
printf (" prec=%u rnd_mode=%s\n", (unsigned int) prec,
mpfr_print_rnd_mode (rnd));
printf ("got ");
mpfr_out_str (stdout, 2, prec, z, MPFR_RNDN);
puts ("");
printf ("expected ");
mpfr_out_str (stdout, 2, prec, t, MPFR_RNDN);
puts ("");
printf ("approx ");
mpfr_print_binary (y);
puts ("");
exit (1);
}
compare2 = mpfr_cmp (t, y);
/* if rounding to nearest, cannot know the sign of t - f(x)
because of composed rounding: y = o(f(x)) and t = o(y) */
if ((rnd != MPFR_RNDN) && (compare * compare2 >= 0))
compare = compare + compare2;
else
compare = inexact; /* cannot determine sign(t-f(x)) */
if (((inexact == 0) && (compare != 0)) ||
((inexact > 0) && (compare <= 0)) ||
((inexact < 0) && (compare >= 0)))
{
printf ("Wrong inexact flag for rnd=%s: expected %d, got %d"
"\n", mpfr_print_rnd_mode (rnd), compare, inexact);
printf ("x="); mpfr_print_binary (x); puts ("");
printf ("y="); mpfr_print_binary (y); puts ("");
printf ("t="); mpfr_print_binary (t); puts ("");
exit (1);
}
}
}
}
mpfr_clear (s);
mpfr_clear (t);
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
tests_end_mpfr ();
return 0;
}
int
main (void)
{
mpfr_t x;
tests_start_mpfr ();
mpfr_init (x);
/* check +infinity gives non-zero for mpfr_inf_p only */
mpfr_set_ui (x, 1L, MPFR_RNDZ);
mpfr_div_ui (x, x, 0L, MPFR_RNDZ);
if (mpfr_nan_p (x) || (mpfr_nan_p) (x) )
{
printf ("Error: mpfr_nan_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) == 0)
{
printf ("Error: mpfr_inf_p(+Inf) gives zero\n");
exit (1);
}
if (mpfr_number_p (x) || (mpfr_number_p) (x) )
{
printf ("Error: mpfr_number_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p) (x) )
{
printf ("Error: mpfr_zero_p(+Inf) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(+Inf) gives non-zero\n");
exit (1);
}
/* same for -Inf */
mpfr_neg (x, x, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p(x)))
{
printf ("Error: mpfr_nan_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) == 0)
{
printf ("Error: mpfr_inf_p(-Inf) gives zero\n");
exit (1);
}
if (mpfr_number_p (x) || (mpfr_number_p)(x) )
{
printf ("Error: mpfr_number_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p)(x) )
{
printf ("Error: mpfr_zero_p(-Inf) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(-Inf) gives non-zero\n");
exit (1);
}
/* same for NaN */
mpfr_sub (x, x, x, MPFR_RNDN);
if (mpfr_nan_p (x) == 0)
{
printf ("Error: mpfr_nan_p(NaN) gives zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) || (mpfr_number_p) (x) )
{
printf ("Error: mpfr_number_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p)(x) )
{
printf ("Error: mpfr_number_p(NaN) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(NaN) gives non-zero\n");
exit (1);
}
/* same for a regular number */
mpfr_set_ui (x, 1, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p)(x))
{
printf ("Error: mpfr_nan_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0)
{
printf ("Error: mpfr_number_p(1) gives zero\n");
exit (1);
}
if (mpfr_zero_p (x) || (mpfr_zero_p) (x) )
{
printf ("Error: mpfr_zero_p(1) gives non-zero\n");
exit (1);
}
if (mpfr_regular_p (x) == 0 || (mpfr_regular_p) (x) == 0)
{
printf ("Error: mpfr_regular_p(1) gives zero\n");
exit (1);
}
/* Same for +0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p)(x))
{
printf ("Error: mpfr_nan_p(+0) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(+0) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0)
{
printf ("Error: mpfr_number_p(+0) gives zero\n");
exit (1);
}
if (mpfr_zero_p (x) == 0 )
{
printf ("Error: mpfr_zero_p(+0) gives zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(+0) gives non-zero\n");
exit (1);
}
/* Same for -0 */
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_neg (x, x, MPFR_RNDN);
if (mpfr_nan_p (x) || (mpfr_nan_p)(x))
{
printf ("Error: mpfr_nan_p(-0) gives non-zero\n");
exit (1);
}
if (mpfr_inf_p (x) || (mpfr_inf_p)(x) )
{
printf ("Error: mpfr_inf_p(-0) gives non-zero\n");
exit (1);
}
if (mpfr_number_p (x) == 0)
{
printf ("Error: mpfr_number_p(-0) gives zero\n");
exit (1);
}
if (mpfr_zero_p (x) == 0 )
{
printf ("Error: mpfr_zero_p(-0) gives zero\n");
exit (1);
}
if (mpfr_regular_p (x) || (mpfr_regular_p) (x) )
{
printf ("Error: mpfr_regular_p(-0) gives non-zero\n");
exit (1);
}
mpfr_clear (x);
tests_end_mpfr ();
return 0;
}
static void
check_mixed (void)
{
int ch = 'a';
#ifndef NPRINTF_HH
signed char sch = -1;
unsigned char uch = 1;
#endif
short sh = -1;
unsigned short ush = 1;
int i = -1;
int j = 1;
unsigned int ui = 1;
long lo = -1;
unsigned long ulo = 1;
float f = -1.25;
double d = -1.25;
#if !defined(NPRINTF_T) || !defined(NPRINTF_L)
long double ld = -1.25;
#endif
#ifndef NPRINTF_T
ptrdiff_t p = 1, saved_p;
#endif
size_t sz = 1;
mpz_t mpz;
mpq_t mpq;
mpf_t mpf;
mpfr_rnd_t rnd = MPFR_RNDN;
mpfr_t mpfr;
mpfr_prec_t prec;
mpz_init (mpz);
mpz_set_ui (mpz, ulo);
mpq_init (mpq);
mpq_set_si (mpq, lo, ulo);
mpf_init (mpf);
mpf_set_q (mpf, mpq);
mpfr_init (mpfr);
mpfr_set_f (mpfr, mpf, MPFR_RNDN);
prec = mpfr_get_prec (mpfr);
check_vprintf ("a. %Ra, b. %u, c. %lx%n", mpfr, ui, ulo, &j);
check_length (1, j, 22, d);
check_vprintf ("a. %c, b. %Rb, c. %u, d. %li%ln", i, mpfr, i, lo, &ulo);
check_length (2, ulo, 36, lu);
check_vprintf ("a. %hi, b. %*f, c. %Re%hn", ush, 3, f, mpfr, &ush);
check_length (3, ush, 29, hu);
check_vprintf ("a. %hi, b. %f, c. %#.2Rf%n", sh, d, mpfr, &i);
check_length (4, i, 29, d);
check_vprintf ("a. %R*A, b. %Fe, c. %i%zn", rnd, mpfr, mpf, sz, &sz);
check_length (5, (unsigned long) sz, 34, lu); /* no format specifier '%zu' in C89 */
check_vprintf ("a. %Pu, b. %c, c. %RUG, d. %Zi%Zn", prec, ch, mpfr, mpz, &mpz);
check_length_with_cmp (6, mpz, 24, mpz_cmp_ui (mpz, 24), Zi);
check_vprintf ("%% a. %#.0RNg, b. %Qx%Rn c. %p",
mpfr, mpq, &mpfr, (void *) &i);
check_length_with_cmp (7, mpfr, 15, mpfr_cmp_ui (mpfr, 15), Rg);
#ifndef NPRINTF_T
saved_p = p;
check_vprintf ("%% a. %RNg, b. %Qx, c. %td%tn", mpfr, mpq, p, &p);
if (p != 20)
mpfr_fprintf (stderr, "Error in test 8, got '%% a. %RNg, b. %Qx, c. %td'\n", mpfr, mpq, saved_p);
check_length (8, (long) p, 20, ld); /* no format specifier '%td' in C89 */
#endif
#ifndef NPRINTF_L
check_vprintf ("a. %RA, b. %Lf, c. %QX%zn", mpfr, ld, mpq, &sz);
check_length (9, (unsigned long) sz, 30, lu); /* no format specifier '%zu' in C89 */
#endif
#ifndef NPRINTF_HH
check_vprintf ("a. %hhi, b. %Ra, c. %hhu%hhn", sch, mpfr, uch, &uch);
check_length (10, (unsigned int) uch, 22, u); /* no format specifier '%hhu' in C89 */
#endif
#if defined(HAVE_LONG_LONG) && !defined(NPRINTF_LL)
{
long long llo = -1;
unsigned long long ullo = 1;
check_vprintf ("a. %Re, b. %llx%Qn", mpfr, ullo, &mpq);
check_length_with_cmp (11, mpq, 16, mpq_cmp_ui (mpq, 16, 1), Qu);
check_vprintf ("a. %lli, b. %Rf%lln", llo, mpfr, &ullo);
check_length (12, ullo, 19, llu);
}
#endif
#if defined(_MPFR_H_HAVE_INTMAX_T) && !defined(NPRINTF_J)
{
intmax_t im = -1;
uintmax_t uim = 1;
check_vprintf ("a. %*RA, b. %ji%Fn", 10, mpfr, im, &mpf);
check_length_with_cmp (31, mpf, 20, mpf_cmp_ui (mpf, 20), Fg);
check_vprintf ("a. %.*Re, b. %jx%jn", 10, mpfr, uim, &im);
check_length (32, (long) im, 25, li); /* no format specifier "%ji" in C89 */
}
#endif
mpfr_clear (mpfr);
mpf_clear (mpf);
mpq_clear (mpq);
mpz_clear (mpz);
}
static void
check_overflow (void)
{
mpfr_t x;
char *s;
mpfr_init (x);
/* Huge overflow */
mpfr_strtofr (x, "123456789E2147483646", &s, 0, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) )
{
printf ("Check overflow failed (1) with:\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
mpfr_strtofr (x, "123456789E9223372036854775807", &s, 0, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) )
{
printf ("Check overflow failed (2) with:\n s='%s'\n x=", s);
mpfr_dump (x);
exit (1);
}
mpfr_strtofr (x, "123456789E170141183460469231731687303715884105728",
&s, 0, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) )
{
printf ("Check overflow failed (3) with:\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
/* Limit overflow */
mpfr_strtofr (x, "12E2147483646", &s, 0, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x) )
{
printf ("Check overflow failed (4) with:\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
mpfr_strtofr (x, "12E2147483645", &s, 0, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x))
{
printf ("Check overflow failed (5) with:\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
mpfr_strtofr (x, "[email protected]", &s, 16, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x))
{
printf ("Check overflow failed (6) with:\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
mpfr_strtofr (x, "[email protected]", &s, 16, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_INF (x) || !MPFR_IS_POS (x))
{
printf ("Check overflow failed (7) with:\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
/* Check underflow */
mpfr_strtofr (x, "123456789E-2147483646", &s, 0, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_POS (x) )
{
printf ("Check underflow failed (1) with:\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
mpfr_strtofr (x, "123456789E-9223372036854775807", &s, 0, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_POS (x) )
{
printf ("Check underflow failed (2) with:\n s='%s'\n x=", s);
mpfr_dump (x);
exit (1);
}
mpfr_strtofr (x, "-123456789E-170141183460469231731687303715884105728",
&s, 0, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_NEG (x) )
{
printf ("Check underflow failed (3) with:\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
mpfr_strtofr (x, "[email protected]", &s, 16, MPFR_RNDN);
if (s[0] != 0 || !MPFR_IS_ZERO (x) || !MPFR_IS_POS (x))
{
printf ("Check overflow failed (7) with:\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
mpfr_clear (x);
}
static void
check_hard (void)
{
mpfr_t u, v, q, q2;
mp_prec_t precu, precv, precq;
int rnd;
int inex, inex2, i, j;
mpfr_init (q);
mpfr_init (q2);
mpfr_init (u);
mpfr_init (v);
for (precq = MPFR_PREC_MIN; precq <= 64; precq ++)
{
mpfr_set_prec (q, precq);
mpfr_set_prec (q2, precq + 1);
for (j = 0; j < 2; j++)
{
if (j == 0)
{
do
{
mpfr_random (q2);
}
while (mpfr_cmp_ui (q2, 0) == 0);
}
else /* use q2=1 */
mpfr_set_ui (q2, 1, GMP_RNDN);
for (precv = precq; precv <= 10 * precq; precv += precq)
{
mpfr_set_prec (v, precv);
do
{
mpfr_random (v);
}
while (mpfr_cmp_ui (v, 0) == 0);
for (precu = precq; precu <= 10 * precq; precu += precq)
{
mpfr_set_prec (u, precu);
mpfr_mul (u, v, q2, GMP_RNDN);
mpfr_nextbelow (u);
for (i = 0; i <= 2; i++)
{
for (rnd = 0; rnd < GMP_RND_MAX; rnd++)
{
inex = test_div (q, u, v, (mp_rnd_t) rnd);
inex2 = get_inexact (q, u, v);
if (inex_cmp (inex, inex2))
{
printf ("Wrong inexact flag for rnd=%s: expected %d, got %d\n",
mpfr_print_rnd_mode ((mp_rnd_t) rnd), inex2, inex);
printf ("u= "); mpfr_dump (u);
printf ("v= "); mpfr_dump (v);
printf ("q= "); mpfr_dump (q);
mpfr_set_prec (q2, precq + precv);
mpfr_mul (q2, q, v, GMP_RNDN);
printf ("q*v="); mpfr_dump (q2);
exit (1);
}
}
mpfr_nextabove (u);
}
}
}
}
}
mpfr_clear (q);
mpfr_clear (q2);
mpfr_clear (u);
mpfr_clear (v);
}
/******************************************************************************
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;
}
static void
check_inexact (void)
{
mpfr_t x, y, z, u;
mp_prec_t px, py, pu;
int inexact, cmp;
mp_rnd_t rnd;
mpfr_init (x);
mpfr_init (y);
mpfr_init (z);
mpfr_init (u);
mpfr_set_prec (x, 28);
mpfr_set_prec (y, 28);
mpfr_set_prec (z, 1023);
mpfr_set_str_binary (x, "0.1000001001101101111100010011E0");
mpfr_set_str (z, "48284762641021308813686974720835219181653367326353400027913400579340343320519877153813133510034402932651132854764198688352364361009429039801248971901380781746767119334993621199563870113045276395603170432175354501451429471578325545278975153148347684600400321033502982713296919861760382863826626093689036010394", 10, GMP_RNDN);
mpfr_div (x, x, z, GMP_RNDN);
mpfr_set_str_binary (y, "0.1111001011001101001001111100E-1023");
if (mpfr_cmp (x, y))
{
printf ("Error in mpfr_div for prec=28, RNDN\n");
printf ("Expected "); mpfr_dump (y);
printf ("Got "); mpfr_dump (x);
exit (1);
}
mpfr_set_prec (x, 53);
mpfr_set_str_binary (x, "0.11101100110010100011011000000100001111011111110010101E0");
mpfr_set_prec (u, 127);
mpfr_set_str_binary (u, "0.1000001100110110110101110110101101111000110000001111111110000000011111001010110100110010111111111101000001011011101011101101000E-2");
mpfr_set_prec (y, 95);
inexact = test_div (y, x, u, GMP_RNDN);
if (inexact != (cmp = get_inexact (y, x, u)))
{
printf ("Wrong inexact flag (0): expected %d, got %d\n", cmp, inexact);
printf ("x="); mpfr_out_str (stdout, 10, 99, x, GMP_RNDN); printf ("\n");
printf ("u="); mpfr_out_str (stdout, 10, 99, u, GMP_RNDN); printf ("\n");
printf ("y="); mpfr_out_str (stdout, 10, 99, y, GMP_RNDN); printf ("\n");
exit (1);
}
mpfr_set_prec (x, 33);
mpfr_set_str_binary (x, "0.101111100011011101010011101100001E0");
mpfr_set_prec (u, 2);
mpfr_set_str_binary (u, "0.1E0");
mpfr_set_prec (y, 28);
if ((inexact = test_div (y, x, u, GMP_RNDN) >= 0))
{
printf ("Wrong inexact flag (1): expected -1, got %d\n",
inexact);
exit (1);
}
mpfr_set_prec (x, 129);
mpfr_set_str_binary (x, "0.111110101111001100000101011100101100110011011101010001000110110101100101000010000001110110100001101010001010100010001111001101010E-2");
mpfr_set_prec (u, 15);
mpfr_set_str_binary (u, "0.101101000001100E-1");
mpfr_set_prec (y, 92);
if ((inexact = test_div (y, x, u, GMP_RNDN)) <= 0)
{
printf ("Wrong inexact flag for rnd=GMP_RNDN(1): expected 1, got %d\n",
inexact);
mpfr_dump (x);
mpfr_dump (u);
mpfr_dump (y);
exit (1);
}
for (px=2; px<MAX_PREC; px++)
{
mpfr_set_prec (x, px);
mpfr_random (x);
for (pu=2; pu<=MAX_PREC; pu++)
{
mpfr_set_prec (u, pu);
do { mpfr_random (u); } while (mpfr_cmp_ui (u, 0) == 0);
{
py = MPFR_PREC_MIN + (randlimb () % (MAX_PREC - MPFR_PREC_MIN));
mpfr_set_prec (y, py);
mpfr_set_prec (z, py + pu);
{
rnd = (mp_rnd_t) RND_RAND ();
inexact = test_div (y, x, u, rnd);
if (mpfr_mul (z, y, u, rnd))
{
printf ("z <- y * u should be exact\n");
exit (1);
}
cmp = mpfr_cmp (z, x);
if (((inexact == 0) && (cmp != 0)) ||
((inexact > 0) && (cmp <= 0)) ||
((inexact < 0) && (cmp >= 0)))
{
printf ("Wrong inexact flag for rnd=%s\n",
mpfr_print_rnd_mode(rnd));
printf ("expected %d, got %d\n", cmp, inexact);
printf ("x="); mpfr_print_binary (x); puts ("");
printf ("u="); mpfr_print_binary (u); puts ("");
printf ("y="); mpfr_print_binary (y); puts ("");
printf ("y*u="); mpfr_print_binary (z); puts ("");
exit (1);
}
}
}
}
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (u);
}
int
main (int argc, char *argv[])
{
mpfr_t x, y, z, s;
MPFR_SAVE_EXPO_DECL (expo);
tests_start_mpfr ();
mpfr_init (x);
mpfr_init (s);
mpfr_init (y);
mpfr_init (z);
/* check special cases */
mpfr_set_prec (x, 2);
mpfr_set_prec (y, 2);
mpfr_set_prec (z, 2);
mpfr_set_prec (s, 2);
mpfr_set_str (x, "-0.75", 10, MPFR_RNDN);
mpfr_set_str (y, "0.5", 10, MPFR_RNDN);
mpfr_set_str (z, "0.375", 10, MPFR_RNDN);
mpfr_fma (s, x, y, z, MPFR_RNDU); /* result is 0 */
if (mpfr_cmp_ui(s, 0))
{
printf("Error: -0.75 * 0.5 + 0.375 should be equal to 0 for prec=2\n");
exit(1);
}
mpfr_set_prec (x, 27);
mpfr_set_prec (y, 27);
mpfr_set_prec (z, 27);
mpfr_set_prec (s, 27);
mpfr_set_str_binary (x, "1.11111111111111111111111111e-1");
mpfr_set (y, x, MPFR_RNDN);
mpfr_set_str_binary (z, "-1.00011110100011001011001001e-1");
if (mpfr_fma (s, x, y, z, MPFR_RNDN) >= 0)
{
printf ("Wrong inexact flag for x=y=1-2^(-27)\n");
exit (1);
}
mpfr_set_nan (x);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x=NAN does not return NAN");
exit (1);
}
mpfr_set_nan (y);
mpfr_urandomb (x, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p(s))
{
printf ("evaluation of function in y=NAN does not return NAN");
exit (1);
}
mpfr_set_nan (z);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (x, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in z=NAN does not return NAN");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_set_inf (y, 1);
mpfr_set_inf (z, 1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("Error for (+inf) * (+inf) + (+inf)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_set_inf (y, -1);
mpfr_set_inf (z, 1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("Error for (-inf) * (-inf) + (+inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_set_inf (y, -1);
mpfr_set_inf (z, -1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) > 0)
{
printf ("Error for (+inf) * (-inf) + (-inf)\n");
exit (1);
}
mpfr_set_inf (x, -1);
mpfr_set_inf (y, 1);
mpfr_set_inf (z, -1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) > 0)
{
printf ("Error for (-inf) * (+inf) + (-inf)\n");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x=INF y=0 does not return NAN");
exit (1);
}
mpfr_set_inf (y, 1);
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x=0 y=INF does not return NAN");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_urandomb (y, RANDS); /* always positive */
mpfr_set_inf (z, -1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x=INF y>0 z=-INF does not return NAN");
exit (1);
}
mpfr_set_inf (y, 1);
mpfr_urandomb (x, RANDS);
mpfr_set_inf (z, -1);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_nan_p (s))
{
printf ("evaluation of function in x>0 y=INF z=-INF does not return NAN");
exit (1);
}
mpfr_set_inf (x, 1);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("evaluation of function in x=INF does not return INF");
exit (1);
}
mpfr_set_inf (y, 1);
mpfr_urandomb (x, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("evaluation of function in y=INF does not return INF");
exit (1);
}
mpfr_set_inf (z, 1);
mpfr_urandomb (x, RANDS);
mpfr_urandomb (y, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (!mpfr_inf_p (s) || mpfr_sgn (s) < 0)
{
printf ("evaluation of function in z=INF does not return INF");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (mpfr_cmp (s, z))
{
printf ("evaluation of function in x=0 does not return z\n");
exit (1);
}
mpfr_set_ui (y, 0, MPFR_RNDN);
mpfr_urandomb (x, RANDS);
mpfr_urandomb (z, RANDS);
mpfr_fma (s, x, y, z, MPFR_RNDN);
if (mpfr_cmp (s, z))
{
printf ("evaluation of function in y=0 does not return z\n");
exit (1);
}
{
mpfr_prec_t prec;
mpfr_t t, slong;
mpfr_rnd_t rnd;
int inexact, compare;
unsigned int n;
mpfr_prec_t p0=2, p1=200;
unsigned int N=200;
mpfr_init (t);
mpfr_init (slong);
/* generic test */
for (prec = p0; prec <= p1; prec++)
{
mpfr_set_prec (x, prec);
mpfr_set_prec (y, prec);
mpfr_set_prec (z, prec);
mpfr_set_prec (s, prec);
mpfr_set_prec (t, prec);
for (n=0; n<N; n++)
{
mpfr_urandomb (x, RANDS);
mpfr_urandomb (y, RANDS);
mpfr_urandomb (z, RANDS);
if (randlimb () % 2)
mpfr_neg (x, x, MPFR_RNDN);
if (randlimb () % 2)
mpfr_neg (y, y, MPFR_RNDN);
if (randlimb () % 2)
mpfr_neg (z, z, MPFR_RNDN);
rnd = RND_RAND ();
mpfr_set_prec (slong, 2 * prec);
if (mpfr_mul (slong, x, y, rnd))
{
printf ("x*y should be exact\n");
exit (1);
}
compare = mpfr_add (t, slong, z, rnd);
inexact = mpfr_fma (s, x, y, z, rnd);
if (mpfr_cmp (s, t))
{
printf ("results differ for x=");
mpfr_out_str (stdout, 2, prec, x, MPFR_RNDN);
printf (" y=");
mpfr_out_str (stdout, 2, prec, y, MPFR_RNDN);
printf (" z=");
mpfr_out_str (stdout, 2, prec, z, MPFR_RNDN);
printf (" prec=%u rnd_mode=%s\n", (unsigned int) prec,
mpfr_print_rnd_mode (rnd));
printf ("got ");
mpfr_out_str (stdout, 2, prec, s, MPFR_RNDN);
puts ("");
printf ("expected ");
mpfr_out_str (stdout, 2, prec, t, MPFR_RNDN);
puts ("");
printf ("approx ");
mpfr_print_binary (slong);
puts ("");
exit (1);
}
if (((inexact == 0) && (compare != 0)) ||
((inexact < 0) && (compare >= 0)) ||
((inexact > 0) && (compare <= 0)))
{
printf ("Wrong inexact flag for rnd=%s: expected %d, got %d\n",
mpfr_print_rnd_mode (rnd), compare, inexact);
printf (" x="); mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
printf (" y="); mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
printf (" z="); mpfr_out_str (stdout, 2, 0, z, MPFR_RNDN);
printf (" s="); mpfr_out_str (stdout, 2, 0, s, MPFR_RNDN);
printf ("\n");
exit (1);
}
}
}
mpfr_clear (t);
mpfr_clear (slong);
}
mpfr_clear (x);
mpfr_clear (y);
mpfr_clear (z);
mpfr_clear (s);
test_exact ();
MPFR_SAVE_EXPO_MARK (expo);
test_overflow1 ();
test_overflow2 ();
test_underflow1 ();
test_underflow2 ();
MPFR_SAVE_EXPO_FREE (expo);
tests_end_mpfr ();
return 0;
}
static void
check_for_zero (void)
{
/* Check that 0 is unsigned! */
mpq_t q;
mpz_t z;
mpfr_t x;
int r;
mpfr_sign_t i;
mpfr_init (x);
mpz_init (z);
mpq_init (q);
mpz_set_ui (z, 0);
mpq_set_ui (q, 0, 1);
MPFR_SET_ZERO (x);
RND_LOOP (r)
{
for (i = MPFR_SIGN_NEG ; i <= MPFR_SIGN_POS ;
i+=MPFR_SIGN_POS-MPFR_SIGN_NEG)
{
MPFR_SET_SIGN(x, i);
mpfr_add_z (x, x, z, (mpfr_rnd_t) r);
if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
{
printf("GMP Zero errors for add_z & rnd=%s & s=%d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
mpfr_dump (x);
exit (1);
}
mpfr_sub_z (x, x, z, (mpfr_rnd_t) r);
if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
{
printf("GMP Zero errors for sub_z & rnd=%s & s=%d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
mpfr_dump (x);
exit (1);
}
mpfr_mul_z (x, x, z, (mpfr_rnd_t) r);
if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
{
printf("GMP Zero errors for mul_z & rnd=%s & s=%d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
mpfr_dump (x);
exit (1);
}
mpfr_add_q (x, x, q, (mpfr_rnd_t) r);
if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
{
printf("GMP Zero errors for add_q & rnd=%s & s=%d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
mpfr_dump (x);
exit (1);
}
mpfr_sub_q (x, x, q, (mpfr_rnd_t) r);
if (!MPFR_IS_ZERO(x) || MPFR_SIGN(x)!=i)
{
printf("GMP Zero errors for sub_q & rnd=%s & s=%d\n",
mpfr_print_rnd_mode ((mpfr_rnd_t) r), i);
mpfr_dump (x);
exit (1);
}
}
}
mpq_clear (q);
mpz_clear (z);
mpfr_clear (x);
}
static void
check_special (void)
{
mpfr_t x, y;
int res;
char *s;
mpfr_init (x);
mpfr_init (y);
/* Check dummy case */
res = mpfr_strtofr (x, "1234567.89E1", NULL, 10, MPFR_RNDN);
mpfr_set_str (y, "1234567.89E1", 10, MPFR_RNDN);
if (mpfr_cmp (x, y))
{
printf ("Results differ between strtofr and set_str.\n"
" set_str gives: ");
mpfr_dump (y);
printf (" strtofr gives: ");
mpfr_dump (x);
exit (1);
}
/* Check NAN */
mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */
res = mpfr_strtofr (x, "NaN", &s, 10, MPFR_RNDN);
if (res != 0 || !mpfr_nan_p (x) || *s != 0)
{
printf ("Error for setting NAN (1)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */
res = mpfr_strtofr (x, "+NaN", &s, 10, MPFR_RNDN);
if (res != 0 || !mpfr_nan_p (x) || *s != 0)
{
printf ("Error for setting +NAN (1)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */
res = mpfr_strtofr (x, " -NaN", &s, 10, MPFR_RNDN);
if (res != 0 || !mpfr_nan_p (x) || *s != 0)
{
printf ("Error for setting -NAN (1)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */
res = mpfr_strtofr (x, "@[email protected]", &s, 16, MPFR_RNDN);
if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "xx") )
{
printf ("Error for setting NAN (2)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */
res = mpfr_strtofr (x, "NAN(abcdEDF__1256)Hello", &s, 10, MPFR_RNDN);
if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "Hello") )
{
printf ("Error for setting NAN (3)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */
res = mpfr_strtofr (x, "NAN(abcdEDF)__1256)Hello", &s, 10, MPFR_RNDN);
if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "__1256)Hello") )
{
printf ("Error for setting NAN (4)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */
res = mpfr_strtofr (x, "NAN(abc%dEDF)__1256)Hello", &s, 10, MPFR_RNDN);
if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "(abc%dEDF)__1256)Hello") )
{
printf ("Error for setting NAN (5)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */
res = mpfr_strtofr (x, "NAN((abc))", &s, 10, MPFR_RNDN);
if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "((abc))") )
{
printf ("Error for setting NAN (6)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN); /* make sure that x is modified */
res = mpfr_strtofr (x, "NAN()foo", &s, 10, MPFR_RNDN);
if (res != 0 || !mpfr_nan_p (x) || strcmp(s, "foo") )
{
printf ("Error for setting NAN (7)\n");
exit (1);
}
/* Check INF */
res = mpfr_strtofr (x, "INFINITY", &s, 8, MPFR_RNDN);
if (res != 0 || !mpfr_inf_p (x) || *s != 0)
{
printf ("Error for setting INFINITY (1)\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
res = mpfr_strtofr (x, "INFANITY", &s, 8, MPFR_RNDN);
if (res != 0 || !mpfr_inf_p (x) || strcmp(s, "ANITY"))
{
printf ("Error for setting INFINITY (2)\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
res = mpfr_strtofr (x, "@[email protected]*2", &s, 11, MPFR_RNDN);
if (res != 0 || !mpfr_inf_p (x) || strcmp(s, "*2"))
{
printf ("Error for setting INFINITY (3)\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
/* Check Zero */
res = mpfr_strtofr (x, " 00000", &s, 11, MPFR_RNDN);
if (res != 0 || !mpfr_zero_p (x) || s[0] != 0)
{
printf ("Error for setting ZERO (1)\n s=%s\n x=", s);
mpfr_dump (x);
exit (1);
}
/* Check base 62 */
res = mpfr_strtofr (x, "A", NULL, 62, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 10))
{
printf ("Error for setting 'A' in base 62\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
res = mpfr_strtofr (x, "a", NULL, 62, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 36))
{
printf ("Error for setting 'a' in base 62\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
res = mpfr_strtofr (x, "Z", NULL, 62, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 35))
{
printf ("Error for setting 'Z' in base 62\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
res = mpfr_strtofr (x, "z", NULL, 62, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 61))
{
printf ("Error for setting 'z' in base 62\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
res = mpfr_strtofr (x, "ZA", NULL, 62, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 2180))
{
printf ("Error for setting 'ZA' in base 62\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
res = mpfr_strtofr (x, "za", NULL, 62, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 3818))
{
printf ("Error for setting 'za' in base 62\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
res = mpfr_strtofr (x, "aZ", NULL, 62, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 2267))
{
printf ("Error for setting 'aZ' in base 62\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
res = mpfr_strtofr (x, "Az", NULL, 62, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 681))
{
printf ("Error for setting 'Az' in base 62\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
/* Check base 60 */
res = mpfr_strtofr (x, "Aa", NULL, 60, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 636))
{
printf ("Error for setting 'Aa' in base 60\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
res = mpfr_strtofr (x, "Zz", &s, 60, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 35) || strcmp(s, "z") )
{
printf ("Error for setting 'Zz' in base 60\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
/* Check base 61 */
res = mpfr_strtofr (x, "z", &s, 61, MPFR_RNDN);
if (res != 0 || mpfr_cmp_ui (x, 0) || strcmp(s, "z") )
{
printf ("Error for setting 'z' in base 61\n x=");
mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
putchar ('\n');
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
static void
special (void)
{
mpfr_t x, y;
int i;
mpfr_init (x);
mpfr_init (y);
mpfr_set_nan (x);
test_expm1 (y, x, MPFR_RNDN);
if (!mpfr_nan_p (y))
{
printf ("Error for expm1(NaN)\n");
exit (1);
}
mpfr_set_inf (x, 1);
test_expm1 (y, x, MPFR_RNDN);
if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
{
printf ("Error for expm1(+Inf)\n");
exit (1);
}
mpfr_set_inf (x, -1);
test_expm1 (y, x, MPFR_RNDN);
if (mpfr_cmp_si (y, -1))
{
printf ("Error for expm1(-Inf)\n");
exit (1);
}
mpfr_set_ui (x, 0, MPFR_RNDN);
test_expm1 (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
{
printf ("Error for expm1(+0)\n");
exit (1);
}
mpfr_neg (x, x, MPFR_RNDN);
test_expm1 (y, x, MPFR_RNDN);
if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0)
{
printf ("Error for expm1(-0)\n");
exit (1);
}
/* Check overflow of expm1(x) */
mpfr_clear_flags ();
mpfr_set_str_binary (x, "1.1E1000000000");
i = test_expm1 (x, x, MPFR_RNDN);
MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) > 0);
MPFR_ASSERTN (mpfr_overflow_p ());
MPFR_ASSERTN (i == 1);
mpfr_clear_flags ();
mpfr_set_str_binary (x, "1.1E1000000000");
i = test_expm1 (x, x, MPFR_RNDU);
MPFR_ASSERTN (MPFR_IS_INF (x) && MPFR_SIGN (x) > 0);
MPFR_ASSERTN (mpfr_overflow_p ());
MPFR_ASSERTN (i == 1);
mpfr_clear_flags ();
mpfr_set_str_binary (x, "1.1E1000000000");
i = test_expm1 (x, x, MPFR_RNDD);
MPFR_ASSERTN (!MPFR_IS_INF (x) && MPFR_SIGN (x) > 0);
MPFR_ASSERTN (mpfr_overflow_p ());
MPFR_ASSERTN (i == -1);
/* Check internal underflow of expm1 (x) */
mpfr_set_prec (x, 2);
mpfr_clear_flags ();
mpfr_set_str_binary (x, "-1.1E1000000000");
i = test_expm1 (x, x, MPFR_RNDN);
MPFR_ASSERTN (mpfr_cmp_si (x, -1) == 0);
MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ());
MPFR_ASSERTN (i == -1);
mpfr_set_str_binary (x, "-1.1E1000000000");
i = test_expm1 (x, x, MPFR_RNDD);
MPFR_ASSERTN (mpfr_cmp_si (x, -1) == 0);
MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ());
MPFR_ASSERTN (i == -1);
mpfr_set_str_binary (x, "-1.1E1000000000");
i = test_expm1 (x, x, MPFR_RNDZ);
MPFR_ASSERTN (mpfr_cmp_str (x, "-0.11", 2, MPFR_RNDN) == 0);
MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ());
MPFR_ASSERTN (i == 1);
mpfr_set_str_binary (x, "-1.1E1000000000");
i = test_expm1 (x, x, MPFR_RNDU);
MPFR_ASSERTN (mpfr_cmp_str (x, "-0.11", 2, MPFR_RNDN) == 0);
MPFR_ASSERTN (!mpfr_overflow_p () && !mpfr_underflow_p ());
MPFR_ASSERTN (i == 1);
mpfr_clear (x);
mpfr_clear (y);
}
