コード例 #1
0
ファイル: chebyshevformaux.c プロジェクト: windover/sollya
/* This function computes an interval bound for a polynomial in cheb basis.
   by using Clenshaw's method --
   The n coefficients are given in coeffs.*/
void evaluateChebPolynomialClenshaw(sollya_mpfi_t bound, int n, sollya_mpfi_t *coeffs, mpfi_t x,mpfi_t x0){
  int i;
  sollya_mpfi_t z, zz, z1,b0,b1;
  mpfr_t a, b;
  mp_prec_t prec;
  prec = sollya_mpfi_get_prec(bound);

  sollya_mpfi_init2(z, prec);
  sollya_mpfi_init2(zz, prec);
  sollya_mpfi_init2(z1, prec);
  sollya_mpfi_init2(b0, prec);
  sollya_mpfi_init2(b1, prec);
  mpfr_init2(a, prec);
  mpfr_init2(b, prec);

  sollya_mpfi_get_right(b,x);
  sollya_mpfi_get_left(a,x);
  sollya_mpfi_set_fr(z1,b);
  sollya_mpfi_sub_fr(z1,z1,a);
  sollya_mpfi_inv(z1,z1);
  sollya_mpfi_mul_ui(z,z1,2);
  /*z=2/(b-a)*/
  sollya_mpfi_set_fr(zz,b);
  mpfi_add_fr(zz,zz,a);
  sollya_mpfi_mul(zz,zz,z1);
  /*zz=(b+a)/(b-a)*/
  sollya_mpfi_mul(z,z,x0);
  sollya_mpfi_sub(z,z,zz);

  /*z=2/(b-a) * x0 - (b+a)/(b-a)*/

  /*Do the clenshaw algo*/
  /*b1:=[0.,0.];
    b0:=[0.,0.];
    for i from n to 2 by -1 do
    bb:=(((2&*z)&*b0) &-b1) &+L[i];
    b1:=b0;
    b0:=bb;
    end do;
    bb:=((z&*b0) &-b1) &+L[1];
    return bb;
  */
  sollya_mpfi_set_ui(b0,0);
  sollya_mpfi_set_ui(b1,0);

  for(i=n-1;i>0; i--){
    sollya_mpfi_mul(zz,z,b0);
    sollya_mpfi_mul_ui(zz,zz,2);
    sollya_mpfi_sub(zz,zz,b1);
    sollya_mpfi_add(zz,zz,coeffs[i]);
    sollya_mpfi_set(b1,b0);
    sollya_mpfi_set(b0,zz);
  }
  sollya_mpfi_mul(zz,z,b0);
  sollya_mpfi_sub(zz,zz,b1);
  sollya_mpfi_add(zz,zz,coeffs[0]);
  sollya_mpfi_set(bound, zz);

  sollya_mpfi_clear(zz);
  sollya_mpfi_clear(z);
  sollya_mpfi_clear(z1);
  sollya_mpfi_clear(b0);
  sollya_mpfi_clear(b1);
  mpfr_clear(b); mpfr_clear(a);
}
コード例 #2
0
ファイル: trandom.c プロジェクト: axDev-toolchain/mpfr
static void
test_urandomb (long nbtests, mpfr_prec_t prec, int verbose)
{
  mpfr_t x;
  int *tab, size_tab, k, sh, xn;
  double d, av = 0, var = 0, chi2 = 0, th;
  mpfr_exp_t emin;

  size_tab = (nbtests >= 1000 ? nbtests / 50 : 20);
  tab = (int *) calloc (size_tab, sizeof(int));
  if (tab == NULL)
    {
      fprintf (stderr, "trandom: can't allocate memory in test_urandomb\n");
      exit (1);
    }

  mpfr_init2 (x, prec);
  xn = 1 + (prec - 1) / mp_bits_per_limb;
  sh = xn * mp_bits_per_limb - prec;

  for (k = 0; k < nbtests; k++)
    {
      mpfr_urandomb (x, RANDS);
      /* check that lower bits are zero */
      if (MPFR_MANT(x)[0] & MPFR_LIMB_MASK(sh))
        {
          printf ("Error: mpfr_urandomb() returns invalid numbers:\n");
          mpfr_print_binary (x); puts ("");
          exit (1);
        }
      d = mpfr_get_d1 (x); av += d; var += d*d;
      tab[(int)(size_tab * d)]++;
    }

  /* coverage test */
  emin = mpfr_get_emin ();
  set_emin (1); /* the generated number in [0,1[ is not in the exponent
                        range, except if it is zero */
  k = mpfr_urandomb (x, RANDS);
  if (MPFR_IS_ZERO(x) == 0 && (k == 0 || mpfr_nan_p (x) == 0))
    {
      printf ("Error in mpfr_urandomb, expected NaN, got ");
      mpfr_dump (x);
      exit (1);
    }
  set_emin (emin);

  mpfr_clear (x);
  if (!verbose)
    {
      free(tab);
      return;
    }

  av /= nbtests;
  var = (var / nbtests) - av * av;

  th = (double)nbtests / size_tab;
  printf("Average = %.5f\nVariance = %.5f\n", av, var);
  printf("Repartition for urandomb. Each integer should be close to %d.\n",
         (int)th);

  for (k = 0; k < size_tab; k++)
    {
      chi2 += (tab[k] - th) * (tab[k] - th) / th;
      printf("%d ", tab[k]);
      if (((k+1) & 7) == 0)
        printf("\n");
    }

  printf("\nChi2 statistics value (with %d degrees of freedom) : %.5f\n\n",
         size_tab - 1, chi2);

  free(tab);
  return;
}
コード例 #3
0
ファイル: tadd.c プロジェクト: mahdiz/mpclib
void
check64 (void)
{
  mpfr_t x, t, u;

  mpfr_init (x);
  mpfr_init (t);
  mpfr_init (u);

  mpfr_set_prec (x, 29);
  mpfr_set_str_raw (x, "1.1101001000101111011010010110e-3");
  mpfr_set_prec (t, 58);
  mpfr_set_str_raw (t, "0.11100010011111001001100110010111110110011000000100101E-1");
  mpfr_set_prec (u, 29);
  mpfr_add (u, x, t, GMP_RNDD);
  mpfr_set_str_raw (t, "1.0101011100001000011100111110e-1");
  if (mpfr_cmp (u, t))
    {
      fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=29, prec(t)=58\n");
      printf ("expected "); mpfr_out_str (stdout, 2, 29, t, GMP_RNDN);
      putchar ('\n');
      printf ("got      "); mpfr_out_str (stdout, 2, 29, u, GMP_RNDN);
      putchar ('\n');
      exit(1);
    }

  mpfr_set_prec (x, 4);
  mpfr_set_str_raw (x, "-1.0E-2");
  mpfr_set_prec (t, 2);
  mpfr_set_str_raw (t, "-1.1e-2");
  mpfr_set_prec (u, 2);
  mpfr_add (u, x, t, GMP_RNDN);
  if (MPFR_MANT(u)[0] << 2)
    {
      fprintf (stderr, "result not normalized for prec=2\n");
      mpfr_print_binary (u); putchar ('\n');
      exit (1);
    }
  mpfr_set_str_raw (t, "-1.0e-1");
  if (mpfr_cmp (u, t))
    {
      fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=4, prec(t)=2\n");
      printf ("expected -1.0e-1\n");
      printf ("got      "); mpfr_out_str (stdout, 2, 4, u, GMP_RNDN);
      putchar ('\n');
      exit (1);
    }

  mpfr_set_prec (x, 8);
  mpfr_set_str_raw (x, "-0.10011010"); /* -77/128 */
  mpfr_set_prec (t, 4);
  mpfr_set_str_raw (t, "-1.110e-5"); /* -7/128 */
  mpfr_set_prec (u, 4);
  mpfr_add (u, x, t, GMP_RNDN); /* should give -5/8 */
  mpfr_set_str_raw (t, "-1.010e-1");
  if (mpfr_cmp (u, t)) {
    fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=8, prec(t)=4\n");
    printf ("expected -1.010e-1\n");
    printf ("got      "); mpfr_out_str (stdout, 2, 4, u, GMP_RNDN);
    putchar ('\n');
    exit (1);
  }

  mpfr_set_prec (x, 112); mpfr_set_prec (t, 98); mpfr_set_prec (u, 54);
  mpfr_set_str_raw (x, "-0.11111100100000000011000011100000101101010001000111E-401");
  mpfr_set_str_raw (t, "0.10110000100100000101101100011111111011101000111000101E-464");
  mpfr_add (u, x, t, GMP_RNDN);
  if (mpfr_cmp (u, x)) {
    fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=112, prec(t)=98\n");
    exit (1);
  }

  mpfr_set_prec (x, 92); mpfr_set_prec (t, 86); mpfr_set_prec (u, 53);
  mpfr_set_d (x, -5.03525136761487735093e-74, GMP_RNDN);
  mpfr_set_d (t, 8.51539046314262304109e-91, GMP_RNDN);
  mpfr_add (u, x, t, GMP_RNDN);
  if (mpfr_get_d1 (u) != -5.0352513676148773509283672e-74) {
    fprintf (stderr, "mpfr_add(u, x, t) failed for prec(x)=92, prec(t)=86\n");
    exit (1);
  }

  mpfr_set_prec(x, 53); mpfr_set_prec(t, 76); mpfr_set_prec(u, 76);
  mpfr_set_str_raw(x, "-0.10010010001001011011110000000000001010011011011110001E-32");
  mpfr_set_str_raw(t, "-0.1011000101110010000101111111011111010001110011110111100110101011110010011111");
  mpfr_sub(u, x, t, GMP_RNDU);
  mpfr_set_str_raw(t, "0.1011000101110010000101111111011100111111101010011011110110101011101000000100");
  if (mpfr_cmp(u,t)) {
    printf("expect "); mpfr_print_binary(t); putchar('\n');
    fprintf (stderr, "mpfr_add failed for precisions 53-76\n"); exit(1);
  }
  mpfr_set_prec(x, 53); mpfr_set_prec(t, 108); mpfr_set_prec(u, 108);
  mpfr_set_str_raw(x, "-0.10010010001001011011110000000000001010011011011110001E-32");
  mpfr_set_str_raw(t, "-0.101100010111001000010111111101111101000111001111011110011010101111001001111000111011001110011000000000111111");
  mpfr_sub(u, x, t, GMP_RNDU);
  mpfr_set_str_raw(t, "0.101100010111001000010111111101110011111110101001101111011010101110100000001011000010101110011000000000111111");
  if (mpfr_cmp(u,t)) {
    printf("expect "); mpfr_print_binary(t); putchar('\n');
    fprintf(stderr, "mpfr_add failed for precisions 53-108\n"); exit(1);
  }
  mpfr_set_prec(x, 97); mpfr_set_prec(t, 97); mpfr_set_prec(u, 97);
  mpfr_set_str_raw(x, "0.1111101100001000000001011000110111101000001011111000100001000101010100011111110010000000000000000E-39");
  mpfr_set_ui(t, 1, GMP_RNDN);
  mpfr_add(u, x, t, GMP_RNDN);
  mpfr_set_str_raw(x, "0.1000000000000000000000000000000000000000111110110000100000000101100011011110100000101111100010001E1");
  if (mpfr_cmp(u,x)) {
    fprintf(stderr, "mpfr_add failed for precision 97\n"); exit(1);
  }
  mpfr_set_prec(x, 128); mpfr_set_prec(t, 128); mpfr_set_prec(u, 128);
  mpfr_set_str_raw(x, "0.10101011111001001010111011001000101100111101000000111111111011010100001100011101010001010111111101111010100110111111100101100010E-4");
  mpfr_set(t, x, GMP_RNDN);
  mpfr_sub(u, x, t, GMP_RNDN);
  mpfr_set_prec(x, 96); mpfr_set_prec(t, 96); mpfr_set_prec(u, 96);
  mpfr_set_str_raw(x, "0.111000000001110100111100110101101001001010010011010011100111100011010100011001010011011011000010E-4");
  mpfr_set(t, x, GMP_RNDN);
  mpfr_sub(u, x, t, GMP_RNDN);
  mpfr_set_prec(x, 85); mpfr_set_prec(t, 85); mpfr_set_prec(u, 85);
  mpfr_set_str_raw(x, "0.1111101110100110110110100010101011101001100010100011110110110010010011101100101111100E-4");
  mpfr_set_str_raw(t, "0.1111101110100110110110100010101001001000011000111000011101100101110100001110101010110E-4");
  mpfr_sub(u, x, t, GMP_RNDU);
  mpfr_sub(x, x, t, GMP_RNDU);
  if (mpfr_cmp(x, u) != 0) {
    printf("Error in mpfr_sub: u=x-t and x=x-t give different results\n");
    exit(1);
  }
  if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] & 
      ((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) {
    printf("Error in mpfr_sub: result is not msb-normalized (1)\n"); exit(1);
  }
  mpfr_set_prec(x, 65); mpfr_set_prec(t, 65); mpfr_set_prec(u, 65);
  mpfr_set_str_raw(x, "0.10011010101000110101010000000011001001001110001011101011111011101E623");
  mpfr_set_str_raw(t, "0.10011010101000110101010000000011001001001110001011101011111011100E623");
  mpfr_sub(u, x, t, GMP_RNDU);
  if (mpfr_get_d1 (u) != 9.4349060620538533806e167) { /* 2^558 */
    printf("Error (1) in mpfr_sub\n"); exit(1);
  }

  mpfr_set_prec(x, 64); mpfr_set_prec(t, 64); mpfr_set_prec(u, 64);
  mpfr_set_str_raw(x, "0.1000011110101111011110111111000011101011101111101101101100000100E-220");
  mpfr_set_str_raw(t, "0.1000011110101111011110111111000011101011101111101101010011111101E-220");
  mpfr_add(u, x, t, GMP_RNDU);
  if ((MPFR_MANT(u)[0] & 1) != 1) { 
    printf("error in mpfr_add with rnd_mode=GMP_RNDU\n");
    printf("b=  "); mpfr_print_binary(x); putchar('\n');
    printf("c=  "); mpfr_print_binary(t); putchar('\n');
    printf("b+c="); mpfr_print_binary(u); putchar('\n');
    exit(1);
  }

  /* bug found by Norbert Mueller, 14 Sep 2000 */
  mpfr_set_prec(x, 56); mpfr_set_prec(t, 83); mpfr_set_prec(u, 10);
  mpfr_set_str_raw(x, "0.10001001011011001111101100110100000101111010010111010111E-7");
  mpfr_set_str_raw(t, "0.10001001011011001111101100110100000101111010010111010111000000000111110110110000100E-7");
  mpfr_sub(u, x, t, GMP_RNDU);

  /* array bound write found by Norbert Mueller, 26 Sep 2000 */
  mpfr_set_prec(x, 109); mpfr_set_prec(t, 153); mpfr_set_prec(u, 95);
  mpfr_set_str_raw(x,"0.1001010000101011101100111000110001111111111111111111111111111111111111111111111111111111111111100000000000000E33");
  mpfr_set_str_raw(t,"-0.100101000010101110110011100011000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011100101101000000100100001100110111E33");
  mpfr_add(u, x, t, GMP_RNDN);

  /* array bound writes found by Norbert Mueller, 27 Sep 2000 */
  mpfr_set_prec(x, 106); mpfr_set_prec(t, 53); mpfr_set_prec(u, 23);
  mpfr_set_str_raw(x, "-0.1000011110101111111001010001000100001011000000000000000000000000000000000000000000000000000000000000000000E-59");
  mpfr_set_str_raw(t, "-0.10000111101011111110010100010001101100011100110100000E-59");
  mpfr_sub(u, x, t, GMP_RNDN);
  mpfr_set_prec(x, 177); mpfr_set_prec(t, 217); mpfr_set_prec(u, 160);
  mpfr_set_str_raw(x, "-0.111010001011010000111001001010010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000E35");
  mpfr_set_str_raw(t, "0.1110100010110100001110010010100100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000111011010011100001111001E35");
  mpfr_add(u, x, t, GMP_RNDN);
  mpfr_set_prec(x, 214); mpfr_set_prec(t, 278); mpfr_set_prec(u, 207);
  mpfr_set_str_raw(x, "0.1000100110100110101101101101000000010000100111000001001110001000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000E66");
  mpfr_set_str_raw(t, "-0.10001001101001101011011011010000000100001001110000010011100010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001111011111001001100011E66");
  mpfr_add(u, x, t, GMP_RNDN);
  mpfr_set_prec(x, 32); mpfr_set_prec(t, 247); mpfr_set_prec(u, 223);
  mpfr_set_str_raw(x, "0.10000000000000000000000000000000E1");
  mpfr_set_str_raw(t, "0.1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111100000110001110100000100011110000101110110011101110100110110111111011010111100100000000000000000000000000E0");
  mpfr_sub(u, x, t, GMP_RNDN);
  if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] & 
      ((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) {
    printf("Error in mpfr_sub: result is not msb-normalized (2)\n"); exit(1);
  }

  /* bug found by Nathalie Revol, 21 March 2001 */
  mpfr_set_prec (x, 65);
  mpfr_set_prec (t, 65);
  mpfr_set_prec (u, 65);
  mpfr_set_str_raw (x, "0.11100100101101001100111011111111110001101001000011101001001010010E-35");
  mpfr_set_str_raw (t, "0.10000000000000000000000000000000000001110010010110100110011110000E1");
  mpfr_sub (u, t, x, GMP_RNDU);
  if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] & 
      ((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) {
    fprintf(stderr, "Error in mpfr_sub: result is not msb-normalized (3)\n");
    exit (1);
  }

  /* bug found by Fabrice Rouillier, 27 Mar 2001 */
  mpfr_set_prec (x, 107);
  mpfr_set_prec (t, 107);
  mpfr_set_prec (u, 107);
  mpfr_set_str_raw (x, "0.10111001001111010010001000000010111111011011011101000001001000101000000000000000000000000000000000000000000E315");
  mpfr_set_str_raw (t, "0.10000000000000000000000000000000000101110100100101110110000001100101011111001000011101111100100100111011000E350");
  mpfr_sub (u, x, t, GMP_RNDU);
  if ((MPFR_MANT(u)[(MPFR_PREC(u)-1)/mp_bits_per_limb] & 
      ((mp_limb_t)1<<(mp_bits_per_limb-1)))==0) {
    fprintf(stderr, "Error in mpfr_sub: result is not msb-normalized (4)\n");
    exit (1);
  }
  
  /* checks that NaN flag is correctly reset */
  mpfr_set_d (t, 1.0, GMP_RNDN);
  mpfr_set_d (u, 1.0, GMP_RNDN);
  mpfr_set_nan (x);
  mpfr_add (x, t, u, GMP_RNDN);
  if (mpfr_cmp_ui (x, 2)) {
    fprintf (stderr, "Error in mpfr_add: 1+1 gives %e\n", mpfr_get_d1 (x));
    exit (1);
  }

  mpfr_clear(x); mpfr_clear(t); mpfr_clear(u);
}
コード例 #4
0
ファイル: tlgamma.c プロジェクト: epowers/mpfr
static void
special (void)
{
  mpfr_t x, y;
  int inex;
  int sign;
  mpfr_exp_t emin, emax;

  mpfr_init (x);
  mpfr_init (y);

  mpfr_set_nan (x);
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  if (!mpfr_nan_p (y))
    {
      printf ("Error for lgamma(NaN)\n");
      exit (1);
    }

  mpfr_set_inf (x, -1);
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
    {
      printf ("Error for lgamma(-Inf)\n");
      exit (1);
    }

  mpfr_set_inf (x, 1);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
    {
      printf ("Error for lgamma(+Inf)\n");
      exit (1);
    }

  mpfr_set_ui (x, 0, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != 1)
    {
      printf ("Error for lgamma(+0)\n");
      exit (1);
    }

  mpfr_set_ui (x, 0, MPFR_RNDN);
  mpfr_neg (x, x, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0 || sign != -1)
    {
      printf ("Error for lgamma(-0)\n");
      exit (1);
    }

  mpfr_set_ui (x, 1, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
    {
      printf ("Error for lgamma(1)\n");
      exit (1);
    }

  mpfr_set_si (x, -1, MPFR_RNDN);
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  if (!mpfr_inf_p (y) || mpfr_sgn (y) < 0)
    {
      printf ("Error for lgamma(-1)\n");
      exit (1);
    }

  mpfr_set_ui (x, 2, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  if (MPFR_IS_NAN (y) || mpfr_cmp_ui (y, 0) || MPFR_IS_NEG (y) || sign != 1)
    {
      printf ("Error for lgamma(2)\n");
      exit (1);
    }

  mpfr_set_prec (x, 53);
  mpfr_set_prec (y, 53);

#define CHECK_X1 "1.0762904832837976166"
#define CHECK_Y1 "-0.039418362817587634939"

  mpfr_set_str (x, CHECK_X1, 10, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str (x, CHECK_Y1, 10, MPFR_RNDN);
  if (mpfr_equal_p (y, x) == 0 || sign != 1)
    {
      printf ("mpfr_lgamma("CHECK_X1") is wrong:\n"
              "expected ");
      mpfr_print_binary (x); putchar ('\n');
      printf ("got      ");
      mpfr_print_binary (y); putchar ('\n');
      exit (1);
    }

#define CHECK_X2 "9.23709516716202383435e-01"
#define CHECK_Y2 "0.049010669407893718563"
  mpfr_set_str (x, CHECK_X2, 10, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str (x, CHECK_Y2, 10, MPFR_RNDN);
  if (mpfr_equal_p (y, x) == 0 || sign != 1)
    {
      printf ("mpfr_lgamma("CHECK_X2") is wrong:\n"
              "expected ");
      mpfr_print_binary (x); putchar ('\n');
      printf ("got      ");
      mpfr_print_binary (y); putchar ('\n');
      exit (1);
    }

  mpfr_set_prec (x, 8);
  mpfr_set_prec (y, 175);
  mpfr_set_ui (x, 33, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDU);
  mpfr_set_prec (x, 175);
  mpfr_set_str_binary (x, "0.1010001100011101101011001101110010100001000001000001110011000001101100001111001001000101011011100100010101011110100111110101010100010011010010000101010111001100011000101111E7");
  if (mpfr_equal_p (x, y) == 0 || sign != 1)
    {
      printf ("Error in mpfr_lgamma (1)\n");
      exit (1);
    }

  mpfr_set_prec (x, 21);
  mpfr_set_prec (y, 8);
  mpfr_set_ui (y, 120, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (x, &sign, y, MPFR_RNDZ);
  mpfr_set_prec (y, 21);
  mpfr_set_str_binary (y, "0.111000101000001100101E9");
  if (mpfr_equal_p (x, y) == 0 || sign != 1)
    {
      printf ("Error in mpfr_lgamma (120)\n");
      printf ("Expected "); mpfr_print_binary (y); puts ("");
      printf ("Got      "); mpfr_print_binary (x); puts ("");
      exit (1);
    }

  mpfr_set_prec (x, 3);
  mpfr_set_prec (y, 206);
  mpfr_set_str_binary (x, "0.110e10");
  sign = -17;
  inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_prec (x, 206);
  mpfr_set_str_binary (x, "0.10000111011000000011100010101001100110001110000111100011000100100110110010001011011110101001111011110110000001010100111011010000000011100110110101100111000111010011110010000100010111101010001101000110101001E13");
  if (mpfr_equal_p (x, y) == 0 || sign != 1)
    {
      printf ("Error in mpfr_lgamma (768)\n");
      exit (1);
    }
  if (inex >= 0)
    {
      printf ("Wrong flag for mpfr_lgamma (768)\n");
      exit (1);
    }

  mpfr_set_prec (x, 4);
  mpfr_set_prec (y, 4);
  mpfr_set_str_binary (x, "0.1100E-66");
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.1100E6");
  if (mpfr_equal_p (x, y) == 0 || sign != 1)
    {
      printf ("Error for lgamma(0.1100E-66)\n");
      printf ("Expected ");
      mpfr_dump (x);
      printf ("Got      ");
      mpfr_dump (y);
      exit (1);
    }

  mpfr_set_prec (x, 256);
  mpfr_set_prec (y, 32);
  mpfr_set_si_2exp (x, -1, 200, MPFR_RNDN);
  mpfr_add_ui (x, x, 1, MPFR_RNDN);
  mpfr_div_2ui (x, x, 1, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_prec (x, 32);
  mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
  if (mpfr_equal_p (x, y) == 0 || sign != 1)
    {
      printf ("Error for lgamma(-2^199+0.5)\n");
      printf ("Got        ");
      mpfr_dump (y);
      printf ("instead of ");
      mpfr_dump (x);
      exit (1);
    }

  mpfr_set_prec (x, 256);
  mpfr_set_prec (y, 32);
  mpfr_set_si_2exp (x, -1, 200, MPFR_RNDN);
  mpfr_sub_ui (x, x, 1, MPFR_RNDN);
  mpfr_div_2ui (x, x, 1, MPFR_RNDN);
  sign = -17;
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_prec (x, 32);
  mpfr_set_str_binary (x, "-0.10001000111011111011000010100010E207");
  if (mpfr_equal_p (x, y) == 0 || sign != -1)
    {
      printf ("Error for lgamma(-2^199-0.5)\n");
      printf ("Got        ");
      mpfr_dump (y);
      printf ("with sign %d instead of ", sign);
      mpfr_dump (x);
      printf ("with sign -1.\n");
      exit (1);
    }

  mpfr_set_prec (x, 10);
  mpfr_set_prec (y, 10);
  mpfr_set_str_binary (x, "-0.1101111000E-3");
  inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, "10.01001011");
  if (mpfr_equal_p (x, y) == 0 || sign != -1 || inex >= 0)
    {
      printf ("Error for lgamma(-0.1101111000E-3)\n");
      printf ("Got        ");
      mpfr_dump (y);
      printf ("instead of ");
      mpfr_dump (x);
      printf ("with sign %d instead of -1 (inex=%d).\n", sign, inex);
      exit (1);
    }

  mpfr_set_prec (x, 18);
  mpfr_set_prec (y, 28);
  mpfr_set_str_binary (x, "-1.10001101010001101e-196");
  inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_prec (x, 28);
  mpfr_set_str_binary (x, "0.100001110110101011011010011E8");
  MPFR_ASSERTN (mpfr_equal_p (x, y) && inex < 0);

  /* values reported by Kaveh Ghazi on 14 Jul 2007, where mpfr_lgamma()
     takes forever */
#define VAL1 "-0.11100001001010110111001010001001001011110100110000110E-55"
#define OUT1 "100110.01000000010111001110110101110101001001100110111"
#define VAL2 "-0.11100001001010110111001010001001001011110011111111100E-55"
#define OUT2 "100110.0100000001011100111011010111010100100110011111"
#define VAL3 "-0.11100001001010110111001010001001001001110101101010100E-55"
#define OUT3 "100110.01000000010111001110110101110101001011110111011"
#define VAL4 "-0.10001111110110110100100100000000001111110001001001011E-57"
#define OUT4 "101000.0001010111110011101101000101111111010001100011"
#define VAL5 "-0.10001111110110110100100100000000001111011111100001000E-57"
#define OUT5 "101000.00010101111100111011010001011111110100111000001"
#define VAL6 "-0.10001111110110110100100100000000001111011101100011001E-57"
#define OUT6 "101000.0001010111110011101101000101111111010011101111"

  mpfr_set_prec (x, 53);
  mpfr_set_prec (y, 53);

  mpfr_set_str_binary (x, VAL1);
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, OUT1);
  MPFR_ASSERTN(sign == -1 && mpfr_equal_p(x, y));

  mpfr_set_str_binary (x, VAL2);
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, OUT2);
  MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));

  mpfr_set_str_binary (x, VAL3);
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, OUT3);
  MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));

  mpfr_set_str_binary (x, VAL4);
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, OUT4);
  MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));

  mpfr_set_str_binary (x, VAL5);
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, OUT5);
  MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));

  mpfr_set_str_binary (x, VAL6);
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, OUT6);
  MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));

  /* further test from Kaveh Ghazi */
  mpfr_set_str_binary (x, "-0.10011010101001010010001110010111010111011101010111001E-53");
  mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, "100101.00111101101010000000101010111010001111001101111");
  MPFR_ASSERTN(sign == -1 && mpfr_equal_p (x, y));

  /* bug found by Kevin Rauch on 26 Oct 2007 */
  emin = mpfr_get_emin ();
  emax = mpfr_get_emax ();
  mpfr_set_emin (-1000000000);
  mpfr_set_emax (1000000000);
  mpfr_set_ui (x, 1, MPFR_RNDN);
  mpfr_lgamma (x, &sign, x, MPFR_RNDN);
  MPFR_ASSERTN(mpfr_get_emin () == -1000000000);
  MPFR_ASSERTN(mpfr_get_emax () == 1000000000);
  mpfr_set_emin (emin);
  mpfr_set_emax (emax);

  /* two other bugs reported by Kevin Rauch on 27 Oct 2007 */
  mpfr_set_prec (x, 128);
  mpfr_set_prec (y, 128);
  mpfr_set_str_binary (x, "0.11000110011110111111110010100110000000000000000000000000000000000000000000000000000000000000000001000011000110100100110111101010E-765689");
  inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_str_binary (x, "10000001100100101111011011010000111010001001110000111010011000101001011111011111110011011010110100101111110111001001010100011101E-108");
  MPFR_ASSERTN(inex < 0 && mpfr_cmp (y, x) == 0 && sign > 0);

  mpfr_set_prec (x, 128);
  mpfr_set_prec (y, 256);
  mpfr_set_str_binary (x, "0.1011111111111111100000111011111E-31871");
  inex = mpfr_lgamma (y, &sign, x, MPFR_RNDN);
  mpfr_set_prec (x, 256);
  mpfr_set_str (x, "AC9729B83707E6797612D0D76DAF42B1240A677FF1B6E3783FD4E53037143B1P-237", 16, MPFR_RNDN);
  MPFR_ASSERTN(inex < 0 && mpfr_cmp (y, x) == 0 && sign > 0);

  mpfr_clear (x);
  mpfr_clear (y);
}
コード例 #5
0
ファイル: tsech.c プロジェクト: Scorpiion/Renux_cross_gcc
static void
overflowed_sech0 (void)
{
  mpfr_t x, y;
  int emax, i, inex, rnd, err = 0;
  mp_exp_t old_emax;

  old_emax = mpfr_get_emax ();

  mpfr_init2 (x, 8);
  mpfr_init2 (y, 8);

  for (emax = -1; emax <= 0; emax++)
    {
      mpfr_set_ui_2exp (y, 1, emax, GMP_RNDN);
      mpfr_nextbelow (y);
      set_emax (emax);  /* 1 is not representable. */
      /* and if emax < 0, 1 - eps is not representable either. */
      for (i = -1; i <= 1; i++)
        RND_LOOP (rnd)
          {
            mpfr_set_si_2exp (x, i, -512 * ABS (i), GMP_RNDN);
            mpfr_clear_flags ();
            inex = mpfr_sech (x, x, (mp_rnd_t) rnd);
            if ((i == 0 || emax < 0 || rnd == GMP_RNDN || rnd == GMP_RNDU) &&
                ! mpfr_overflow_p ())
              {
                printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
                        "  The overflow flag is not set.\n",
                        i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
                err = 1;
              }
            if (rnd == GMP_RNDZ || rnd == GMP_RNDD)
              {
                if (inex >= 0)
                  {
                    printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
                            "  The inexact value must be negative.\n",
                            i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
                    err = 1;
                  }
                if (! mpfr_equal_p (x, y))
                  {
                    printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
                            "  Got ", i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
                    mpfr_print_binary (x);
                    printf (" instead of 0.11111111E%d.\n", emax);
                    err = 1;
                  }
              }
            else
              {
                if (inex <= 0)
                  {
                    printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
                            "  The inexact value must be positive.\n",
                            i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
                    err = 1;
                  }
                if (! (mpfr_inf_p (x) && MPFR_SIGN (x) > 0))
                  {
                    printf ("Error in overflowed_sech0 (i = %d, rnd = %s):\n"
                            "  Got ", i, mpfr_print_rnd_mode ((mp_rnd_t) rnd));
                    mpfr_print_binary (x);
                    printf (" instead of +Inf.\n");
                    err = 1;
                  }
              }
          }
      set_emax (old_emax);
    }

  if (err)
    exit (1);
  mpfr_clear (x);
  mpfr_clear (y);
}
コード例 #6
0
ファイル: gmp_caml.c プロジェクト: nberth/mlgmpidl
void camlidl_custom_mpfr_finalize(value val)
{
    __mpfr_struct* mpfr = (__mpfr_struct*)(Data_custom_val(val));
    mpfr_clear(mpfr);
}
コード例 #7
0
ファイル: log10.c プロジェクト: mmanley/Antares
int
mpfr_log10 (mpfr_ptr r, mpfr_srcptr a, mp_rnd_t rnd_mode)
{
  int inexact;
  MPFR_SAVE_EXPO_DECL (expo);

  /* If a is NaN, the result is NaN */
  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (a)))
    {
      if (MPFR_IS_NAN (a))
        {
          MPFR_SET_NAN (r);
          MPFR_RET_NAN;
        }
      /* check for infinity before zero */
      else if (MPFR_IS_INF (a))
        {
          if (MPFR_IS_NEG (a))
            /* log10(-Inf) = NaN */
            {
              MPFR_SET_NAN (r);
              MPFR_RET_NAN;
            }
          else /* log10(+Inf) = +Inf */
            {
              MPFR_SET_INF (r);
              MPFR_SET_POS (r);
              MPFR_RET (0); /* exact */
            }
        }
      else /* a = 0 */
        {
          MPFR_ASSERTD (MPFR_IS_ZERO (a));
          MPFR_SET_INF (r);
          MPFR_SET_NEG (r);
          MPFR_RET (0); /* log10(0) is an exact -infinity */
        }
    }

  /* If a is negative, the result is NaN */
  if (MPFR_UNLIKELY (MPFR_IS_NEG (a)))
    {
      MPFR_SET_NAN (r);
      MPFR_RET_NAN;
    }

  /* If a is 1, the result is 0 */
  if (mpfr_cmp_ui (a, 1) == 0)
    {
      MPFR_SET_ZERO (r);
      MPFR_SET_POS (r);
      MPFR_RET (0); /* result is exact */
    }

  MPFR_SAVE_EXPO_MARK (expo);

  /* General case */
  {
    /* Declaration of the intermediary variable */
    mpfr_t t, tt;
    MPFR_ZIV_DECL (loop);
    /* Declaration of the size variable */
    mp_prec_t Ny = MPFR_PREC(r);   /* Precision of output variable */
    mp_prec_t Nt;        /* Precision of the intermediary variable */
    mp_exp_t  err;                           /* Precision of error */

    /* compute the precision of intermediary variable */
    /* the optimal number of bits : see algorithms.tex */
    Nt = Ny + 4 + MPFR_INT_CEIL_LOG2 (Ny);

    /* initialise of intermediary variables */
    mpfr_init2 (t, Nt);
    mpfr_init2 (tt, Nt);

    /* First computation of log10 */
    MPFR_ZIV_INIT (loop, Nt);
    for (;;)
      {
        /* compute log10 */
        mpfr_set_ui (t, 10, GMP_RNDN);   /* 10 */
        mpfr_log (t, t, GMP_RNDD);       /* log(10) */
        mpfr_log (tt, a, GMP_RNDN);      /* log(a) */
        mpfr_div (t, tt, t, GMP_RNDN);   /* log(a)/log(10) */

        /* estimation of the error */
        err = Nt - 4;
        if (MPFR_LIKELY (MPFR_CAN_ROUND (t, err, Ny, rnd_mode)))
          break;

        /* log10(10^n) is exact:
           FIXME: Can we have 10^n exactly representable as a mpfr_t
           but n can't fit an unsigned long? */
        if (MPFR_IS_POS (t)
            && mpfr_integer_p (t) && mpfr_fits_ulong_p (t, GMP_RNDN)
            && !mpfr_ui_pow_ui (tt, 10, mpfr_get_ui (t, GMP_RNDN), GMP_RNDN)
            && mpfr_cmp (a, tt) == 0)
          break;

        /* actualisation of the precision */
        MPFR_ZIV_NEXT (loop, Nt);
        mpfr_set_prec (t, Nt);
        mpfr_set_prec (tt, Nt);
      }
    MPFR_ZIV_FREE (loop);

    inexact = mpfr_set (r, t, rnd_mode);

    mpfr_clear (t);
    mpfr_clear (tt);
  }

  MPFR_SAVE_EXPO_FREE (expo);
  return mpfr_check_range (r, inexact, rnd_mode);
}
コード例 #8
0
ファイル: yn.c プロジェクト: Kirija/XPIR
/* compute in s an approximation of
   S3 = c*sum((h(k)+h(n+k))*y^k/k!/(n+k)!,k=0..infinity)
   where h(k) = 1 + 1/2 + ... + 1/k
   k=0: h(n)
   k=1: 1+h(n+1)
   k=2: 3/2+h(n+2)
   Returns e such that the error is bounded by 2^e ulp(s).
*/
static mpfr_exp_t
mpfr_yn_s3 (mpfr_ptr s, mpfr_srcptr y, mpfr_srcptr c, unsigned long n)
{
  unsigned long k, zz;
  mpfr_t t, u;
  mpz_t p, q; /* p/q will store h(k)+h(n+k) */
  mpfr_exp_t exps, expU;

  zz = mpfr_get_ui (y, MPFR_RNDU); /* y = z^2/4 */
  MPFR_ASSERTN (zz < ULONG_MAX - 2);
  zz += 2; /* z^2 <= 2^zz */
  mpz_init_set_ui (p, 0);
  mpz_init_set_ui (q, 1);
  /* initialize p/q to h(n) */
  for (k = 1; k <= n; k++)
    {
      /* p/q + 1/k = (k*p+q)/(q*k) */
      mpz_mul_ui (p, p, k);
      mpz_add (p, p, q);
      mpz_mul_ui (q, q, k);
    }
  mpfr_init2 (t, MPFR_PREC(s));
  mpfr_init2 (u, MPFR_PREC(s));
  mpfr_fac_ui (t, n, MPFR_RNDN);
  mpfr_div (t, c, t, MPFR_RNDN);    /* c/n! */
  mpfr_mul_z (u, t, p, MPFR_RNDN);
  mpfr_div_z (s, u, q, MPFR_RNDN);
  exps = MPFR_EXP (s);
  expU = exps;
  for (k = 1; ;k ++)
    {
      /* update t */
      mpfr_mul (t, t, y, MPFR_RNDN);
      mpfr_div_ui (t, t, k, MPFR_RNDN);
      mpfr_div_ui (t, t, n + k, MPFR_RNDN);
      /* update p/q:
         p/q + 1/k + 1/(n+k) = [p*k*(n+k) + q*(n+k) + q*k]/(q*k*(n+k)) */
      mpz_mul_ui (p, p, k);
      mpz_mul_ui (p, p, n + k);
      mpz_addmul_ui (p, q, n + 2 * k);
      mpz_mul_ui (q, q, k);
      mpz_mul_ui (q, q, n + k);
      mpfr_mul_z (u, t, p, MPFR_RNDN);
      mpfr_div_z (u, u, q, MPFR_RNDN);
      exps = MPFR_EXP (u);
      if (exps > expU)
        expU = exps;
      mpfr_add (s, s, u, MPFR_RNDN);
      exps = MPFR_EXP (s);
      if (exps > expU)
        expU = exps;
      if (MPFR_EXP (u) + (mpfr_exp_t) MPFR_PREC (u) < MPFR_EXP (s) &&
          zz / (2 * k) < k + n)
        break;
    }
  mpfr_clear (t);
  mpfr_clear (u);
  mpz_clear (p);
  mpz_clear (q);
  exps = expU - MPFR_EXP (s);
  /* the error is bounded by (6k^2+33/2k+11) 2^exps ulps
     <= 8*(k+2)^2 2^exps ulps */
  return 3 + 2 * MPFR_INT_CEIL_LOG2(k + 2) + exps;
}
コード例 #9
0
ファイル: turandom.c プロジェクト: BrianGladman/mpfr
static void
test_urandom (long nbtests, mpfr_prec_t prec, mpfr_rnd_t rnd, long bit_index,
              int verbose)
{
  mpfr_t x;
  int *tab, size_tab, k, sh, xn;
  double d, av = 0, var = 0, chi2 = 0, th;
  mpfr_exp_t emin;
  mp_size_t limb_index = 0;
  mp_limb_t limb_mask = 0;
  long count = 0;
  int i;
  int inex = 1;

  size_tab = (nbtests >= 1000 ? nbtests / 50 : 20);
  tab = (int *) calloc (size_tab, sizeof(int));
  if (tab == NULL)
    {
      fprintf (stderr, "trandom: can't allocate memory in test_urandom\n");
      exit (1);
    }

  mpfr_init2 (x, prec);
  xn = 1 + (prec - 1) / mp_bits_per_limb;
  sh = xn * mp_bits_per_limb - prec;
  if (bit_index >= 0 && bit_index < prec)
    {
      /* compute the limb index and limb mask to fetch the bit #bit_index */
      limb_index = (prec - bit_index) / mp_bits_per_limb;
      i = 1 + bit_index - (bit_index / mp_bits_per_limb) * mp_bits_per_limb;
      limb_mask = MPFR_LIMB_ONE << (mp_bits_per_limb - i);
    }

  for (k = 0; k < nbtests; k++)
    {
      i = mpfr_urandom (x, RANDS, rnd);
      inex = (i != 0) && inex;
      /* check that lower bits are zero */
      if (MPFR_MANT(x)[0] & MPFR_LIMB_MASK(sh) && !MPFR_IS_ZERO (x))
        {
          printf ("Error: mpfr_urandom() returns invalid numbers:\n");
          mpfr_dump (x);
          exit (1);
        }
      /* check that the value is in [0,1] */
      if (mpfr_cmp_ui (x, 0) < 0 || mpfr_cmp_ui (x, 1) > 0)
        {
          printf ("Error: mpfr_urandom() returns number outside [0, 1]:\n");
          mpfr_dump (x);
          exit (1);
        }

      d = mpfr_get_d1 (x); av += d; var += d*d;
      i = (int)(size_tab * d);
      if (d == 1.0) i --;
      tab[i]++;

      if (limb_mask && (MPFR_MANT (x)[limb_index] & limb_mask))
        count ++;
    }

  if (inex == 0)
    {
      /* one call in the loop pretended to return an exact number! */
      printf ("Error: mpfr_urandom() returns a zero ternary value.\n");
      exit (1);
    }

  /* coverage test */
  emin = mpfr_get_emin ();
  for (k = 0; k < 5; k++)
    {
      set_emin (k+1);
      inex = mpfr_urandom (x, RANDS, rnd);
      if ((   (rnd == MPFR_RNDZ || rnd == MPFR_RNDD)
              && (!MPFR_IS_ZERO (x) || inex != -1))
          || ((rnd == MPFR_RNDU || rnd == MPFR_RNDA)
              && (mpfr_cmp_ui (x, 1 << k) != 0 || inex != +1))
          || (rnd == MPFR_RNDN
              && (k > 0 || mpfr_cmp_ui (x, 1 << k) != 0 || inex != +1)
              && (!MPFR_IS_ZERO (x) || inex != -1)))
        {
          printf ("Error: mpfr_urandom() does not handle correctly"
                  " a restricted exponent range.\nemin = %d\n"
                  "rounding mode: %s\nternary value: %d\nrandom value: ",
                  k+1, mpfr_print_rnd_mode (rnd), inex);
          mpfr_dump (x);
          exit (1);
        }
    }
  set_emin (emin);

  mpfr_clear (x);
  if (!verbose)
    {
      free(tab);
      return;
    }

  av /= nbtests;
  var = (var / nbtests) - av * av;

  th = (double)nbtests / size_tab;
  printf ("Average = %.5f\nVariance = %.5f\n", av, var);
  printf ("Repartition for urandom with rounding mode %s. "
          "Each integer should be close to %d.\n",
         mpfr_print_rnd_mode (rnd), (int)th);

  for (k = 0; k < size_tab; k++)
    {
      chi2 += (tab[k] - th) * (tab[k] - th) / th;
      printf("%d ", tab[k]);
      if (((k+1) & 7) == 0)
        printf("\n");
    }

  printf("\nChi2 statistics value (with %d degrees of freedom) : %.5f\n",
         size_tab - 1, chi2);

  if (limb_mask)
    printf ("Bit #%ld is set %ld/%ld = %.1f %% of time\n",
            bit_index, count, nbtests, count * 100.0 / nbtests);

  puts ("");

  free(tab);
  return;
}
コード例 #10
0
ファイル: trint.c プロジェクト: epowers/mpfr
int
main (int argc, char *argv[])
{
  mp_size_t s;
  mpz_t z;
  mpfr_prec_t p;
  mpfr_t x, y, t, u, v;
  int r;
  int inexact, sign_t;

  tests_start_mpfr ();

  mpfr_init (x);
  mpfr_init (y);
  mpz_init (z);
  mpfr_init (t);
  mpfr_init (u);
  mpfr_init (v);
  mpz_set_ui (z, 1);
  for (s = 2; s < 100; s++)
    {
      /* z has exactly s bits */

      mpz_mul_2exp (z, z, 1);
      if (randlimb () % 2)
        mpz_add_ui (z, z, 1);
      mpfr_set_prec (x, s);
      mpfr_set_prec (t, s);
      mpfr_set_prec (u, s);
      if (mpfr_set_z (x, z, MPFR_RNDN))
        {
          printf ("Error: mpfr_set_z should be exact (s = %u)\n",
                  (unsigned int) s);
          exit (1);
        }
      if (randlimb () % 2)
        mpfr_neg (x, x, MPFR_RNDN);
      if (randlimb () % 2)
        mpfr_div_2ui (x, x, randlimb () % s, MPFR_RNDN);
      for (p = 2; p < 100; p++)
        {
          int trint;
          mpfr_set_prec (y, p);
          mpfr_set_prec (v, p);
          for (r = 0; r < MPFR_RND_MAX ; r++)
            for (trint = 0; trint < 3; trint++)
              {
                if (trint == 2)
                  inexact = mpfr_rint (y, x, (mpfr_rnd_t) r);
                else if (r == MPFR_RNDN)
                  inexact = mpfr_round (y, x);
                else if (r == MPFR_RNDZ)
                  inexact = (trint ? mpfr_trunc (y, x) :
                             mpfr_rint_trunc (y, x, MPFR_RNDZ));
                else if (r == MPFR_RNDU)
                  inexact = (trint ? mpfr_ceil (y, x) :
                             mpfr_rint_ceil (y, x, MPFR_RNDU));
                else /* r = MPFR_RNDD */
                  inexact = (trint ? mpfr_floor (y, x) :
                             mpfr_rint_floor (y, x, MPFR_RNDD));
                if (mpfr_sub (t, y, x, MPFR_RNDN))
                  err ("subtraction 1 should be exact",
                       s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                sign_t = mpfr_cmp_ui (t, 0);
                if (trint != 0 &&
                    (((inexact == 0) && (sign_t != 0)) ||
                     ((inexact < 0) && (sign_t >= 0)) ||
                     ((inexact > 0) && (sign_t <= 0))))
                  err ("wrong inexact flag", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                if (inexact == 0)
                  continue; /* end of the test for exact results */

                if (((r == MPFR_RNDD || (r == MPFR_RNDZ && MPFR_SIGN (x) > 0))
                     && inexact > 0) ||
                    ((r == MPFR_RNDU || (r == MPFR_RNDZ && MPFR_SIGN (x) < 0))
                     && inexact < 0))
                  err ("wrong rounding direction",
                       s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                if (inexact < 0)
                  {
                    mpfr_add_ui (v, y, 1, MPFR_RNDU);
                    if (mpfr_cmp (v, x) <= 0)
                      err ("representable integer between x and its "
                           "rounded value", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                  }
                else
                  {
                    mpfr_sub_ui (v, y, 1, MPFR_RNDD);
                    if (mpfr_cmp (v, x) >= 0)
                      err ("representable integer between x and its "
                           "rounded value", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                  }
                if (r == MPFR_RNDN)
                  {
                    int cmp;
                    if (mpfr_sub (u, v, x, MPFR_RNDN))
                      err ("subtraction 2 should be exact",
                           s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                    cmp = mpfr_cmp_abs (t, u);
                    if (cmp > 0)
                      err ("faithful rounding, but not the nearest integer",
                           s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                    if (cmp < 0)
                      continue;
                    /* |t| = |u|: x is the middle of two consecutive
                       representable integers. */
                    if (trint == 2)
                      {
                        /* halfway case for mpfr_rint in MPFR_RNDN rounding
                           mode: round to an even integer or significand. */
                        mpfr_div_2ui (y, y, 1, MPFR_RNDZ);
                        if (!mpfr_integer_p (y))
                          err ("halfway case for mpfr_rint, result isn't an"
                               " even integer", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                        /* If floor(x) and ceil(x) aren't both representable
                           integers, the significand must be even. */
                        mpfr_sub (v, v, y, MPFR_RNDN);
                        mpfr_abs (v, v, MPFR_RNDN);
                        if (mpfr_cmp_ui (v, 1) != 0)
                          {
                            mpfr_div_2si (y, y, MPFR_EXP (y) - MPFR_PREC (y)
                                          + 1, MPFR_RNDN);
                            if (!mpfr_integer_p (y))
                              err ("halfway case for mpfr_rint, significand isn't"
                                   " even", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                          }
                      }
                    else
                      { /* halfway case for mpfr_round: x must have been
                           rounded away from zero. */
                        if ((MPFR_SIGN (x) > 0 && inexact < 0) ||
                            (MPFR_SIGN (x) < 0 && inexact > 0))
                          err ("halfway case for mpfr_round, bad rounding"
                               " direction", s, x, y, p, (mpfr_rnd_t) r, trint, inexact);
                      }
                  }
              }
        }
    }
  mpfr_clear (x);
  mpfr_clear (y);
  mpz_clear (z);
  mpfr_clear (t);
  mpfr_clear (u);
  mpfr_clear (v);

  special ();
  coverage_03032011 ();

#if __MPFR_STDC (199901L)
  if (argc > 1 && strcmp (argv[1], "-s") == 0)
    test_against_libc ();
#endif

  tests_end_mpfr ();
  return 0;
}
コード例 #11
0
ファイル: yn.c プロジェクト: Kirija/XPIR
int
mpfr_yn (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
  int inex;
  unsigned long absn;
  MPFR_SAVE_EXPO_DECL (expo);

  MPFR_LOG_FUNC
    (("n=%ld x[%Pu]=%.*Rg rnd=%d", n, mpfr_get_prec (z), mpfr_log_prec, z, r),
     ("y[%Pu]=%.*Rg inexact=%d", mpfr_get_prec (res), mpfr_log_prec, res, inex));

  absn = SAFE_ABS (unsigned long, n);

  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (z)))
    {
      if (MPFR_IS_NAN (z))
        {
          MPFR_SET_NAN (res); /* y(n,NaN) = NaN */
          MPFR_RET_NAN;
        }
      /* y(n,z) tends to zero when z goes to +Inf, oscillating around
         0. We choose to return +0 in that case. */
      else if (MPFR_IS_INF (z))
        {
          if (MPFR_SIGN(z) > 0)
            return mpfr_set_ui (res, 0, r);
          else /* y(n,-Inf) = NaN */
            {
              MPFR_SET_NAN (res);
              MPFR_RET_NAN;
            }
        }
      else /* y(n,z) tends to -Inf for n >= 0 or n even, to +Inf otherwise,
              when z goes to zero */
        {
          MPFR_SET_INF(res);
          if (n >= 0 || ((unsigned long) n & 1) == 0)
            MPFR_SET_NEG(res);
          else
            MPFR_SET_POS(res);
          mpfr_set_divby0 ();
          MPFR_RET(0);
        }
    }

  /* for z < 0, y(n,z) is imaginary except when j(n,|z|) = 0, which we
     assume does not happen for a rational z. */
  if (MPFR_SIGN(z) < 0)
    {
      MPFR_SET_NAN (res);
      MPFR_RET_NAN;
    }

  /* now z is not singular, and z > 0 */

  MPFR_SAVE_EXPO_MARK (expo);

  /* Deal with tiny arguments. We have:
     y0(z) = 2 log(z)/Pi + 2 (euler - log(2))/Pi + O(log(z)*z^2), more
     precisely for 0 <= z <= 1/2, with g(z) = 2/Pi + 2(euler-log(2))/Pi/log(z),
                g(z) - 0.41*z^2 < y0(z)/log(z) < g(z)
     thus since log(z) is negative:
             g(z)*log(z) < y0(z) < (g(z) - z^2/2)*log(z)
     and since |g(z)| >= 0.63 for 0 <= z <= 1/2, the relative error on
     y0(z)/log(z) is bounded by 0.41*z^2/0.63 <= 0.66*z^2.
     Note: we use both the main term in log(z) and the constant term, because
     otherwise the relative error would be only in 1/log(|log(z)|).
  */
  if (n == 0 && MPFR_EXP(z) < - (mpfr_exp_t) (MPFR_PREC(res) / 2))
    {
      mpfr_t l, h, t, logz;
      mpfr_prec_t prec;
      int ok, inex2;

      prec = MPFR_PREC(res) + 10;
      mpfr_init2 (l, prec);
      mpfr_init2 (h, prec);
      mpfr_init2 (t, prec);
      mpfr_init2 (logz, prec);
      /* first enclose log(z) + euler - log(2) = log(z/2) + euler */
      mpfr_log (logz, z, MPFR_RNDD);    /* lower bound of log(z) */
      mpfr_set (h, logz, MPFR_RNDU);    /* exact */
      mpfr_nextabove (h);              /* upper bound of log(z) */
      mpfr_const_euler (t, MPFR_RNDD);  /* lower bound of euler */
      mpfr_add (l, logz, t, MPFR_RNDD); /* lower bound of log(z) + euler */
      mpfr_nextabove (t);              /* upper bound of euler */
      mpfr_add (h, h, t, MPFR_RNDU);    /* upper bound of log(z) + euler */
      mpfr_const_log2 (t, MPFR_RNDU);   /* upper bound of log(2) */
      mpfr_sub (l, l, t, MPFR_RNDD);    /* lower bound of log(z/2) + euler */
      mpfr_nextbelow (t);              /* lower bound of log(2) */
      mpfr_sub (h, h, t, MPFR_RNDU);    /* upper bound of log(z/2) + euler */
      mpfr_const_pi (t, MPFR_RNDU);     /* upper bound of Pi */
      mpfr_div (l, l, t, MPFR_RNDD);    /* lower bound of (log(z/2)+euler)/Pi */
      mpfr_nextbelow (t);              /* lower bound of Pi */
      mpfr_div (h, h, t, MPFR_RNDD);    /* upper bound of (log(z/2)+euler)/Pi */
      mpfr_mul_2ui (l, l, 1, MPFR_RNDD); /* lower bound on g(z)*log(z) */
      mpfr_mul_2ui (h, h, 1, MPFR_RNDU); /* upper bound on g(z)*log(z) */
      /* we now have l <= g(z)*log(z) <= h, and we need to add -z^2/2*log(z)
         to h */
      mpfr_mul (t, z, z, MPFR_RNDU);     /* upper bound on z^2 */
      /* since logz is negative, a lower bound corresponds to an upper bound
         for its absolute value */
      mpfr_neg (t, t, MPFR_RNDD);
      mpfr_div_2ui (t, t, 1, MPFR_RNDD);
      mpfr_mul (t, t, logz, MPFR_RNDU); /* upper bound on z^2/2*log(z) */
      mpfr_add (h, h, t, MPFR_RNDU);
      inex = mpfr_prec_round (l, MPFR_PREC(res), r);
      inex2 = mpfr_prec_round (h, MPFR_PREC(res), r);
      /* we need h=l and inex=inex2 */
      ok = (inex == inex2) && mpfr_equal_p (l, h);
      if (ok)
        mpfr_set (res, h, r); /* exact */
      mpfr_clear (l);
      mpfr_clear (h);
      mpfr_clear (t);
      mpfr_clear (logz);
      if (ok)
        goto end;
    }

  /* small argument check for y1(z) = -2/Pi/z + O(log(z)):
     for 0 <= z <= 1, |y1(z) + 2/Pi/z| <= 0.25 */
  if (n == 1 && MPFR_EXP(z) + 1 < - (mpfr_exp_t) MPFR_PREC(res))
    {
      mpfr_t y;
      mpfr_prec_t prec;
      mpfr_exp_t err1;
      int ok;
      MPFR_BLOCK_DECL (flags);

      /* since 2/Pi > 0.5, and |y1(z)| >= |2/Pi/z|, if z <= 2^(-emax-1),
         then |y1(z)| > 2^emax */
      prec = MPFR_PREC(res) + 10;
      mpfr_init2 (y, prec);
      mpfr_const_pi (y, MPFR_RNDU); /* Pi*(1+u)^2, where here and below u
                                      represents a quantity <= 1/2^prec */
      mpfr_mul (y, y, z, MPFR_RNDU); /* Pi*z * (1+u)^4, upper bound */
      MPFR_BLOCK (flags, mpfr_ui_div (y, 2, y, MPFR_RNDZ));
      /* 2/Pi/z * (1+u)^6, lower bound, with possible overflow */
      if (MPFR_OVERFLOW (flags))
        {
          mpfr_clear (y);
          MPFR_SAVE_EXPO_FREE (expo);
          return mpfr_overflow (res, r, -1);
        }
      mpfr_neg (y, y, MPFR_RNDN);
      /* (1+u)^6 can be written 1+7u [for another value of u], thus the
         error on 2/Pi/z is less than 7ulp(y). The truncation error is less
         than 1/4, thus if ulp(y)>=1/4, the total error is less than 8ulp(y),
         otherwise it is less than 1/4+7/8 <= 2. */
      if (MPFR_EXP(y) + 2 >= MPFR_PREC(y)) /* ulp(y) >= 1/4 */
        err1 = 3;
      else /* ulp(y) <= 1/8 */
        err1 = (mpfr_exp_t) MPFR_PREC(y) - MPFR_EXP(y) + 1;
      ok = MPFR_CAN_ROUND (y, prec - err1, MPFR_PREC(res), r);
      if (ok)
        inex = mpfr_set (res, y, r);
      mpfr_clear (y);
      if (ok)
        goto end;
    }

  /* we can use the asymptotic expansion as soon as z > p log(2)/2,
     but to get some margin we use it for z > p/2 */
  if (mpfr_cmp_ui (z, MPFR_PREC(res) / 2 + 3) > 0)
    {
      inex = mpfr_yn_asympt (res, n, z, r);
      if (inex != 0)
        goto end;
    }

  /* General case */
  {
    mpfr_prec_t prec;
    mpfr_exp_t err1, err2, err3;
    mpfr_t y, s1, s2, s3;
    MPFR_ZIV_DECL (loop);

    mpfr_init (y);
    mpfr_init (s1);
    mpfr_init (s2);
    mpfr_init (s3);

    prec = MPFR_PREC(res) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (res)) + 13;
    MPFR_ZIV_INIT (loop, prec);
    for (;;)
      {
        mpfr_set_prec (y, prec);
        mpfr_set_prec (s1, prec);
        mpfr_set_prec (s2, prec);
        mpfr_set_prec (s3, prec);

        mpfr_mul (y, z, z, MPFR_RNDN);
        mpfr_div_2ui (y, y, 2, MPFR_RNDN); /* z^2/4 */

        /* store (z/2)^n temporarily in s2 */
        mpfr_pow_ui (s2, z, absn, MPFR_RNDN);
        mpfr_div_2si (s2, s2, absn, MPFR_RNDN);

        /* compute S1 * (z/2)^(-n) */
        if (n == 0)
          {
            mpfr_set_ui (s1, 0, MPFR_RNDN);
            err1 = 0;
          }
        else
          err1 = mpfr_yn_s1 (s1, y, absn - 1);
        mpfr_div (s1, s1, s2, MPFR_RNDN); /* (z/2)^(-n) * S1 */
        /* See algorithms.tex: the relative error on s1 is bounded by
           (3n+3)*2^(e+1-prec). */
        err1 = MPFR_INT_CEIL_LOG2 (3 * absn + 3) + err1 + 1;
        /* rel_err(s1) <= 2^(err1-prec), thus err(s1) <= 2^err1 ulps */

        /* compute (z/2)^n * S3 */
        mpfr_neg (y, y, MPFR_RNDN); /* -z^2/4 */
        err3 = mpfr_yn_s3 (s3, y, s2, absn); /* (z/2)^n * S3 */
        /* the error on s3 is bounded by 2^err3 ulps */

        /* add s1+s3 */
        err1 += MPFR_EXP(s1);
        mpfr_add (s1, s1, s3, MPFR_RNDN);
        /* the error is bounded by 1/2 + 2^err1*2^(- EXP(s1))
           + 2^err3*2^(EXP(s3) - EXP(s1)) */
        err3 += MPFR_EXP(s3);
        err1 = (err3 > err1) ? err3 + 1 : err1 + 1;
        err1 -= MPFR_EXP(s1);
        err1 = (err1 >= 0) ? err1 + 1 : 1;
        /* now the error on s1 is bounded by 2^err1*ulp(s1) */

        /* compute S2 */
        mpfr_div_2ui (s2, z, 1, MPFR_RNDN); /* z/2 */
        mpfr_log (s2, s2, MPFR_RNDN); /* log(z/2) */
        mpfr_const_euler (s3, MPFR_RNDN);
        err2 = MPFR_EXP(s2) > MPFR_EXP(s3) ? MPFR_EXP(s2) : MPFR_EXP(s3);
        mpfr_add (s2, s2, s3, MPFR_RNDN); /* log(z/2) + gamma */
        err2 -= MPFR_EXP(s2);
        mpfr_mul_2ui (s2, s2, 1, MPFR_RNDN); /* 2*(log(z/2) + gamma) */
        mpfr_jn (s3, absn, z, MPFR_RNDN); /* Jn(z) */
        mpfr_mul (s2, s2, s3, MPFR_RNDN); /* 2*(log(z/2) + gamma)*Jn(z) */
        err2 += 4; /* the error on s2 is bounded by 2^err2 ulps, see
                      algorithms.tex */

        /* add all three sums */
        err1 += MPFR_EXP(s1); /* the error on s1 is bounded by 2^err1 */
        err2 += MPFR_EXP(s2); /* the error on s2 is bounded by 2^err2 */
        mpfr_sub (s2, s2, s1, MPFR_RNDN); /* s2 - (s1+s3) */
        err2 = (err1 > err2) ? err1 + 1 : err2 + 1;
        err2 -= MPFR_EXP(s2);
        err2 = (err2 >= 0) ? err2 + 1 : 1;
        /* now the error on s2 is bounded by 2^err2*ulp(s2) */
        mpfr_const_pi (y, MPFR_RNDN); /* error bounded by 1 ulp */
        mpfr_div (s2, s2, y, MPFR_RNDN); /* error bounded by
                                           2^(err2+1)*ulp(s2) */
        err2 ++;

        if (MPFR_LIKELY (MPFR_CAN_ROUND (s2, prec - err2, MPFR_PREC(res), r)))
          break;
        MPFR_ZIV_NEXT (loop, prec);
      }
    MPFR_ZIV_FREE (loop);

    /* Assume two's complement for the test n & 1 */
    inex = mpfr_set4 (res, s2, r, n >= 0 || (n & 1) == 0 ?
                      MPFR_SIGN (s2) : - MPFR_SIGN (s2));

    mpfr_clear (y);
    mpfr_clear (s1);
    mpfr_clear (s2);
    mpfr_clear (s3);
  }

 end:
  MPFR_SAVE_EXPO_FREE (expo);
  return mpfr_check_range (res, inex, r);
}
コード例 #12
0
ファイル: trint.c プロジェクト: epowers/mpfr
static void
special (void)
{
  mpfr_t x, y;
  mpfr_exp_t emax;

  mpfr_init (x);
  mpfr_init (y);

  mpfr_set_nan (x);
  mpfr_rint (y, x, MPFR_RNDN);
  MPFR_ASSERTN(mpfr_nan_p (y));

  mpfr_set_inf (x, 1);
  mpfr_rint (y, x, MPFR_RNDN);
  MPFR_ASSERTN(mpfr_inf_p (y) && mpfr_sgn (y) > 0);

  mpfr_set_inf (x, -1);
  mpfr_rint (y, x, MPFR_RNDN);
  MPFR_ASSERTN(mpfr_inf_p (y) && mpfr_sgn (y) < 0);

  mpfr_set_ui (x, 0, MPFR_RNDN);
  mpfr_rint (y, x, MPFR_RNDN);
  MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_POS(y));

  mpfr_set_ui (x, 0, MPFR_RNDN);
  mpfr_neg (x, x, MPFR_RNDN);
  mpfr_rint (y, x, MPFR_RNDN);
  MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_NEG(y));

  /* coverage test */
  mpfr_set_prec (x, 2);
  mpfr_set_ui (x, 1, MPFR_RNDN);
  mpfr_mul_2exp (x, x, mp_bits_per_limb, MPFR_RNDN);
  mpfr_rint (y, x, MPFR_RNDN);
  MPFR_ASSERTN(mpfr_cmp (y, x) == 0);

  /* another coverage test */
  emax = mpfr_get_emax ();
  set_emax (1);
  mpfr_set_prec (x, 3);
  mpfr_set_str_binary (x, "1.11E0");
  mpfr_set_prec (y, 2);
  mpfr_rint (y, x, MPFR_RNDU); /* x rounds to 1.0E1=0.1E2 which overflows */
  MPFR_ASSERTN(mpfr_inf_p (y) && mpfr_sgn (y) > 0);
  set_emax (emax);

  /* yet another */
  mpfr_set_prec (x, 97);
  mpfr_set_prec (y, 96);
  mpfr_set_str_binary (x, "-0.1011111001101111000111011100011100000110110110110000000111010001000101001111101010101011010111100E97");
  mpfr_rint (y, x, MPFR_RNDN);
  MPFR_ASSERTN(mpfr_cmp (y, x) == 0);

  mpfr_set_prec (x, 53);
  mpfr_set_prec (y, 53);
  mpfr_set_str_binary (x, "0.10101100000000101001010101111111000000011111010000010E-1");
  mpfr_rint (y, x, MPFR_RNDU);
  MPFR_ASSERTN(mpfr_cmp_ui (y, 1) == 0);
  mpfr_rint (y, x, MPFR_RNDD);
  MPFR_ASSERTN(mpfr_cmp_ui (y, 0) == 0 && MPFR_IS_POS(y));

  mpfr_set_prec (x, 36);
  mpfr_set_prec (y, 2);
  mpfr_set_str_binary (x, "-11000110101010111111110111001.0000100");
  mpfr_rint (y, x, MPFR_RNDN);
  mpfr_set_str_binary (x, "-11E27");
  MPFR_ASSERTN(mpfr_cmp (y, x) == 0);

  mpfr_set_prec (x, 39);
  mpfr_set_prec (y, 29);
  mpfr_set_str_binary (x, "-0.100010110100011010001111001001001100111E39");
  mpfr_rint (y, x, MPFR_RNDN);
  mpfr_set_str_binary (x, "-0.10001011010001101000111100101E39");
  MPFR_ASSERTN(mpfr_cmp (y, x) == 0);

  mpfr_set_prec (x, 46);
  mpfr_set_prec (y, 32);
  mpfr_set_str_binary (x, "-0.1011100110100101000001011111101011001001101001E32");
  mpfr_rint (y, x, MPFR_RNDN);
  mpfr_set_str_binary (x, "-0.10111001101001010000010111111011E32");
  MPFR_ASSERTN(mpfr_cmp (y, x) == 0);

  /* coverage test for mpfr_round */
  mpfr_set_prec (x, 3);
  mpfr_set_str_binary (x, "1.01E1"); /* 2.5 */
  mpfr_set_prec (y, 2);
  mpfr_round (y, x);
  /* since mpfr_round breaks ties away, should give 3 and not 2 as with
     the "round to even" rule */
  MPFR_ASSERTN(mpfr_cmp_ui (y, 3) == 0);
  /* same test for the function */
  (mpfr_round) (y, x);
  MPFR_ASSERTN(mpfr_cmp_ui (y, 3) == 0);

  mpfr_set_prec (x, 6);
  mpfr_set_prec (y, 3);
  mpfr_set_str_binary (x, "110.111");
  mpfr_round (y, x);
  if (mpfr_cmp_ui (y, 7))
    {
      printf ("Error in round(110.111)\n");
      exit (1);
    }

  /* Bug found by  Mark J Watkins */
  mpfr_set_prec (x, 84);
  mpfr_set_str_binary (x,
   "0.110011010010001000000111101101001111111100101110010000000000000" \
                       "000000000000000000000E32");
  mpfr_round (x, x);
  if (mpfr_cmp_str (x, "0.1100110100100010000001111011010100000000000000" \
                    "00000000000000000000000000000000000000E32", 2, MPFR_RNDN))
    {
      printf ("Rounding error when dest=src\n");
      exit (1);
    }

  mpfr_clear (x);
  mpfr_clear (y);
}
コード例 #13
0
ファイル: trint.c プロジェクト: epowers/mpfr
static void
coverage_03032011 (void)
{
  mpfr_t in, out, cmp;
  int status;
  int precIn;
  char strData[(GMP_NUMB_BITS * 4)+256];

  precIn = GMP_NUMB_BITS * 4;

  mpfr_init2 (in, precIn);
  mpfr_init2 (out, GMP_NUMB_BITS);
  mpfr_init2 (cmp, GMP_NUMB_BITS);

  /* cmp = "0.1EprecIn+2" */
  /* The buffer size is sufficient, as precIn is small in practice. */
  sprintf (strData, "0.1E%d", precIn+2);
  mpfr_set_str_binary (cmp, strData);

  /* in = "0.10...01EprecIn+2" use all (precIn) significand bits */
  memset ((void *)strData, '0', precIn+2);
  strData[1] = '.';
  strData[2] = '1';
  sprintf (&strData[precIn+1], "1E%d", precIn+2);
  mpfr_set_str_binary (in, strData);

  status = mpfr_rint (out, in, MPFR_RNDN);
  if ((mpfr_cmp (out, cmp) != 0) || (status >= 0))
    {
      printf("mpfr_rint error :\n status is %d instead of 0\n", status);
      printf(" out value is ");
      mpfr_dump(out);
      printf(" instead of   ");
      mpfr_dump(cmp);
      exit (1);
    }

  mpfr_clear (cmp);
  mpfr_clear (out);

  mpfr_init2 (out, GMP_NUMB_BITS);
  mpfr_init2 (cmp, GMP_NUMB_BITS);

  /* cmp = "0.10...01EprecIn+2" use all (GMP_NUMB_BITS) significand bits */
  strcpy (&strData[GMP_NUMB_BITS+1], &strData[precIn+1]);
  mpfr_set_str_binary (cmp, strData);

  (MPFR_MANT(in))[2] = MPFR_LIMB_HIGHBIT;
  status = mpfr_rint (out, in, MPFR_RNDN);

  if ((mpfr_cmp (out, cmp) != 0) || (status <= 0))
    {
      printf("mpfr_rint error :\n status is %d instead of 0\n", status);
      printf(" out value is\n");
      mpfr_dump(out);
      printf(" instead of\n");
      mpfr_dump(cmp);
      exit (1);
    }

  mpfr_clear (cmp);
  mpfr_clear (out);
  mpfr_clear (in);
}
コード例 #14
0
ファイル: acosh.c プロジェクト: mahdiz/mpclib
int
mpfr_acosh (mpfr_ptr y, mpfr_srcptr x , mp_rnd_t rnd_mode) 
{
    
  int inexact =0;
  int comp;

  if (MPFR_IS_NAN(x)) 
    {
      MPFR_SET_NAN(y); 
      MPFR_RET_NAN;
    }
    
  comp=mpfr_cmp_ui(x,1);

  if(comp < 0)
    {
      MPFR_SET_NAN(y); 
      MPFR_RET_NAN;
    }
  MPFR_CLEAR_NAN(y);

  if(comp == 0)
    {
      MPFR_SET_ZERO(y); /* acosh(1) = 0 */
      MPFR_SET_POS(y);
      MPFR_RET(0);
    }
  
  if (MPFR_IS_INF(x))
    { 
      MPFR_SET_INF(y);
      MPFR_SET_POS(y);
      MPFR_RET(0);
    }

  MPFR_CLEAR_INF(y);

  /* General case */
  {
    /* Declaration of the intermediary variable */
    mpfr_t t, te,ti;       
    
    /* Declaration of the size variable */
    mp_prec_t Nx = MPFR_PREC(x);   /* Precision of input variable */
    mp_prec_t Ny = MPFR_PREC(y);   /* Precision of input variable */
    
    mp_prec_t Nt;   /* Precision of the intermediary variable */
    int err;  /* Precision of error */
                
    /* compute the precision of intermediary variable */
    Nt=MAX(Nx,Ny);
    /* the optimal number of bits : see algorithms.ps */
    Nt=Nt+4+_mpfr_ceil_log2(Nt);

    /* initialise of intermediary	variable */
    mpfr_init(t);             
    mpfr_init(te);             
    mpfr_init(ti);                    

    /* First computation of cosh */
    do {

      /* reactualisation of the precision */
      mpfr_set_prec(t,Nt);             
      mpfr_set_prec(te,Nt);             
      mpfr_set_prec(ti,Nt);             

      /* compute acosh */
      mpfr_mul(te,x,x,GMP_RNDD);  /* (x^2) */
      mpfr_sub_ui(ti,te,1,GMP_RNDD);  /* (x^2-1) */
      mpfr_sqrt(t,ti,GMP_RNDN);     /* sqrt(x^2-1) */
      mpfr_add(t,t,x,GMP_RNDN);    /* sqrt(x^2-1)+x */
      mpfr_log(t,t,GMP_RNDN);        /* ln(sqrt(x^2-1)+x)*/

      /* estimation of the error see- algorithms.ps*/
      /*err=Nt-_mpfr_ceil_log2(0.5+pow(2,2-MPFR_EXP(t))+pow(2,1+MPFR_EXP(te)-MPFR_EXP(ti)-MPFR_EXP(t)));*/
      err=Nt-(-1+2*MAX(2+MAX(2-MPFR_EXP(t),1+MPFR_EXP(te)-MPFR_EXP(ti)-MPFR_EXP(t)),0));

      /* actualisation of the precision */
      Nt += 10;

    } while ((err<0) ||!mpfr_can_round(t,err,GMP_RNDN,rnd_mode,Ny));
 
    inexact = mpfr_set(y,t,rnd_mode);

    mpfr_clear(t);
    mpfr_clear(ti);
    mpfr_clear(te);
  }
  return inexact;
}
コード例 #15
0
int
mpc_atan (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
    int s_re;
    int s_im;
    int inex_re;
    int inex_im;
    int inex;

    inex_re = 0;
    inex_im = 0;
    s_re = mpfr_signbit (mpc_realref (op));
    s_im = mpfr_signbit (mpc_imagref (op));

    /* special values */
    if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
    {
        if (mpfr_nan_p (mpc_realref (op)))
        {
            mpfr_set_nan (mpc_realref (rop));
            if (mpfr_zero_p (mpc_imagref (op)) || mpfr_inf_p (mpc_imagref (op)))
            {
                mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
                if (s_im)
                    mpc_conj (rop, rop, MPC_RNDNN);
            }
            else
                mpfr_set_nan (mpc_imagref (rop));
        }
        else
        {
            if (mpfr_inf_p (mpc_realref (op)))
            {
                inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
                mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
            }
            else
            {
                mpfr_set_nan (mpc_realref (rop));
                mpfr_set_nan (mpc_imagref (rop));
            }
        }
        return MPC_INEX (inex_re, 0);
    }

    if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
    {
        inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));

        mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
        if (s_im)
            mpc_conj (rop, rop, GMP_RNDN);

        return MPC_INEX (inex_re, 0);
    }

    /* pure real argument */
    if (mpfr_zero_p (mpc_imagref (op)))
    {
        inex_re = mpfr_atan (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));

        mpfr_set_ui (mpc_imagref (rop), 0, GMP_RNDN);
        if (s_im)
            mpc_conj (rop, rop, GMP_RNDN);

        return MPC_INEX (inex_re, 0);
    }

    /* pure imaginary argument */
    if (mpfr_zero_p (mpc_realref (op)))
    {
        int cmp_1;

        if (s_im)
            cmp_1 = -mpfr_cmp_si (mpc_imagref (op), -1);
        else
            cmp_1 = mpfr_cmp_ui (mpc_imagref (op), +1);

        if (cmp_1 < 0)
        {
            /* atan(+0+iy) = +0 +i*atanh(y), if |y| < 1
               atan(-0+iy) = -0 +i*atanh(y), if |y| < 1 */

            mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
            if (s_re)
                mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);

            inex_im = mpfr_atanh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));
        }
        else if (cmp_1 == 0)
        {
            /* atan(+/-0+i) = NaN +i*inf
               atan(+/-0-i) = NaN -i*inf */
            mpfr_set_nan (mpc_realref (rop));
            mpfr_set_inf (mpc_imagref (rop), s_im ? -1 : +1);
        }
        else
        {
            /* atan(+0+iy) = +pi/2 +i*atanh(1/y), if |y| > 1
               atan(-0+iy) = -pi/2 +i*atanh(1/y), if |y| > 1 */
            mpfr_rnd_t rnd_im, rnd_away;
            mpfr_t y;
            mpfr_prec_t p, p_im;
            int ok;

            rnd_im = MPC_RND_IM (rnd);
            mpfr_init (y);
            p_im = mpfr_get_prec (mpc_imagref (rop));
            p = p_im;

            /* a = o(1/y)      with error(a) < 1 ulp(a)
               b = o(atanh(a)) with error(b) < (1+2^{1+Exp(a)-Exp(b)}) ulp(b)

               As |atanh (1/y)| > |1/y| we have Exp(a)-Exp(b) <=0 so, at most,
               2 bits of precision are lost.

               We round atanh(1/y) away from 0.
            */
            do
            {
                p += mpc_ceil_log2 (p) + 2;
                mpfr_set_prec (y, p);
                rnd_away = s_im == 0 ? GMP_RNDU : GMP_RNDD;
                inex_im = mpfr_ui_div (y, 1, mpc_imagref (op), rnd_away);
                /* FIXME: should we consider the case with unreasonably huge
                   precision prec(y)>3*exp_min, where atanh(1/Im(op)) could be
                   representable while 1/Im(op) underflows ?
                   This corresponds to |y| = 0.5*2^emin, in which case the
                   result may be wrong. */

                /* atanh cannot underflow: |atanh(x)| > |x| for |x| < 1 */
                inex_im |= mpfr_atanh (y, y, rnd_away);

                ok = inex_im == 0
                     || mpfr_can_round (y, p - 2, rnd_away, GMP_RNDZ,
                                        p_im + (rnd_im == GMP_RNDN));
            } while (ok == 0);

            inex_re = set_pi_over_2 (mpc_realref (rop), -s_re, MPC_RND_RE (rnd));
            inex_im = mpfr_set (mpc_imagref (rop), y, rnd_im);
            mpfr_clear (y);
        }
        return MPC_INEX (inex_re, inex_im);
    }

    /* regular number argument */
    {
        mpfr_t a, b, x, y;
        mpfr_prec_t prec, p;
        mpfr_exp_t err, expo;
        int ok = 0;
        mpfr_t minus_op_re;
        mpfr_exp_t op_re_exp, op_im_exp;
        mpfr_rnd_t rnd1, rnd2;

        mpfr_inits2 (MPFR_PREC_MIN, a, b, x, y, (mpfr_ptr) 0);

        /* real part: Re(arctan(x+i*y)) = [arctan2(x,1-y) - arctan2(-x,1+y)]/2 */
        minus_op_re[0] = mpc_realref (op)[0];
        MPFR_CHANGE_SIGN (minus_op_re);
        op_re_exp = mpfr_get_exp (mpc_realref (op));
        op_im_exp = mpfr_get_exp (mpc_imagref (op));

        prec = mpfr_get_prec (mpc_realref (rop)); /* result precision */

        /* a = o(1-y)         error(a) < 1 ulp(a)
           b = o(atan2(x,a))  error(b) < [1+2^{3+Exp(x)-Exp(a)-Exp(b)}] ulp(b)
                                         = kb ulp(b)
           c = o(1+y)         error(c) < 1 ulp(c)
           d = o(atan2(-x,c)) error(d) < [1+2^{3+Exp(x)-Exp(c)-Exp(d)}] ulp(d)
                                         = kd ulp(d)
           e = o(b - d)       error(e) < [1 + kb*2^{Exp(b}-Exp(e)}
                                            + kd*2^{Exp(d)-Exp(e)}] ulp(e)
                              error(e) < [1 + 2^{4+Exp(x)-Exp(a)-Exp(e)}
                                            + 2^{4+Exp(x)-Exp(c)-Exp(e)}] ulp(e)
                              because |atan(u)| < |u|
                                       < [1 + 2^{5+Exp(x)-min(Exp(a),Exp(c))
                                                 -Exp(e)}] ulp(e)
           f = e/2            exact
        */

        /* p: working precision */
        p = (op_im_exp > 0 || prec > SAFE_ABS (mpfr_prec_t, op_im_exp)) ? prec
            : (prec - op_im_exp);
        rnd1 = mpfr_sgn (mpc_realref (op)) > 0 ? GMP_RNDD : GMP_RNDU;
        rnd2 = mpfr_sgn (mpc_realref (op)) < 0 ? GMP_RNDU : GMP_RNDD;

        do
        {
            p += mpc_ceil_log2 (p) + 2;
            mpfr_set_prec (a, p);
            mpfr_set_prec (b, p);
            mpfr_set_prec (x, p);

            /* x = upper bound for atan (x/(1-y)). Since atan is increasing, we
               need an upper bound on x/(1-y), i.e., a lower bound on 1-y for
               x positive, and an upper bound on 1-y for x negative */
            mpfr_ui_sub (a, 1, mpc_imagref (op), rnd1);
            if (mpfr_sgn (a) == 0) /* y is near 1, thus 1+y is near 2, and
                                  expo will be 1 or 2 below */
            {
                MPC_ASSERT (mpfr_cmp_ui (mpc_imagref(op), 1) == 0);
                /* check for intermediate underflow */
                err = 2; /* ensures err will be expo below */
            }
            else
                err = mpfr_get_exp (a); /* err = Exp(a) with the notations above */
            mpfr_atan2 (x, mpc_realref (op), a, GMP_RNDU);

            /* b = lower bound for atan (-x/(1+y)): for x negative, we need a
               lower bound on -x/(1+y), i.e., an upper bound on 1+y */
            mpfr_add_ui (a, mpc_imagref(op), 1, rnd2);
            /* if a is exactly zero, i.e., Im(op) = -1, then the error on a is 0,
               and we can simply ignore the terms involving Exp(a) in the error */
            if (mpfr_sgn (a) == 0)
            {
                MPC_ASSERT (mpfr_cmp_si (mpc_imagref(op), -1) == 0);
                /* check for intermediate underflow */
                expo = err; /* will leave err unchanged below */
            }
            else
                expo = mpfr_get_exp (a); /* expo = Exp(c) with the notations above */
            mpfr_atan2 (b, minus_op_re, a, GMP_RNDD);

            err = err < expo ? err : expo; /* err = min(Exp(a),Exp(c)) */
            mpfr_sub (x, x, b, GMP_RNDU);

            err = 5 + op_re_exp - err - mpfr_get_exp (x);
            /* error is bounded by [1 + 2^err] ulp(e) */
            err = err < 0 ? 1 : err + 1;

            mpfr_div_2ui (x, x, 1, GMP_RNDU);

            /* Note: using RND2=RNDD guarantees that if x is exactly representable
               on prec + ... bits, mpfr_can_round will return 0 */
            ok = mpfr_can_round (x, p - err, GMP_RNDU, GMP_RNDD,
                                 prec + (MPC_RND_RE (rnd) == GMP_RNDN));
        } while (ok == 0);

        /* Imaginary part
           Im(atan(x+I*y)) = 1/4 * [log(x^2+(1+y)^2) - log (x^2 +(1-y)^2)] */
        prec = mpfr_get_prec (mpc_imagref (rop)); /* result precision */

        /* a = o(1+y)    error(a) < 1 ulp(a)
           b = o(a^2)    error(b) < 5 ulp(b)
           c = o(x^2)    error(c) < 1 ulp(c)
           d = o(b+c)    error(d) < 7 ulp(d)
           e = o(log(d)) error(e) < [1 + 7*2^{2-Exp(e)}] ulp(e) = ke ulp(e)
           f = o(1-y)    error(f) < 1 ulp(f)
           g = o(f^2)    error(g) < 5 ulp(g)
           h = o(c+f)    error(h) < 7 ulp(h)
           i = o(log(h)) error(i) < [1 + 7*2^{2-Exp(i)}] ulp(i) = ki ulp(i)
           j = o(e-i)    error(j) < [1 + ke*2^{Exp(e)-Exp(j)}
                                       + ki*2^{Exp(i)-Exp(j)}] ulp(j)
                         error(j) < [1 + 2^{Exp(e)-Exp(j)} + 2^{Exp(i)-Exp(j)}
                                       + 7*2^{3-Exp(j)}] ulp(j)
                                  < [1 + 2^{max(Exp(e),Exp(i))-Exp(j)+1}
                                       + 7*2^{3-Exp(j)}] ulp(j)
           k = j/4       exact
        */
        err = 2;
        p = prec; /* working precision */

        do
        {
            p += mpc_ceil_log2 (p) + err;
            mpfr_set_prec (a, p);
            mpfr_set_prec (b, p);
            mpfr_set_prec (y, p);

            /* a = upper bound for log(x^2 + (1+y)^2) */
            ROUND_AWAY (mpfr_add_ui (a, mpc_imagref (op), 1, MPFR_RNDA), a);
            mpfr_sqr (a, a, GMP_RNDU);
            mpfr_sqr (y, mpc_realref (op), GMP_RNDU);
            mpfr_add (a, a, y, GMP_RNDU);
            mpfr_log (a, a, GMP_RNDU);

            /* b = lower bound for log(x^2 + (1-y)^2) */
            mpfr_ui_sub (b, 1, mpc_imagref (op), GMP_RNDZ); /* round to zero */
            mpfr_sqr (b, b, GMP_RNDZ);
            /* we could write mpfr_sqr (y, mpc_realref (op), GMP_RNDZ) but it is
               more efficient to reuse the value of y (x^2) above and subtract
               one ulp */
            mpfr_nextbelow (y);
            mpfr_add (b, b, y, GMP_RNDZ);
            mpfr_log (b, b, GMP_RNDZ);

            mpfr_sub (y, a, b, GMP_RNDU);

            if (mpfr_zero_p (y))
                /* FIXME: happens when x and y have very different magnitudes;
                   could be handled more efficiently                           */
                ok = 0;
            else
            {
                expo = MPC_MAX (mpfr_get_exp (a), mpfr_get_exp (b));
                expo = expo - mpfr_get_exp (y) + 1;
                err = 3 - mpfr_get_exp (y);
                /* error(j) <= [1 + 2^expo + 7*2^err] ulp(j) */
                if (expo <= err) /* error(j) <= [1 + 2^{err+1}] ulp(j) */
                    err = (err < 0) ? 1 : err + 2;
                else
                    err = (expo < 0) ? 1 : expo + 2;

                mpfr_div_2ui (y, y, 2, GMP_RNDN);
                MPC_ASSERT (!mpfr_zero_p (y));
                /* FIXME: underflow. Since the main term of the Taylor series
                   in y=0 is 1/(x^2+1) * y, this means that y is very small
                   and/or x very large; but then the mpfr_zero_p (y) above
                   should be true. This needs a proof, or better yet,
                   special code.                                              */

                ok = mpfr_can_round (y, p - err, GMP_RNDU, GMP_RNDD,
                                     prec + (MPC_RND_IM (rnd) == GMP_RNDN));
            }
        } while (ok == 0);

        inex = mpc_set_fr_fr (rop, x, y, rnd);

        mpfr_clears (a, b, x, y, (mpfr_ptr) 0);
        return inex;
    }
}
コード例 #16
0
ファイル: TestFindDetLib.c プロジェクト: swosu/hpc_FindDet
int main(){
    double max;
    double tmp;
    double resDet;
    mpfr_t det;
    double mulTmp; 
    mpfr_t tmp1;
    mpfr_t tmp2;
    mpfr_t logAbsDet;
    int i,j,k,maxRow,sign;
    char f_name[50];
    double* buffer;
    mpfr_init(det);
    mpfr_init(tmp1);
    mpfr_init(tmp2);
    mpfr_init(logAbsDet);
    buffer = malloc(size*size*sizeof(double));
    sprintf(f_name,"m5000x5000.bin");
    FILE *datafile=fopen(f_name,"rb");
    for(i=0;i<size;i++){
        for(j=0;j<size;j++){
            *(buffer+size*i+j)=0; 
        }
    }
    for(i=0;i<size;i++){
        for(j=0;j<size;j++){
            fread(buffer+(size*i+j),sizeof(double),1,datafile);
        }
    }
    for(i=0;i<size;i++){
        for(j=0;j<size;j++){
            printf("%lf\t",*(buffer+(size*i+j)));
        }
        printf("\n");
    }
    for(i=0;i<size-1;i++){
        maxRow = i;
        max = *(buffer+(size*i+i));
        for(j=i+1;j<size;j++){
            if(fabs(max)<fabs(*(buffer+size*j+i))){
                max = *(buffer+size*j+i);
                maxRow=j;
            }
        }
        if(fabs(max)<0.000001){
            resDet =0;
            printf("det=%e\n",resDet);
            exit(1);
        }
        if(maxRow!=i){
            sign++;
            for(j=i;j<size;j++){
                tmp = *(buffer + size*i+j);
                *(buffer+size*i+j) = *(buffer + size*maxRow+j);
                *(buffer+size*maxRow+j) = tmp;
            }
        }
        for(j=i+1;j<size;j++){
            mulTmp = *(buffer+size*j+i) / *(buffer+size*i+i);
            for(k=i;k<size;k++){

                *(buffer+size*j+k) = *(buffer+size*j+k)-*(buffer + size*i+k)*mulTmp;
            }
        }
    }
    mpfr_set_d(tmp1,1.0,GMP_RNDN);
    for(i=0;i<size;i++){
        mpfr_set_d(tmp2,*(buffer+size*i+i),GMP_RNDN);
        mpfr_mul(tmp1,tmp2,tmp1,GMP_RNDN);
    }
    if(sign%2==0){
        mpfr_set(det,tmp1,GMP_RNDN);
        resDet=mpfr_get_d(det,GMP_RNDN);
        mpfr_log10(logAbsDet,det,GMP_RNDN);
    }
    else{
        mpfr_neg(tmp1,tmp1,GMP_RNDN);
        mpfr_set(det,tmp1,GMP_RNDN);

        resDet=mpfr_get_d(det,GMP_RNDN);
        mpfr_log10(logAbsDet,det,GMP_RNDN);
    }

    //mpf_abs(absDet,det);
    //    mpf_set(logAbsDet, mpfr_log10(absDet));
   // mpfr_printf("det= %Fe\n",det);
    printf("det= %e\n",resDet);
    mpfr_printf("log(abs(det))= %Fe\n",logAbsDet);
    //gmp_printf("log(abs(det)= %e\n",logAbsDet);
    double END = clock();
    printf("%f\n",END/CLOCKS_PER_SEC);

    mpfr_clear(det);
    mpfr_clear(tmp1);
    mpfr_clear(tmp2);
    mpfr_clear(logAbsDet);
    free(buffer);
    return 0;
}
コード例 #17
0
ファイル: eint.c プロジェクト: mmanley/Antares
int
mpfr_eint (mpfr_ptr y, mpfr_srcptr x, mp_rnd_t rnd)
{
  int inex;
  mpfr_t tmp, ump;
  mp_exp_t err, te;
  mp_prec_t prec;
  MPFR_SAVE_EXPO_DECL (expo);
  MPFR_ZIV_DECL (loop);

  MPFR_LOG_FUNC (("x[%#R]=%R rnd=%d", x, x, rnd),
                 ("y[%#R]=%R inexact=%d", y, y, inex));

  if (MPFR_UNLIKELY (MPFR_IS_SINGULAR (x)))
    {
      /* exp(NaN) = exp(-Inf) = NaN */
      if (MPFR_IS_NAN (x) || (MPFR_IS_INF (x) && MPFR_IS_NEG(x)))
        {
          MPFR_SET_NAN (y);
          MPFR_RET_NAN;
        }
      /* eint(+inf) = +inf */
      else if (MPFR_IS_INF (x))
        {
          MPFR_SET_INF(y);
          MPFR_SET_POS(y);
          MPFR_RET(0);
        }
      else /* eint(+/-0) = -Inf */
        {
          MPFR_SET_INF(y);
          MPFR_SET_NEG(y);
          MPFR_RET(0);
        }
    }

  /* eint(x) = NaN for x < 0 */
  if (MPFR_IS_NEG(x))
    {
      MPFR_SET_NAN (y);
      MPFR_RET_NAN;
    }

  MPFR_SAVE_EXPO_MARK (expo);

  /* Since eint(x) >= exp(x)/x, we have log2(eint(x)) >= (x-log(x))/log(2).
     Let's compute k <= (x-log(x))/log(2) in a low precision. If k >= emax,
     then log2(eint(x)) >= emax, and eint(x) >= 2^emax, i.e. it overflows. */
  mpfr_init2 (tmp, 64);
  mpfr_init2 (ump, 64);
  mpfr_log (tmp, x, GMP_RNDU);
  mpfr_sub (ump, x, tmp, GMP_RNDD);
  mpfr_const_log2 (tmp, GMP_RNDU);
  mpfr_div (ump, ump, tmp, GMP_RNDD);
  /* FIXME: We really need mpfr_set_exp_t and mpfr_cmp_exp_t functions. */
  MPFR_ASSERTN (MPFR_EMAX_MAX <= LONG_MAX);
  if (mpfr_cmp_ui (ump, __gmpfr_emax) >= 0)
    {
      mpfr_clear (tmp);
      mpfr_clear (ump);
      MPFR_SAVE_EXPO_FREE (expo);
      return mpfr_overflow (y, rnd, 1);
    }

  /* Init stuff */
  prec = MPFR_PREC (y) + 2 * MPFR_INT_CEIL_LOG2 (MPFR_PREC (y)) + 6;

  /* eint() has a root 0.37250741078136663446..., so if x is near,
     already take more bits */
  if (MPFR_GET_EXP(x) == -1) /* 1/4 <= x < 1/2 */
    {
      double d;
      d = mpfr_get_d (x, GMP_RNDN) - 0.37250741078136663;
      d = (d == 0.0) ? -53 : __gmpfr_ceil_log2 (d);
      prec += -d;
    }

  mpfr_set_prec (tmp, prec);
  mpfr_set_prec (ump, prec);

  MPFR_ZIV_INIT (loop, prec);            /* Initialize the ZivLoop controler */
  for (;;)                               /* Infinite loop */
    {
      /* We need that the smallest value of k!/x^k is smaller than 2^(-p).
         The minimum is obtained for x=k, and it is smaller than e*sqrt(x)/e^x
         for x>=1. */
      if (MPFR_GET_EXP (x) > 0 && mpfr_cmp_d (x, ((double) prec +
                            0.5 * (double) MPFR_GET_EXP (x)) * LOG2 + 1.0) > 0)
        err = mpfr_eint_asympt (tmp, x);
      else
        {
          err = mpfr_eint_aux (tmp, x); /* error <= 2^err ulp(tmp) */
          te = MPFR_GET_EXP(tmp);
          mpfr_const_euler (ump, GMP_RNDN); /* 0.577 -> EXP(ump)=0 */
          mpfr_add (tmp, tmp, ump, GMP_RNDN);
          /* error <= 1/2 + 1/2*2^(EXP(ump)-EXP(tmp)) + 2^(te-EXP(tmp)+err)
             <= 1/2 + 2^(MAX(EXP(ump), te+err+1) - EXP(tmp))
             <= 2^(MAX(0, 1 + MAX(EXP(ump), te+err+1) - EXP(tmp))) */
          err = MAX(1, te + err + 2) - MPFR_GET_EXP(tmp);
          err = MAX(0, err);
          te = MPFR_GET_EXP(tmp);
          mpfr_log (ump, x, GMP_RNDN);
          mpfr_add (tmp, tmp, ump, GMP_RNDN);
          /* same formula as above, except now EXP(ump) is not 0 */
          err += te + 1;
          if (MPFR_LIKELY (!MPFR_IS_ZERO (ump)))
            err = MAX (MPFR_GET_EXP (ump), err);
          err = MAX(0, err - MPFR_GET_EXP (tmp));
        }
      if (MPFR_LIKELY (MPFR_CAN_ROUND (tmp, prec - err, MPFR_PREC (y), rnd)))
        break;
      MPFR_ZIV_NEXT (loop, prec);        /* Increase used precision */
      mpfr_set_prec (tmp, prec);
      mpfr_set_prec (ump, prec);
    }
  MPFR_ZIV_FREE (loop);                  /* Free the ZivLoop Controler */

  inex = mpfr_set (y, tmp, rnd);    /* Set y to the computed value */
  mpfr_clear (tmp);
  mpfr_clear (ump);

  MPFR_SAVE_EXPO_FREE (expo);
  return mpfr_check_range (y, inex, rnd);
}
コード例 #18
0
/* checks that the inexact return value is correct */
static void
check_exact (void)
{
  mpfr_t a, b, c, d;
  mp_prec_t prec;
  int i, inexact;
  mp_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 (mpfr_mul (c, a, b, GMP_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_random (a);
          mpfr_random (b);
          rnd = (mp_rnd_t) RND_RAND ();
          inexact = mpfr_mul (c, a, b, rnd);
          if (mpfr_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);
}
コード例 #19
0
ファイル: asin.c プロジェクト: mahdiz/mpclib
int
mpfr_asin (mpfr_ptr asin, mpfr_srcptr x, mp_rnd_t rnd_mode)
{
  mpfr_t xp;
  mpfr_t arcs;

  int signe, suplement;

  mpfr_t tmp;
  int Prec;
  int prec_asin;
  int good = 0;
  int realprec;
  int estimated_delta;
  int compared; 

  /* Trivial cases */
  if (MPFR_IS_NAN(x) || MPFR_IS_INF(x))
    {
      MPFR_SET_NAN(asin);
      MPFR_RET_NAN;
    }

  /* Set x_p=|x| */
  signe = MPFR_SIGN(x);
  mpfr_init2 (xp, MPFR_PREC(x));
  mpfr_set (xp, x, rnd_mode);
  if (signe == -1)
    MPFR_CHANGE_SIGN(xp);

  compared = mpfr_cmp_ui (xp, 1);

  if (compared > 0) /* asin(x) = NaN for |x| > 1 */
    {
      MPFR_SET_NAN(asin);
      mpfr_clear (xp);
      MPFR_RET_NAN;
    }

  if (compared == 0) /* x = 1 or x = -1 */
    {
      if (signe > 0) /* asin(+1) = Pi/2 */
        mpfr_const_pi (asin, rnd_mode);
      else /* asin(-1) = -Pi/2 */
        {
          if (rnd_mode == GMP_RNDU)
            rnd_mode = GMP_RNDD;
          else if (rnd_mode == GMP_RNDD)
            rnd_mode = GMP_RNDU;
          mpfr_const_pi (asin, rnd_mode);
          mpfr_neg (asin, asin, rnd_mode);
        }
      MPFR_EXP(asin)--;
      mpfr_clear (xp);
      return 1; /* inexact */
    }

  if (MPFR_IS_ZERO(x)) /* x = 0 */
    {
      mpfr_set_ui (asin, 0, GMP_RNDN);
      mpfr_clear(xp);
      return 0; /* exact result */
    }

  prec_asin = MPFR_PREC(asin);
  mpfr_ui_sub (xp, 1, xp, GMP_RNDD);
  
  suplement = 2 - MPFR_EXP(xp);
#ifdef DEBUG
  printf("suplement=%d\n", suplement);
#endif
  realprec = prec_asin + 10;

  while (!good)
    {
      estimated_delta = 1 + suplement;
      Prec = realprec+estimated_delta;

      /* Initialisation    */
      mpfr_init2 (tmp, Prec);
      mpfr_init2 (arcs, Prec);

#ifdef DEBUG
      printf("Prec=%d\n", Prec);
      printf("              x=");
      mpfr_out_str (stdout, 2, 0, x, GMP_RNDN);
      printf ("\n");
#endif
      mpfr_mul (tmp, x, x, GMP_RNDN);
#ifdef DEBUG
      printf("            x^2=");
      mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
      printf ("\n");
#endif
      mpfr_ui_sub (tmp, 1, tmp, GMP_RNDN);
#ifdef DEBUG
      printf("          1-x^2=");
      mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
      printf ("\n");
      printf("10:          1-x^2=");
      mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN);
      printf ("\n");
#endif
      mpfr_sqrt (tmp, tmp, GMP_RNDN);
#ifdef DEBUG
      printf("  sqrt(1-x^2)=");
      mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
      printf ("\n");
      printf("10:  sqrt(1-x^2)=");
      mpfr_out_str (stdout, 10, 0, tmp, GMP_RNDN);
      printf ("\n");
#endif
      mpfr_div (tmp, x, tmp, GMP_RNDN);
#ifdef DEBUG
      printf("x/sqrt(1-x^2)=");
      mpfr_out_str (stdout, 2, 0, tmp, GMP_RNDN);
      printf ("\n");
#endif
      mpfr_atan (arcs, tmp, GMP_RNDN);
#ifdef DEBUG
      printf("atan(x/..x^2)=");
      mpfr_out_str (stdout, 2, 0, arcs, GMP_RNDN);
      printf ("\n");
#endif
      if (mpfr_can_round (arcs, realprec, GMP_RNDN, rnd_mode, MPFR_PREC(asin)))
	{
	  mpfr_set (asin, arcs, rnd_mode);
#ifdef DEBUG
	  printf("asin         =");
	  mpfr_out_str (stdout, 2, prec_asin, asin, GMP_RNDN);
	  printf ("\n");
#endif
	  good = 1;
	}
      else
	{
	  realprec += _mpfr_ceil_log2 ((double) realprec);
#ifdef DEBUG
	  printf("RETRY\n");
#endif
	}
      mpfr_clear (tmp);
      mpfr_clear (arcs);
  }

  mpfr_clear (xp);

  return 1; /* inexact result */
}
コード例 #20
0
static void
check_max(void)
{
  mpfr_t xx, yy, zz;
  mp_exp_t emin;

  mpfr_init2(xx, 4);
  mpfr_init2(yy, 4);
  mpfr_init2(zz, 4);
  mpfr_set_str1 (xx, "0.68750");
  mpfr_mul_2si(xx, xx, MPFR_EMAX_DEFAULT/2, GMP_RNDN);
  mpfr_set_str1 (yy, "0.68750");
  mpfr_mul_2si(yy, yy, MPFR_EMAX_DEFAULT - MPFR_EMAX_DEFAULT/2 + 1, GMP_RNDN);
  mpfr_clear_flags();
  mpfr_mul(zz, xx, yy, GMP_RNDU);
  if (!(mpfr_overflow_p() && MPFR_IS_INF(zz)))
    {
      printf("check_max failed (should be an overflow)\n");
      exit(1);
    }

  mpfr_clear_flags();
  mpfr_mul(zz, xx, yy, GMP_RNDD);
  if (mpfr_overflow_p() || MPFR_IS_INF(zz))
    {
      printf("check_max failed (should NOT be an overflow)\n");
      exit(1);
    }
  mpfr_set_str1 (xx, "0.93750");
  mpfr_mul_2si(xx, xx, MPFR_EMAX_DEFAULT, GMP_RNDN);
  if (!(MPFR_IS_FP(xx) && MPFR_IS_FP(zz)))
    {
      printf("check_max failed (internal error)\n");
      exit(1);
    }
  if (mpfr_cmp(xx, zz) != 0)
    {
      printf("check_max failed: got ");
      mpfr_out_str(stdout, 2, 0, zz, GMP_RNDZ);
      printf(" instead of ");
      mpfr_out_str(stdout, 2, 0, xx, GMP_RNDZ);
      printf("\n");
      exit(1);
    }

  /* check underflow */
  emin = mpfr_get_emin ();
  set_emin (0);
  mpfr_set_str_binary (xx, "0.1E0");
  mpfr_set_str_binary (yy, "0.1E0");
  mpfr_mul (zz, xx, yy, GMP_RNDN);
  /* exact result is 0.1E-1, which should round to 0 */
  MPFR_ASSERTN(mpfr_cmp_ui (zz, 0) == 0 && MPFR_IS_POS(zz));
  set_emin (emin);
  
  /* coverage test for mpfr_powerof2_raw */
  emin = mpfr_get_emin ();
  set_emin (0);
  mpfr_set_prec (xx, mp_bits_per_limb + 1);
  mpfr_set_str_binary (xx, "0.1E0");
  mpfr_nextabove (xx);
  mpfr_set_str_binary (yy, "0.1E0");
  mpfr_mul (zz, xx, yy, GMP_RNDN);
  /* exact result is just above 0.1E-1, which should round to minfloat */
  MPFR_ASSERTN(mpfr_cmp (zz, yy) == 0);
  set_emin (emin);
  
  mpfr_clear(xx);
  mpfr_clear(yy);
  mpfr_clear(zz);
}
コード例 #21
0
int
main (void)
{
    mpfr_t x;
    mpfr_exp_t emax;

    tests_start_mpfr ();

    mpfr_init (x);

    mpfr_set_nan (x);
    mpfr_prec_round (x, 2, MPFR_RNDN);
    MPFR_ASSERTN(mpfr_nan_p (x));

    mpfr_set_inf (x, 1);
    mpfr_prec_round (x, 2, MPFR_RNDN);
    MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);

    mpfr_set_inf (x, -1);
    mpfr_prec_round (x, 2, MPFR_RNDN);
    MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) < 0);

    mpfr_set_ui (x, 0, MPFR_RNDN);
    mpfr_prec_round (x, 2, MPFR_RNDN);
    MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_POS(x));

    mpfr_set_ui (x, 0, MPFR_RNDN);
    mpfr_neg (x, x, MPFR_RNDN);
    mpfr_prec_round (x, 2, MPFR_RNDN);
    MPFR_ASSERTN(mpfr_cmp_ui (x, 0) == 0 && MPFR_IS_NEG(x));

    emax = mpfr_get_emax ();
    set_emax (0);
    mpfr_set_prec (x, 3);
    mpfr_set_str_binary (x, "0.111");
    mpfr_prec_round (x, 2, MPFR_RNDN);
    MPFR_ASSERTN(mpfr_inf_p (x) && mpfr_sgn (x) > 0);
    set_emax (emax);

    mpfr_set_prec (x, mp_bits_per_limb + 2);
    mpfr_set_ui (x, 1, MPFR_RNDN);
    mpfr_nextbelow (x);
    mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
    MPFR_ASSERTN(mpfr_cmp_ui (x, 1) == 0);

    mpfr_set_prec (x, 3);
    mpfr_set_ui (x, 5, MPFR_RNDN);
    mpfr_prec_round (x, 2, MPFR_RNDN);
    if (mpfr_cmp_ui(x, 4))
    {
        printf ("Error in tround: got ");
        mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
        printf (" instead of 4\n");
        exit (1);
    }

    /* check case when reallocation is needed */
    mpfr_set_prec (x, 3);
    mpfr_set_ui (x, 5, MPFR_RNDN); /* exact */
    mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
    if (mpfr_cmp_ui(x, 5))
    {
        printf ("Error in tround: got ");
        mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
        printf (" instead of 5\n");
        exit (1);
    }

    mpfr_clear(x);
    mpfr_init2 (x, 3);
    mpfr_set_si (x, -5, MPFR_RNDN); /* exact */
    mpfr_prec_round (x, mp_bits_per_limb + 1, MPFR_RNDN);
    if (mpfr_cmp_si(x, -5))
    {
        printf ("Error in tround: got ");
        mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
        printf (" instead of -5\n");
        exit (1);
    }

    /* check case when new precision needs less limbs */
    mpfr_set_prec (x, mp_bits_per_limb + 1);
    mpfr_set_ui (x, 5, MPFR_RNDN); /* exact */
    mpfr_prec_round (x, 3, MPFR_RNDN); /* exact */
    if (mpfr_cmp_ui(x, 5))
    {
        printf ("Error in tround: got ");
        mpfr_out_str (stdout, 10, 0, x, MPFR_RNDN);
        printf (" instead of 5\n");
        exit (1);
    }

    mpfr_clear(x);

    tests_end_mpfr ();
    return 0;
}
コード例 #22
0
ファイル: external.c プロジェクト: hoangt/PandA-bambu
void externalPlot(char *library, mpfr_t a, mpfr_t b, mp_prec_t samplingPrecision, int random, node *func, int mode, mp_prec_t prec, char *name, int type) {
  void *descr;
  void  (*myFunction)(mpfr_t, mpfr_t);
  char *error;
  mpfr_t x_h,x,y,temp,perturb,ulp,min_value;
  double xd, yd;
  FILE *file;
  gmp_randstate_t state;
  char *gplotname;
  char *dataname;
  char *outputname;


  gmp_randinit_default (state);

  if(samplingPrecision > prec) {
    sollyaFprintf(stderr, "Error: you must use a sampling precision lower than the current precision\n");
    return;
  }

  descr = dlopen(library, RTLD_NOW);
  if (descr==NULL) {
    sollyaFprintf(stderr, "Error: the given library (%s) is not available (%s)!\n",library,dlerror());
    return;
  }

  dlerror(); /* Clear any existing error */
  myFunction = (void (*)(mpfr_t, mpfr_t)) dlsym(descr, "f");
  if ((error = dlerror()) != NULL) {
    sollyaFprintf(stderr, "Error: the function f cannot be found in library %s (%s)\n",library,error);
    return;
  }

  if(name==NULL) {
    gplotname = (char *)safeCalloc(13 + strlen(PACKAGE_NAME), sizeof(char));
    sprintf(gplotname,"/tmp/%s-%04d.p",PACKAGE_NAME,fileNumber);
    dataname = (char *)safeCalloc(15 + strlen(PACKAGE_NAME), sizeof(char));
    sprintf(dataname,"/tmp/%s-%04d.dat",PACKAGE_NAME,fileNumber);
    outputname = (char *)safeCalloc(1, sizeof(char));
    fileNumber++;
    if (fileNumber >= NUMBEROFFILES) fileNumber=0;
  }
  else {
    gplotname = (char *)safeCalloc(strlen(name)+3,sizeof(char));
    sprintf(gplotname,"%s.p",name);
    dataname = (char *)safeCalloc(strlen(name)+5,sizeof(char));
    sprintf(dataname,"%s.dat",name);
    outputname = (char *)safeCalloc(strlen(name)+5,sizeof(char));   
    if ((type==PLOTPOSTSCRIPT) || (type==PLOTPOSTSCRIPTFILE)) sprintf(outputname,"%s.eps",name);
  }

  
  /* Beginning of the interesting part of the code */
  file = fopen(gplotname, "w");
  if (file == NULL) {
    sollyaFprintf(stderr,"Error: the file %s requested by plot could not be opened for writing: ",gplotname);
    sollyaFprintf(stderr,"\"%s\".\n",strerror(errno));
    return;
  }
  sollyaFprintf(file, "# Gnuplot script generated by %s\n",PACKAGE_NAME);
  if ((type==PLOTPOSTSCRIPT) || (type==PLOTPOSTSCRIPTFILE)) sollyaFprintf(file,"set terminal postscript eps color\nset out \"%s\"\n",outputname);
  sollyaFprintf(file, "set xrange [%1.50e:%1.50e]\n", mpfr_get_d(a, GMP_RNDD),mpfr_get_d(b, GMP_RNDU));
  sollyaFprintf(file, "plot \"%s\" using 1:2 with dots t \"\"\n",dataname);
  fclose(file);

  file = fopen(dataname, "w");
  if (file == NULL) {
    sollyaFprintf(stderr,"Error: the file %s requested by plot could not be opened for writing: ",dataname);
    sollyaFprintf(stderr,"\"%s\".\n",strerror(errno));
    return;
  }

  mpfr_init2(x_h,samplingPrecision);
  mpfr_init2(perturb, prec);
  mpfr_init2(x,prec);
  mpfr_init2(y,prec);
  mpfr_init2(temp,prec);
  mpfr_init2(ulp,prec);
  mpfr_init2(min_value,53);

  mpfr_sub(min_value, b, a, GMP_RNDN);
  mpfr_div_2ui(min_value, min_value, 12, GMP_RNDN);

  mpfr_set(x_h,a,GMP_RNDD);
  
  while(mpfr_less_p(x_h,b)) {
    mpfr_set(x, x_h, GMP_RNDN); // exact
    
    if (mpfr_zero_p(x_h)) {
      mpfr_set(x_h, min_value, GMP_RNDU);
    }
    else {
      if (mpfr_cmpabs(x_h, min_value) < 0) mpfr_set_d(x_h, 0., GMP_RNDN);
      else mpfr_nextabove(x_h);
    }

    if(random) {
      mpfr_sub(ulp, x_h, x, GMP_RNDN);
      mpfr_urandomb(perturb, state);
      mpfr_mul(perturb, perturb, ulp, GMP_RNDN);
      mpfr_add(x, x, perturb, GMP_RNDN);
    }

    (*myFunction)(temp,x);
    evaluateFaithful(y, func, x,prec);
    mpfr_sub(temp, temp, y, GMP_RNDN);
    if(mode==RELATIVE) mpfr_div(temp, temp, y, GMP_RNDN);
    xd =  mpfr_get_d(x, GMP_RNDN);
    if (xd >= MAX_VALUE_GNUPLOT) xd = MAX_VALUE_GNUPLOT;
    if (xd <= -MAX_VALUE_GNUPLOT) xd = -MAX_VALUE_GNUPLOT;
    sollyaFprintf(file, "%1.50e",xd);
    if (!mpfr_number_p(temp)) {
      if (verbosity >= 2) {
	changeToWarningMode();
	sollyaPrintf("Information: function undefined or not evaluable in point %s = ",variablename);
	printValue(&x);
	sollyaPrintf("\nThis point will not be plotted.\n");
	restoreMode();
      }
    }
    yd = mpfr_get_d(temp, GMP_RNDN);
    if (yd >= MAX_VALUE_GNUPLOT) yd = MAX_VALUE_GNUPLOT;
    if (yd <= -MAX_VALUE_GNUPLOT) yd = -MAX_VALUE_GNUPLOT;
    sollyaFprintf(file, "\t%1.50e\n", yd);
  }

  fclose(file);
 
  /* End of the interesting part.... */

  dlclose(descr);
  mpfr_clear(x);
  mpfr_clear(y);
  mpfr_clear(x_h);
  mpfr_clear(temp);
  mpfr_clear(perturb);
  mpfr_clear(ulp);
  mpfr_clear(min_value);

  if ((name==NULL) || (type==PLOTFILE)) {
    if (fork()==0) {
      daemon(1,1);
      execlp("gnuplot", "gnuplot", "-persist", gplotname, NULL);
      perror("An error occurred when calling gnuplot ");
      exit(1);
    }
    else wait(NULL);
  }
  else { /* Case we have an output: no daemon */
    if (fork()==0) {
      execlp("gnuplot", "gnuplot", "-persist", gplotname, NULL);
      perror("An error occurred when calling gnuplot ");
      exit(1);
    }
    else {
      wait(NULL);
      if((type==PLOTPOSTSCRIPT)) {
	remove(gplotname);
	remove(dataname);
      }
    }
  }
  
  free(gplotname);
  free(dataname);
  free(outputname);
  return;
}
コード例 #23
0
ファイル: aring-RRR.hpp プロジェクト: ajagekarakshay/M2
 void clear(ElementType &result) const { 
   mpfr_clear(&result); 
 }
コード例 #24
0
ファイル: terf.c プロジェクト: epowers/mpfr
static void
special_erf (void)
{
  mpfr_t x, y;
  int inex;

  mpfr_init2 (x, 53);
  mpfr_init2 (y, 53);

  /* erf(NaN) = NaN */
  mpfr_set_nan (x);
  mpfr_erf (y, x, MPFR_RNDN);
  if (!mpfr_nan_p (y))
    {
      printf ("mpfr_erf failed for x=NaN\n");
      exit (1);
    }

  /* erf(+Inf) = 1 */
  mpfr_set_inf (x, 1);
  mpfr_erf (y, x, MPFR_RNDN);
  if (mpfr_cmp_ui (y, 1))
    {
      printf ("mpfr_erf failed for x=+Inf\n");
      printf ("expected 1.0, got ");
      mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
      printf ("\n");
      exit (1);
    }

  /* erf(-Inf) = -1 */
  mpfr_set_inf (x, -1);
  mpfr_erf (y, x, MPFR_RNDN);
  if (mpfr_cmp_si (y, -1))
    {
      printf ("mpfr_erf failed for x=-Inf\n");
      exit (1);
    }

  /* erf(+0) = +0 */
  mpfr_set_ui (x, 0, MPFR_RNDN);
  mpfr_erf (y, x, MPFR_RNDN);
  if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
    {
      printf ("mpfr_erf failed for x=+0\n");
      exit (1);
    }

  /* erf(-0) = -0 */
  mpfr_neg (x, x, MPFR_RNDN);
  mpfr_erf (y, x, MPFR_RNDN);
  if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) > 0)
    {
      printf ("mpfr_erf failed for x=-0\n");
      exit (1);
    }

  mpfr_set_ui (x, 1, MPFR_RNDN);
  mpfr_erf (x, x, MPFR_RNDN);
  mpfr_set_str_binary (y, "0.11010111101110110011110100111010000010000100010001011");
  if (mpfr_cmp (x, y))
    {
      printf ("mpfr_erf failed for x=1.0, rnd=MPFR_RNDN\n");
      printf ("expected ");
      mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
      printf ("\n");
      printf ("got      ");
      mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
      printf ("\n");
      exit (1);
    }

  mpfr_set_str (x, "6.6", 10, MPFR_RNDN);
  mpfr_erf (x, x, MPFR_RNDN);
  if (mpfr_cmp_ui (x, 1))
    {
      printf ("mpfr_erf failed for x=6.6, rnd=MPFR_RNDN\n");
      printf ("expected 1\n");
      printf ("got      ");
      mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
      printf ("\n");
      exit (1);
    }

  mpfr_set_str (x, "-6.6", 10, MPFR_RNDN);
  mpfr_erf (x, x, MPFR_RNDN);
  if (mpfr_cmp_si (x, -1))
    {
      printf ("mpfr_erf failed for x=-6.6, rnd=MPFR_RNDN\n");
      printf ("expected -1\n");
      printf ("got      ");
      mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
      printf ("\n");
      exit (1);
    }

  mpfr_set_str (x, "6.6", 10, MPFR_RNDN);
  mpfr_erf (x, x, MPFR_RNDZ);
  mpfr_set_str_binary (y, "0.11111111111111111111111111111111111111111111111111111");
  if (mpfr_cmp (x, y))
    {
      printf ("mpfr_erf failed for x=6.6, rnd=MPFR_RNDZ\n");
      printf ("expected ");
      mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
      printf ("\n");
      printf ("got      ");
      mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
      printf ("\n");
      exit (1);
    }

  mpfr_set_str (x, "4.5", 10, MPFR_RNDN);
  mpfr_erf (x, x, MPFR_RNDN);
  mpfr_set_str_binary (y, "0.1111111111111111111111111111111100100111110100011");
  if (mpfr_cmp (x, y))
    {
      printf ("mpfr_erf failed for x=4.5, rnd=MPFR_RNDN\n");
      printf ("expected ");
      mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
      printf ("\n");
      printf ("got      ");
      mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
      printf ("\n");
      exit (1);
    }

  mpfr_set_prec (x, 120);
  mpfr_set_prec (y, 120);
  mpfr_set_str_binary (x, "0.110100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011001100110011E3");
  mpfr_erf (x, x, MPFR_RNDN);
  mpfr_set_str_binary (y, "0.11111111111111111111111111111111111111111111111111111111111111111100111111000100111011111011010000110101111100011001101");
  if (mpfr_cmp (x, y))
    {
      printf ("mpfr_erf failed for x=6.6, rnd=MPFR_RNDN\n");
      printf ("expected ");
      mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
      printf ("\n");
      printf ("got      ");
      mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
      printf ("\n");
      exit (1);
    }

  mpfr_set_prec (x, 8);
  mpfr_set_prec (y, 8);
  mpfr_set_ui (x, 50, MPFR_RNDN);
  inex = mpfr_erf (y, x, MPFR_RNDN);
  if (mpfr_cmp_ui (y, 1))
    {
      printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDN\n");
      printf ("expected 1, got ");
      mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
      printf ("\n");
      exit (1);
    }
  if (inex <= 0)
    {
      printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDN: wrong ternary value\n"
              "expected positive, got %d\n", inex);
      exit (1);
    }
  inex = mpfr_erf (x, x, MPFR_RNDZ);
  mpfr_nextbelow (y);
  if (mpfr_cmp (x, y))
    {
      printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDZ\n");
      printf ("expected ");
      mpfr_out_str (stdout, 2, 0, y, MPFR_RNDN);
      printf ("\n");
      printf ("got      ");
      mpfr_out_str (stdout, 2, 0, x, MPFR_RNDN);
      printf ("\n");
      exit (1);
    }
  if (inex >= 0)
    {
      printf ("mpfr_erf failed for x=50, rnd=MPFR_RNDN: wrong ternary value\n"
              "expected negative, got %d\n", inex);
      exit (1);
    }

  mpfr_set_prec (x, 32);
  mpfr_set_prec (y, 32);

  mpfr_set_str_binary (x, "0.1010100100111011001111100101E-1");
  mpfr_set_str_binary (y, "0.10111000001110011010110001101011E-1");
  mpfr_erf (x, x, MPFR_RNDN);
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for prec=32 (1)\n");
      exit (1);
    }

  mpfr_set_str_binary (x, "-0.10110011011010111110010001100001");
  mpfr_set_str_binary (y, "-0.1010110110101011100010111000111");
  mpfr_erf (x, x, MPFR_RNDN);
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for prec=32 (2)\n");
      mpfr_print_binary (x); printf ("\n");
      exit (1);
    }

  mpfr_set_str_binary (x, "100.10001110011110100000110000111");
  mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
  mpfr_erf (x, x, MPFR_RNDN);
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for prec=32 (3)\n");
      exit (1);
    }
  mpfr_set_str_binary (x, "100.10001110011110100000110000111");
  mpfr_erf (x, x, MPFR_RNDZ);
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for prec=32 (4)\n");
      exit (1);
    }
  mpfr_set_str_binary (x, "100.10001110011110100000110000111");
  mpfr_erf (x, x, MPFR_RNDU);
  if (mpfr_cmp_ui (x, 1))
    {
      printf ("Error: erf for prec=32 (5)\n");
      exit (1);
    }

  mpfr_set_str_binary (x, "100.10001110011110100000110001000");
  mpfr_erf (x, x, MPFR_RNDN);
  if (mpfr_cmp_ui (x, 1))
    {
      printf ("Error: erf for prec=32 (6)\n");
      exit (1);
    }
  mpfr_set_str_binary (x, "100.10001110011110100000110001000");
  mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
  mpfr_erf (x, x, MPFR_RNDZ);
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for prec=32 (7)\n");
      exit (1);
    }
  mpfr_set_str_binary (x, "100.10001110011110100000110001000");
  mpfr_erf (x, x, MPFR_RNDU);
  if (mpfr_cmp_ui (x, 1))
    {
      printf ("Error: erf for prec=32 (8)\n");
      exit (1);
    }

  mpfr_set_ui (x, 5, MPFR_RNDN);
  mpfr_erf (x, x, MPFR_RNDN);
  if (mpfr_cmp_ui (x, 1))
    {
      printf ("Error: erf for prec=32 (9)\n");
      exit (1);
    }
  mpfr_set_ui (x, 5, MPFR_RNDN);
  mpfr_erf (x, x, MPFR_RNDU);
  if (mpfr_cmp_ui (x, 1))
    {
      printf ("Error: erf for prec=32 (10)\n");
      exit (1);
    }
  mpfr_set_ui (x, 5, MPFR_RNDN);
  mpfr_erf (x, x, MPFR_RNDZ);
  mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for prec=32 (11)\n");
      exit (1);
    }
  mpfr_set_ui (x, 5, MPFR_RNDN);
  mpfr_erf (x, x, MPFR_RNDD);
  mpfr_set_str_binary (y, "0.11111111111111111111111111111111");
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for prec=32 (12)\n");
      exit (1);
    }

  mpfr_set_prec (x, 43);
  mpfr_set_prec (y, 64);
  mpfr_set_str_binary (x, "-0.1101110110101111100101011101110101101001001e3");
  mpfr_erf (y, x, MPFR_RNDU);
  mpfr_set_prec (x, 64);
  mpfr_set_str_binary (x, "-0.1111111111111111111111111111111111111111111111111111111111111111");
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for prec=43,64 (13)\n");
      exit (1);
    }

  /* worst cases */
  mpfr_set_prec (x, 53);
  mpfr_set_prec (y, 53);
  mpfr_set_str_binary (x, "1.0000000000000000000000000000000000000110000000101101");
  mpfr_erf (y, x, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.110101111011101100111101001110100000101011000011001");
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for worst case (1)\n");
      exit (1);
    }

  mpfr_set_str_binary (x, "1.0000000000000000000000000000011000111010101101011010");
  mpfr_erf (y, x, MPFR_RNDU);
  mpfr_set_str_binary (x, "0.11010111101110110011110100111100100111100011111000110");
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for worst case (2a)\n");
      exit (1);
    }
  mpfr_set_str_binary (x, "1.0000000000000000000000000000011000111010101101011010");
  mpfr_erf (y, x, MPFR_RNDD);
  mpfr_set_str_binary (x, "0.11010111101110110011110100111100100111100011111000101");
  if (mpfr_cmp (x, y))
    {
      printf ("Error: erf for worst case (2b)\n");
      exit (1);
    }

  mpfr_clear (x);
  mpfr_clear (y);
}
コード例 #25
0
ファイル: tsech.c プロジェクト: Scorpiion/Renux_cross_gcc
static void
check_specials (void)
{
  mpfr_t  x, y;

  mpfr_init2 (x, 123L);
  mpfr_init2 (y, 123L);

  mpfr_set_nan (x);
  mpfr_sech (y, x, GMP_RNDN);
  if (! mpfr_nan_p (y))
    {
      printf ("Error: sech(NaN) != NaN\n");
      exit (1);
    }

  mpfr_set_inf (x, 1);
  mpfr_sech (y, x, GMP_RNDN);
  if (! (MPFR_IS_ZERO (y) && MPFR_SIGN (y) > 0))
    {
      printf ("Error: sech(+Inf) != +0\n");
      exit (1);
    }

  mpfr_set_inf (x, -1);
  mpfr_sech (y, x, GMP_RNDN);
  if (! (MPFR_IS_ZERO (y) && MPFR_SIGN (y) > 0))
    {
      printf ("Error: sech(-Inf) != +0\n");
      exit (1);
    }

  /* sec(+/-0) = 1 */
  mpfr_set_ui (x, 0, GMP_RNDN);
  mpfr_sech (y, x, GMP_RNDN);
  if (mpfr_cmp_ui (y, 1))
    {
      printf ("Error: sech(+0) != 1\n");
      exit (1);
    }
  mpfr_neg (x, x, GMP_RNDN);
  mpfr_sech (y, x, GMP_RNDN);
  if (mpfr_cmp_ui (y, 1))
    {
      printf ("Error: sech(-0) != 1\n");
      exit (1);
    }

  /* check huge x */
  mpfr_set_str (x, "8e8", 10, GMP_RNDN);
  mpfr_sech (y, x, GMP_RNDN);
  if (! (mpfr_zero_p (y) && MPFR_SIGN (y) > 0))
    {
      printf ("Error: sech(8e8) != +0\n");
      exit (1);
    }
  mpfr_set_str (x, "-8e8", 10, GMP_RNDN);
  mpfr_sech (y, x, GMP_RNDN);
  if (! (mpfr_zero_p (y) && MPFR_SIGN (y) > 0))
    {
      printf ("Error: sech(-8e8) != +0\n");
      exit (1);
    }

  mpfr_clear (x);
  mpfr_clear (y);
}
コード例 #26
0
ファイル: terf.c プロジェクト: epowers/mpfr
static void
large_arg (void)
{
  mpfr_t x, y;
  unsigned int flags;

  mpfr_init2 (x, 88);
  mpfr_init2 (y, 98);

  mpfr_set_si_2exp (x, -1, 173, MPFR_RNDN);
  mpfr_clear_flags ();
  mpfr_erfc (y, x, MPFR_RNDN);
  flags = __gmpfr_flags;
  if (mpfr_cmp_ui (y, 2) != 0)
    {
      printf ("mpfr_erfc failed for large x (1)\n");
      exit (1);
    }
  if (flags != MPFR_FLAGS_INEXACT)
    {
      printf ("mpfr_erfc sets incorrect flags for large x (1)\n");
      printf ("Expected %u, got %u\n",
              (unsigned int) MPFR_FLAGS_INEXACT, flags);
      exit (1);
    }

  mpfr_set_si_2exp (x, -1, mpfr_get_emax () - 3, MPFR_RNDN);
  mpfr_clear_flags ();
  mpfr_erfc (y, x, MPFR_RNDN);
  flags = __gmpfr_flags;
  if (mpfr_cmp_ui (y, 2) != 0)
    {
      printf ("mpfr_erfc failed for large x (1b)\n");
      exit (1);
    }
  if (flags != MPFR_FLAGS_INEXACT)
    {
      printf ("mpfr_erfc sets incorrect flags for large x (1b)\n");
      printf ("Expected %u, got %u\n",
              (unsigned int) MPFR_FLAGS_INEXACT, flags);
      exit (1);
    }

  mpfr_set_prec (x, 33);
  mpfr_set_prec (y, 43);
  mpfr_set_str_binary (x, "1.11000101010111011000111100101001e6");
  mpfr_erfc (y, x, MPFR_RNDD);
  mpfr_set_prec (x, 43);
  mpfr_set_str_binary (x, "100010011100101100001101100101011101101E-18579");
  if (mpfr_cmp (x, y) != 0)
    {
      printf ("mpfr_erfc failed for large x (2)\n");
      exit (1);
    }

  mpfr_set_prec (y, 43);
  mpfr_set_si_2exp (x, 1, 11, MPFR_RNDN);
  mpfr_erfc (y, x, MPFR_RNDN);
  mpfr_set_str_binary (x, "0.1100000100100010101111001111010010001000110E-6051113");
  if (mpfr_cmp (x, y) != 0)
    {
      printf ("mpfr_erfc failed for large x (3)\n");
      exit (1);
    }

  mpfr_set_prec (x, 75);
  mpfr_set_prec (y, 85);
  mpfr_set_str_binary (x, "0.111110111111010011101011001100001010011110101010011111010010111101010001011E15");
  mpfr_erfc (y, x, MPFR_RNDN);
  if (mpfr_cmp_ui (y, 0) || mpfr_sgn (y) < 0)
    {
      printf ("mpfr_erfc failed for large x (3b)\n");
      exit (1);
    }

  mpfr_set_prec (x, 2);
  mpfr_set_prec (y, 21);
  mpfr_set_str_binary (x, "-1.0e3");
  mpfr_clear_flags ();
  mpfr_erfc (y, x, MPFR_RNDZ);
  flags = __gmpfr_flags;
  mpfr_set_prec (x, 21);
  mpfr_set_str_binary (x, "1.11111111111111111111");
  if (mpfr_cmp (x, y) != 0)
    {
      printf ("mpfr_erfc failed for large x (4)\n");
      exit (1);
    }
  if (flags != MPFR_FLAGS_INEXACT)
    {
      printf ("mpfr_erfc sets incorrect flags for large x (4)\n");
      printf ("Expected %u, got %u\n",
              (unsigned int) MPFR_FLAGS_INEXACT, flags);
      exit (1);
    }

  mpfr_set_prec (x, 2);
  mpfr_set_prec (y, 31);
  mpfr_set_str_binary (x, "-1.0e3");
  mpfr_clear_flags ();
  mpfr_erfc (y, x, MPFR_RNDZ);
  flags = __gmpfr_flags;
  mpfr_set_prec (x, 31);
  mpfr_set_str_binary (x, "1.111111111111111111111111111111");
  if (mpfr_cmp (x, y) != 0)
    {
      printf ("mpfr_erfc failed for x=-8, prec=31 (5)\n");
      printf ("expected "); mpfr_dump (x);
      printf ("got      "); mpfr_dump (y);
      exit (1);
    }
  if (flags != MPFR_FLAGS_INEXACT)
    {
      printf ("mpfr_erfc sets incorrect flags for large x (5)\n");
      printf ("Expected %u, got %u\n",
              (unsigned int) MPFR_FLAGS_INEXACT, flags);
      exit (1);
    }

  /* Reported by Christopher Creutzig on 2007-07-10. */
  mpfr_set_prec (x, 53);
  mpfr_set_prec (y, 53);
  mpfr_set_si_2exp (x, 54563, -1, MPFR_RNDN);
  mpfr_erfc (y, x, MPFR_RNDZ);
  mpfr_set_ui (x, 0, MPFR_RNDN);
  if (! mpfr_equal_p (y, x))
    {
      printf ("mpfr_erfc failed for x=27281.5, prec=53 (6)\n");
      printf ("expected "); mpfr_dump (x);
      printf ("got      "); mpfr_dump (y);
      exit (1);
    }

  /* same test with rounding away from zero */
  mpfr_set_si_2exp (x, 54563, -1, MPFR_RNDN);
  mpfr_erfc (y, x, MPFR_RNDU);
  mpfr_set_ui (x, 0, MPFR_RNDN);
  mpfr_nextabove (x);
  if (! mpfr_equal_p (y, x))
    {
      printf ("mpfr_erfc failed for x=27281.5, prec=53 (7)\n");
      printf ("expected "); mpfr_dump (x);
      printf ("got      "); mpfr_dump (y);
      exit (1);
    }

  mpfr_clear (x);
  mpfr_clear (y);
}
コード例 #27
0
int main()
{
    slong iter;
    flint_rand_t state;

    flint_printf("add....");
    fflush(stdout);

    flint_randinit(state);

    /* test exact addition: (x + y) + z == x + (y + z) */
    for (iter = 0; iter < 100000 * arb_test_multiplier(); iter++)
    {
        slong bits, res1, res2, res3, res4;
        fmpr_t x, y, z, t, u;

        bits = 2 + n_randint(state, 200);

        fmpr_init(x);
        fmpr_init(y);
        fmpr_init(z);
        fmpr_init(t);
        fmpr_init(u);

        fmpr_randtest_special(x, state, bits, 10);
        fmpr_randtest_special(y, state, bits, 10);
        fmpr_randtest_special(z, state, bits, 10);
        fmpr_randtest_special(t, state, bits, 10);
        fmpr_randtest_special(u, state, bits, 10);

        res1 = fmpr_add(t, x, y, FMPR_PREC_EXACT, FMPR_RND_DOWN);
        res2 = fmpr_add(t, t, z, FMPR_PREC_EXACT, FMPR_RND_DOWN);
        res3 = fmpr_add(u, y, z, FMPR_PREC_EXACT, FMPR_RND_DOWN);
        res4 = fmpr_add(u, x, u, FMPR_PREC_EXACT, FMPR_RND_DOWN);

        if (!fmpr_equal(t, u) ||
            res1 != FMPR_RESULT_EXACT || res2 != FMPR_RESULT_EXACT ||
            res3 != FMPR_RESULT_EXACT || res4 != FMPR_RESULT_EXACT)
        {
            flint_printf("FAIL\n\n");
            flint_printf("bits = %wd\n", bits);
            flint_printf("x = "); fmpr_print(x); flint_printf("\n\n");
            flint_printf("y = "); fmpr_print(y); flint_printf("\n\n");
            flint_printf("z = "); fmpr_print(z); flint_printf("\n\n");
            flint_printf("t = "); fmpr_print(t); flint_printf("\n\n");
            flint_printf("u = "); fmpr_print(u); flint_printf("\n\n");
            abort();
        }

        fmpr_clear(x);
        fmpr_clear(y);
        fmpr_clear(z);
        fmpr_clear(t);
        fmpr_clear(u);
    }

    /* compare with add_naive */
    for (iter = 0; iter < 1000000 * arb_test_multiplier(); iter++)
    {
        slong prec, ret1, ret2;
        fmpr_t x, y, z, w;
        fmpr_rnd_t rnd;

        fmpr_init(x);
        fmpr_init(y);
        fmpr_init(z);
        fmpr_init(w);

        fmpr_randtest_special(x, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 200));
        fmpr_randtest_special(y, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 200));
        fmpr_randtest_special(z, state, 1 + n_randint(state, 1000), 1 + n_randint(state, 200));

        prec = 2 + n_randint(state, 1000);
        if (n_randint(state, 10) == 0 &&
                fmpz_bits(fmpr_expref(x)) < 10 &&
                fmpz_bits(fmpr_expref(y)) < 10)
            prec = FMPR_PREC_EXACT;

        switch (n_randint(state, 4))
        {
            case 0: rnd = FMPR_RND_DOWN; break;
            case 1: rnd = FMPR_RND_UP; break;
            case 2: rnd = FMPR_RND_FLOOR; break;
            default: rnd = FMPR_RND_CEIL; break;
        }

        ret1 = fmpr_add(z, x, y, prec, rnd);
        ret2 = fmpr_add_naive(w, x, y, prec, rnd);

        if (!fmpr_equal(z, w) || ret1 != ret2 ||
            !fmpr_check_ulp(z, ret1, prec) || !fmpr_check_ulp(w, ret2, prec))
        {
            flint_printf("FAIL\n\n");
            flint_printf("iter %wd\n", iter);
            flint_printf("prec = %wd\n", prec);
            flint_printf("x = "); fmpr_print(x); flint_printf("\n\n");
            flint_printf("y = "); fmpr_print(y); flint_printf("\n\n");
            flint_printf("z = "); fmpr_print(z); flint_printf("\n\n");
            flint_printf("w = "); fmpr_print(w); flint_printf("\n\n");
            flint_printf("ret1 = %wd, ret2 = %wd\n", ret1, ret2);
            abort();
        }

        fmpr_clear(x);
        fmpr_clear(y);
        fmpr_clear(z);
        fmpr_clear(w);
    }

    /* compare rounding with mpfr */
    for (iter = 0; iter < 1000000 * arb_test_multiplier(); iter++)
    {
        slong bits, res;
        int mpfr_res;
        fmpr_t x, y, z, w;
        mpfr_t X, Y, Z;

        bits = 2 + n_randint(state, 500);

        fmpr_init(x);
        fmpr_init(y);
        fmpr_init(z);
        fmpr_init(w);

        mpfr_init2(X, bits + 500);
        mpfr_init2(Y, bits + 500);
        mpfr_init2(Z, bits);

        fmpr_randtest_special(x, state, bits + n_randint(state, 500), 10);
        fmpr_randtest_special(y, state, bits + n_randint(state, 500), 10);
        fmpr_randtest_special(z, state, bits, 10);

        fmpr_get_mpfr(X, x, MPFR_RNDN);
        fmpr_get_mpfr(Y, y, MPFR_RNDN);

        switch (n_randint(state, 4))
        {
            case 0:
                mpfr_res = mpfr_add(Z, X, Y, MPFR_RNDZ);
                res = fmpr_add(z, x, y, bits, FMPR_RND_DOWN);
                break;
            case 1:
                mpfr_res = mpfr_add(Z, X, Y, MPFR_RNDA);
                res = fmpr_add(z, x, y, bits, FMPR_RND_UP);
                break;
            case 2:
                mpfr_res = mpfr_add(Z, X, Y, MPFR_RNDD);
                res = fmpr_add(z, x, y, bits, FMPR_RND_FLOOR);
                break;
            default:
                mpfr_res = mpfr_add(Z, X, Y, MPFR_RNDU);
                res = fmpr_add(z, x, y, bits, FMPR_RND_CEIL);
                break;
        }

        fmpr_set_mpfr(w, Z);

        if (!fmpr_equal(z, w) || (res == FMPR_RESULT_EXACT) != (mpfr_res == 0)
            || !fmpr_check_ulp(z, res, bits))
        {
            flint_printf("FAIL\n\n");
            flint_printf("iter %wd\n", iter);
            flint_printf("bits = %wd\n", bits);
            flint_printf("x = "); fmpr_print(x); flint_printf("\n\n");
            flint_printf("y = "); fmpr_print(y); flint_printf("\n\n");
            flint_printf("z = "); fmpr_print(z); flint_printf("\n\n");
            flint_printf("w = "); fmpr_print(w); flint_printf("\n\n");
            flint_printf("returned: %wd, %d\n", res, mpfr_res);
            abort();
        }

        /* check error bound */
        if (!fmpr_is_nan(z) && !fmpr_is_inf(z))
        {
            fmpr_t z_exact, error_bound, true_error;

            fmpr_init(z_exact);
            fmpr_init(error_bound);
            fmpr_init(true_error);

            fmpr_set_error_result(error_bound, z, res);
            fmpr_add(z_exact, x, y, FMPR_PREC_EXACT, FMPR_RND_DOWN);

            fmpr_sub(true_error, z, z_exact, FMPR_PREC_EXACT, FMPR_RND_DOWN);
            fmpr_abs(true_error, true_error);

            if (fmpr_is_zero(error_bound) != fmpr_is_zero(true_error) ||
                fmpr_cmp(true_error, error_bound) > 0)
            {
                flint_printf("FAIL: error bound\n\n");
                flint_printf("bits = %wd\n", bits);
                flint_printf("x = "); fmpr_print(x); flint_printf("\n\n");
                flint_printf("y = "); fmpr_print(y); flint_printf("\n\n");
                flint_printf("z = "); fmpr_print(z); flint_printf("\n\n");
                flint_printf("z_exact = "); fmpr_print(z_exact); flint_printf("\n\n");
                flint_printf("true_error = "); fmpr_print(true_error); flint_printf("\n\n");
                flint_printf("error_bound = "); fmpr_print(error_bound); flint_printf("\n\n");
                abort();
            }

            fmpr_clear(z_exact);
            fmpr_clear(error_bound);
            fmpr_clear(true_error);
        }

        fmpr_clear(x);
        fmpr_clear(y);
        fmpr_clear(z);
        fmpr_clear(w);

        mpfr_clear(X);
        mpfr_clear(Y);
        mpfr_clear(Z);
    }

    flint_randclear(state);
    flint_cleanup();
    flint_printf("PASS\n");
    return EXIT_SUCCESS;
}
コード例 #28
0
ファイル: tcheck.c プロジェクト: SESA/EbbRT-mpfr
int
main (void)
{
  mpfr_t a;
  mp_limb_t *p, tmp;
  mp_size_t s;
  mpfr_prec_t pr;
  int max;

  tests_start_mpfr ();
  for(pr = MPFR_PREC_MIN ; pr < 500 ; pr++)
    {
      mpfr_init2 (a, pr);
      if (!mpfr_check(a)) ERROR("for init");
      /* Check special cases */
      MPFR_SET_NAN(a);
      if (!mpfr_check(a)) ERROR("for nan");
      MPFR_SET_POS(a);
      MPFR_SET_INF(a);
      if (!mpfr_check(a)) ERROR("for inf");
      MPFR_SET_ZERO(a);
      if (!mpfr_check(a)) ERROR("for zero");
      /* Check var */
      mpfr_set_ui(a, 2, MPFR_RNDN);
      if (!mpfr_check(a)) ERROR("for set_ui");
      mpfr_clear_overflow();
      max = 1000; /* Allows max 2^1000 bits for the exponent */
      while ((!mpfr_overflow_p()) && (max>0))
        {
          mpfr_mul(a, a, a, MPFR_RNDN);
          if (!mpfr_check(a)) ERROR("for mul");
          max--;
        }
      if (max==0) ERROR("can't reach overflow");
      mpfr_set_ui(a, 2137, MPFR_RNDN);
      /* Corrupt a and check for it */
      MPFR_SIGN(a) = 2;
      if (mpfr_check(a))  ERROR("sgn");
      MPFR_SET_POS(a);
      /* Check prec */
      MPFR_PREC(a) = 1;
      if (mpfr_check(a))  ERROR("precmin");
#if MPFR_VERSION_MAJOR < 3
      /* Disable the test with MPFR >= 3 since mpfr_prec_t is now signed.
         The "if" below is sufficient, but the MPFR_PREC_MAX+1 generates
         a warning with GCC 4.4.4 even though the test is always false. */
      if ((mpfr_prec_t) 0 - 1 > 0)
        {
          MPFR_PREC(a) = MPFR_PREC_MAX+1;
          if (mpfr_check(a))  ERROR("precmax");
        }
#endif
      MPFR_PREC(a) = pr;
      if (!mpfr_check(a)) ERROR("prec");
      /* Check exponent */
      MPFR_EXP(a) = MPFR_EXP_INVALID;
      if (mpfr_check(a))  ERROR("exp invalid");
      MPFR_EXP(a) = -MPFR_EXP_INVALID;
      if (mpfr_check(a))  ERROR("-exp invalid");
      MPFR_EXP(a) = 0;
      if (!mpfr_check(a)) ERROR("exp 0");
      /* Check Mantissa */
      p = MPFR_MANT(a);
      MPFR_MANT(a) = NULL;
      if (mpfr_check(a))  ERROR("Mantissa Null Ptr");
      MPFR_MANT(a) = p;
      /* Check size */
      s = MPFR_GET_ALLOC_SIZE(a);
      MPFR_SET_ALLOC_SIZE(a, 0);
      if (mpfr_check(a))  ERROR("0 size");
      MPFR_SET_ALLOC_SIZE(a, MP_SIZE_T_MIN);
      if (mpfr_check(a))  ERROR("min size");
      MPFR_SET_ALLOC_SIZE(a, MPFR_LIMB_SIZE(a)-1 );
      if (mpfr_check(a))  ERROR("size < prec");
      MPFR_SET_ALLOC_SIZE(a, s);
      /* Check normal form */
      tmp = MPFR_MANT(a)[0];
      if ((pr % GMP_NUMB_BITS) != 0)
        {
          MPFR_MANT(a)[0] = ~0;
          if (mpfr_check(a))  ERROR("last bits non 0");
        }
      MPFR_MANT(a)[0] = tmp;
      MPFR_MANT(a)[MPFR_LIMB_SIZE(a)-1] &= MPFR_LIMB_MASK (GMP_NUMB_BITS-1);
      if (mpfr_check(a))  ERROR("last bits non 0");
      /* Final */
      mpfr_set_ui(a, 2137, MPFR_RNDN);
      if (!mpfr_check(a)) ERROR("after last set");
      mpfr_clear (a);
      if (mpfr_check(a))  ERROR("after clear");
    }
  tests_end_mpfr ();
  return 0;
}
コード例 #29
0
ファイル: tadd.c プロジェクト: mahdiz/mpclib
void
check_inexact (void)
{
  mpfr_t x, y, z, u;
  mp_prec_t px, py, pu, pz;
  int inexact, cmp;
  mp_rnd_t rnd;
  
  mpfr_init (x);
  mpfr_init (y);
  mpfr_init (z);
  mpfr_init (u);

  mpfr_set_prec (x, 2);
  mpfr_set_str_raw (x, "0.1E-4");
  mpfr_set_prec (u, 33);
  mpfr_set_str_raw (u, "0.101110100101101100000000111100000E-1");
  mpfr_set_prec (y, 31);
  if ((inexact = mpfr_add (y, x, u, GMP_RNDN)))
    {
      fprintf (stderr, "Wrong inexact flag (2): expected 0, got %d\n", inexact);
      exit (1);
    }

  mpfr_set_prec (x, 2);
  mpfr_set_str_raw (x, "0.1E-4");
  mpfr_set_prec (u, 33);
  mpfr_set_str_raw (u, "0.101110100101101100000000111100000E-1");
  mpfr_set_prec (y, 28);
  if ((inexact = mpfr_add (y, x, u, GMP_RNDN)))
    {
      fprintf (stderr, "Wrong inexact flag (1): expected 0, got %d\n", inexact);
      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);
	  mpfr_random (u);
	  for (py=2; py<MAX_PREC; py++)
	    {
	      mpfr_set_prec (y, py);
	      pz =  (mpfr_cmp_abs (x, u) >= 0) ? MPFR_EXP(x)-MPFR_EXP(u)
		: MPFR_EXP(u)-MPFR_EXP(x);
	      /* x + u is exactly representable with precision
		 abs(EXP(x)-EXP(u)) + max(prec(x), prec(u)) + 1 */
	      pz = pz + MAX(MPFR_PREC(x), MPFR_PREC(u)) + 1;
	      mpfr_set_prec (z, pz);
	      rnd = LONG_RAND () % 4;
	      if (mpfr_add (z, x, u, rnd))
		{
		  fprintf (stderr, "z <- x + u should be exact\n");
		  printf ("x="); mpfr_print_binary (x); putchar ('\n');
		  printf ("u="); mpfr_print_binary (u); putchar ('\n');
		  printf ("z="); mpfr_print_binary (z); putchar ('\n');
		  exit (1);
		}
	      for (rnd=0; rnd<4; rnd++)
		{
		  inexact = mpfr_add (y, x, u, rnd);
		  cmp = mpfr_cmp (y, z);
		  if (((inexact == 0) && (cmp != 0)) ||
		      ((inexact > 0) && (cmp <= 0)) ||
		      ((inexact < 0) && (cmp >= 0)))
		    {
		      fprintf (stderr, "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); putchar ('\n');
		      printf ("u="); mpfr_print_binary (u); putchar ('\n');
		      printf ("y=  "); mpfr_print_binary (y); putchar ('\n');
		      printf ("x+u="); mpfr_print_binary (z); putchar ('\n');
		      exit (1);
		    }
		}
	    }
	}
    }

  mpfr_clear (x);
  mpfr_clear (y);
  mpfr_clear (z);
  mpfr_clear (u);
}
コード例 #30
0
ファイル: chebyshevformaux.c プロジェクト: windover/sollya
/*Computes the antiderivative of a polynomial in Chebyshev basis.
  NOTE: the constant coefficient is set to zero, but it should be viewed as a constant*/
void getChebCoeffsIntegrationPolynomial(sollya_mpfi_t*coeffs, sollya_mpfi_t *chebCoeffs, int n, sollya_mpfi_t x){
  sollya_mpfi_t z1, z2, ui, vi;

  int i;
  sollya_mpfi_t *c;
  mpfr_t u,v;
  mp_prec_t prec;
  prec = sollya_mpfi_get_prec(coeffs[0]);

  c=(sollya_mpfi_t *)safeMalloc((n+1)*sizeof(sollya_mpfi_t));

  for (i=0;i<n+1;i++){
    sollya_mpfi_init2(c[i],prec);
    sollya_mpfi_set_ui(c[i],0);
  }

  if(n>0){
    sollya_mpfi_div_ui(c[1],chebCoeffs[2],2);
    sollya_mpfi_sub(c[1],chebCoeffs[0], c[1]);
  }


  for (i=2;i<n-1;i++){
    sollya_mpfi_sub(c[i],chebCoeffs[i-1],chebCoeffs[i+1]);
    sollya_mpfi_div_ui(c[i],c[i],2*i);

  }


  if(n>1){
    sollya_mpfi_set(c[n-1],chebCoeffs[n-2]);
    sollya_mpfi_div_ui(c[n-1],c[n-1],2*(n-1));
  }

  if(n>0){
    sollya_mpfi_set(c[n],chebCoeffs[n-1]);
    sollya_mpfi_div_ui(c[n],c[n],2*(n));
  }



  /*we have in c_i the values of the coefs of \int P(y) = \sum c_i T_i(x) (the constant of integration in c_0 is not computed*/
  /*we have to multiply by 1/y'(x), which is z1=(b-a)/2 */

  /*we compute z1=(b-a)/2*/

  sollya_mpfi_init2(ui, prec);
  sollya_mpfi_init2(vi, prec);


  mpfr_init2(u, prec);
  mpfr_init2(v, prec);

  sollya_mpfi_init2(z1, prec);
  sollya_mpfi_init2(z2, prec);

  sollya_mpfi_get_left(u,x);
  sollya_mpfi_get_right(v,x);

  sollya_mpfi_set_fr(ui,u);
  sollya_mpfi_set_fr(vi,v);

  sollya_mpfi_sub(z2,vi,ui);

  sollya_mpfi_div_ui(z1,z2,2);

  for (i=1;i<n+1;i++){
    sollya_mpfi_mul(c[i], c[i],z1);
  }

  for (i=0;i<n+1;i++){
    sollya_mpfi_set(coeffs[i], c[i]);
  }
  for (i=0;i<n+1;i++){
    sollya_mpfi_clear(c[i]);
  }
  safeFree(c);
  sollya_mpfi_clear(z1);
  sollya_mpfi_clear(z2);
  sollya_mpfi_clear(ui);
  sollya_mpfi_clear(vi);
  mpfr_clear(u);
  mpfr_clear(v);
}