Ejemplo n.º 1
0
    // Refine the random square
    mpfr_prec_t Refine(gmp_randstate_t r, mpfr_prec_t prec, long num = 1)
      const {
      if (num <= 0) return prec;
      // Use _vx as scratch
      prec += num * chunk_;
      mpfr_div_2ui(_eps, _eps, num * chunk_, MPFR_RNDN);

      mpz_urandomb(_ui, r, num * chunk_);
      mpfr_set_prec(_up, prec);
      mpfr_set_z_2exp(_up, _ui, -prec, MPFR_RNDN);
      mpfr_set_prec(_vx, prec);
      mpfr_add(_vx, _u, _up, MPFR_RNDN);
      mpfr_swap(_u, _vx);       // u = vx
      mpfr_add(_up, _u, _eps, MPFR_RNDN);

      mpz_urandomb(_vi, r, num * chunk_);
      mpfr_set_prec(_vp, prec);
      mpfr_set_z_2exp(_vp, _vi, -prec, MPFR_RNDN);
      mpfr_set_prec(_vx, prec);
      mpfr_add(_vx, _v, _vp, MPFR_RNDN);
      mpfr_swap(_v, _vx);       // v = vx
      mpfr_add(_vp, _v, _eps, MPFR_RNDN);

      return prec;
    }
Ejemplo n.º 2
0
void
mpc_swap (mpc_ptr a, mpc_ptr b)
{
  /* assumes real and imaginary parts do not overlap */
  mpfr_swap (MPC_RE(a), MPC_RE(b));
  mpfr_swap (MPC_IM(a), MPC_IM(b));
}
static void
check_random (mpfr_prec_t p)
{
  mpfr_t a1,b,c,a2;
  int r;
  int i, inexact1, inexact2;

  mpfr_inits2 (p, a1, b, c, a2, (mpfr_ptr) 0);

  for (i = 0 ; i < 500 ; i++)
    {
      mpfr_urandomb (b, RANDS);
      mpfr_urandomb (c, RANDS);
      if (MPFR_IS_PURE_FP(b) && MPFR_IS_PURE_FP(c))
        {
          if (MPFR_GET_EXP(b) < MPFR_GET_EXP(c))
            mpfr_swap(b, c);
          if (MPFR_IS_PURE_FP(b) && MPFR_IS_PURE_FP(c))
            for (r = 0 ; r < MPFR_RND_MAX ; r++)
              {
                inexact1 = mpfr_add1(a1, b, c, (mpfr_rnd_t) r);
                inexact2 = mpfr_add1sp(a2, b, c, (mpfr_rnd_t) r);
                if (mpfr_cmp(a1, a2))
                  STD_ERROR;
                if (inexact1 != inexact2)
                  STD_ERROR2;
              }
        }
    }

  mpfr_clears (a1, a2, b, c, (mpfr_ptr) 0);
}
Ejemplo n.º 4
0
mpfr_t* compute_rho_to_z_matrix(unsigned long Lambda_arg, long prec){
	/* To avoid writing lambda + 1 so many times...*/
	unsigned long Lambda=Lambda_arg+1;
	mpfr_t* temps=malloc(sizeof(mpfr_t)*(Lambda));
	mpfr_init2(temps[0],prec);
	mpfr_set_ui(temps[0],8,MPFR_RNDN);
	mpfr_sqrt(temps[0],temps[0],MPFR_RNDN);
	mpfr_neg(temps[0],temps[0],MPFR_RNDN);
	for(unsigned long j=1;j<Lambda;j++){
		mpfr_init2(temps[j],prec);
		mpfr_mul_si(temps[j],temps[j-1],2*j-3,MPFR_RNDN);
		mpfr_div_ui(temps[j],temps[j],j,MPFR_RNDN); 
	}
	mpfr_sub_ui(temps[1],temps[1],2,MPFR_RNDN);
	mpfr_add_ui(temps[0],temps[0],3,MPFR_RNDN);
	mpfr_t temp;
	mpfr_init2(temp,prec);
	mpfr_t temp2;
	mpfr_init2(temp2,prec);

	mpfr_t* result=malloc(sizeof(mpfr_t)*(Lambda)*(Lambda));
	mpfr_init2(result[0],prec);
	mpfr_set_ui(result[0],1,MPFR_RNDN);
	for(unsigned long j=1; j<(Lambda*Lambda); j++){
		mpfr_init2(result[j],prec);
		mpfr_set_zero(result[j],1);
	}
	for(unsigned long j=1;j<Lambda;j++){
		mpfr_set_ui(temp,1,MPFR_RNDN);
		for(unsigned long k=0;k<=j;k++){
			mpfr_mul(temp2,temps[j-k],temp,MPFR_RNDN);
			mpfr_add(result[j+Lambda],result[j+Lambda],temp2,MPFR_RNDN);
			mpfr_mul_si(temp,temp,-2,MPFR_RNDN); 
		} 
	}
	for(unsigned long i=2;i<Lambda;i++){
		for(unsigned long j=1;j<Lambda;j++){
			for(unsigned long k=i-1;k<Lambda-j;k++){
				mpfr_mul(temp,result[Lambda*(i-1)+k],result[j+Lambda],MPFR_RNDN);
				mpfr_add(result[Lambda*i+k+j],result[Lambda*i+k+j],temp,MPFR_RNDN);
			}

		} 
	} 

	/* transposition */
	for(unsigned long i=0;i<Lambda;i++){
		for(unsigned long j=0;j<i;j++){
		mpfr_swap(result[i+Lambda*j],result[j+Lambda*i]);
		}
	}
	for(unsigned long j=0;j<Lambda;j++){
		mpfr_clear(temps[j]);
	}
	free(temps);
	mpfr_clear(temp);
	mpfr_clear(temp2);
	return result; 
}
Ejemplo n.º 5
0
int
mpc_mul_i (mpc_ptr a, mpc_srcptr b, int sign, mpc_rnd_t rnd)
/* if sign is >= 0, multiply by i, otherwise by -i */
{
  int   inex_re, inex_im;
  mpfr_t tmp;

  /* Treat the most probable case of compatible precisions first */
  if (     MPFR_PREC (MPC_RE (b)) == MPFR_PREC (MPC_IM (a))
        && MPFR_PREC (MPC_IM (b)) == MPFR_PREC (MPC_RE (a)))
  {
     if (a == b)
        mpfr_swap (MPC_RE (a), MPC_IM (a));
     else
     {
        mpfr_set (MPC_RE (a), MPC_IM (b), GMP_RNDN);
        mpfr_set (MPC_IM (a), MPC_RE (b), GMP_RNDN);
     }
     if (sign >= 0)
        MPFR_CHANGE_SIGN (MPC_RE (a));
     else
        MPFR_CHANGE_SIGN (MPC_IM (a));
     inex_re = 0;
     inex_im = 0;
  }
  else
  {
     if (a == b)
     {
        mpfr_init2 (tmp, MPFR_PREC (MPC_RE (a)));
        if (sign >= 0)
        {
           inex_re = mpfr_neg (tmp, MPC_IM (b), MPC_RND_RE (rnd));
           inex_im = mpfr_set (MPC_IM (a), MPC_RE (b), MPC_RND_IM (rnd));
        }
        else
        {
           inex_re = mpfr_set (tmp, MPC_IM (b), MPC_RND_RE (rnd));
           inex_im = mpfr_neg (MPC_IM (a), MPC_RE (b), MPC_RND_IM (rnd));
        }
        mpfr_clear (MPC_RE (a));
        MPC_RE (a)[0] = tmp [0];
     }
     else
        if (sign >= 0)
        {
           inex_re = mpfr_neg (MPC_RE (a), MPC_IM (b), MPC_RND_RE (rnd));
           inex_im = mpfr_set (MPC_IM (a), MPC_RE (b), MPC_RND_IM (rnd));
        }
        else
        {
           inex_re = mpfr_set (MPC_RE (a), MPC_IM (b), MPC_RND_RE (rnd));
           inex_im = mpfr_neg (MPC_IM (a), MPC_RE (b), MPC_RND_IM (rnd));
        }
  }

  return MPC_INEX(inex_re, inex_im);
}
int
mpfi_revert_if_needed (mpfi_ptr a)
{
  if ( MPFI_NAN_P (a) )
    return 0;

  if ( mpfr_cmp (&(a->right), &(a->left)) < 0 ) {
    mpfr_swap (&(a->left), &(a->right));
    return 1;
  }
  else
    return 0;
}
Ejemplo n.º 7
0
/* if u = o(x-y), v = o(u-x), w = o(v+y), then x-y = u-w */
static void
check_two_sum (mpfr_prec_t p)
{
    mpfr_t x, y, u, v, w;
    mpfr_rnd_t rnd;
    int inexact;

    mpfr_init2 (x, p);
    mpfr_init2 (y, p);
    mpfr_init2 (u, p);
    mpfr_init2 (v, p);
    mpfr_init2 (w, p);
    mpfr_urandomb (x, RANDS);
    mpfr_urandomb (y, RANDS);
    if (mpfr_cmpabs (x, y) < 0)
        mpfr_swap (x, y);
    rnd = MPFR_RNDN;
    inexact = test_sub (u, x, y, rnd);
    test_sub (v, u, x, rnd);
    mpfr_add (w, v, y, rnd);
    /* as u = (x-y) - w, we should have inexact and w of opposite signs */
    if (((inexact == 0) && mpfr_cmp_ui (w, 0)) ||
            ((inexact > 0) && (mpfr_cmp_ui (w, 0) <= 0)) ||
            ((inexact < 0) && (mpfr_cmp_ui (w, 0) >= 0)))
    {
        printf ("Wrong inexact flag for prec=%u, rnd=%s\n", (unsigned)p,
                mpfr_print_rnd_mode (rnd));
        printf ("x=");
        mpfr_print_binary(x);
        puts ("");
        printf ("y=");
        mpfr_print_binary(y);
        puts ("");
        printf ("u=");
        mpfr_print_binary(u);
        puts ("");
        printf ("v=");
        mpfr_print_binary(v);
        puts ("");
        printf ("w=");
        mpfr_print_binary(w);
        puts ("");
        printf ("inexact = %d\n", inexact);
        exit (1);
    }
    mpfr_clear (x);
    mpfr_clear (y);
    mpfr_clear (u);
    mpfr_clear (v);
    mpfr_clear (w);
}
Ejemplo n.º 8
0
static __inline__ void
mpfr_add_bound(mpfr_t r,const mpfr_t s)
 {
  mpfr_prec_t s_prec=mpfr_get_prec(s);
  if(s_prec > mpfr_get_prec(r) )
   {
    mpfr_t n; mpfr_init2(n,s_prec);
    mpfr_swap(n,r);
    mpfr_add(r,n,s,MPFR_RNDU);
    mpfr_clear(n);
   }
  else
   mpfr_add(r,r,s,MPFR_RNDU);
 }
Ejemplo n.º 9
0
/**
 * ncm_mpsf_sbessel_recur_next: (skip)
 * @jlrec: a #NcmMpsfSBesselRecur
 * @rnd: FIXME
 *
 * FIXME
 *
*/
void
ncm_mpsf_sbessel_recur_next (NcmMpsfSBesselRecur *jlrec, mp_rnd_t rnd)
{
  if (mpfr_sgn (jlrec->x) != 0)
  {
    mpfr_mul_ui (jlrec->temp, jlrec->jl[1], 2 * jlrec->l + 3, rnd);
    mpfr_div (jlrec->temp, jlrec->temp, jlrec->x, rnd);
    mpfr_sub (jlrec->temp, jlrec->temp, jlrec->jl[0], rnd);

    mpfr_swap (jlrec->jl[0], jlrec->jl[1]);
    mpfr_set (jlrec->jl[1], jlrec->temp, rnd);
  }
  jlrec->l++;
}
Ejemplo n.º 10
0
int
main (void)
{
  mpfr_t u, v;

  tests_start_mpfr ();

  mpfr_init2 (u, 24);
  mpfr_init2 (v, 53);
  mpfr_set_ui (u, 16777215, MPFR_RNDN); /* 2^24 - 1 */
  mpfr_set_str1 (v, "9007199254740991.0"); /* 2^53 - 1 */
  mpfr_swap (u, v);
  mpfr_swap (u, v);
  if (mpfr_cmp_ui (u, 16777215) || mpfr_cmp_str1 (v, "9007199254740991.0"))
    {
      printf ("Error in mpfr_swap\n");
      exit (1);
    }
  mpfr_clear (u);
  mpfr_clear (v);

  tests_end_mpfr ();
  return 0;
}
Ejemplo n.º 11
0
slong
hadamard_2arg(mpfr_t b,const fmpz_mat_t m)
/*
upper bound on log2( 2*abs(m det) )
returns -1 if zero row found, smallest row index otherwise

b on entry is uninitialized
b on exit is initialized iff no zero row found
*/
 {
  const slong n=m->r;
  slong smallest=0,j;
  // gcc warning: initialization from incompatible pointer type --- don't know
  //  how to fix
  const fmpz** const rows=m->rows;
  mpfr_t v,u;
  if(log2_L2_fmpz_3arg( v, rows[0], n ))
   return -1;
  mpfr_copy_bound(b, v);
  // v and b must be freed
  for(j=1;j<n;j++)
   {
    if(log2_L2_fmpz_3arg( u, rows[j], n ))
     {
      mpfr_clear(b); mpfr_clear(v);
      return -1;
     }
    mpfr_add_bound(b, u);
    if( mpfr_cmp(u, v)<0 )
     {
      smallest=j;
      mpfr_swap(v, u);
     }
    mpfr_clear(u);
    // v and b must be freed
   }
  mpfr_clear(v);
  mpfr_div_ui( b, b, 2, MPFR_RNDU ); // instead of taking root
  mpfr_add_ui( b, b, 1, MPFR_RNDU ); // instead of multiplying by 2
  return smallest;
 }
Ejemplo n.º 12
0
static MPC_Object *
GMPy_MPC_From_Decimal(PyObject *obj, mpfr_prec_t rprec, mpfr_prec_t iprec,
                      CTXT_Object *context)
{
    MPC_Object *result = NULL;
    MPFR_Object *tempf;
    mpfr_prec_t oldmpfr, oldreal;
    int oldmpfr_round, oldreal_round;

    assert(IS_DECIMAL(obj));

    CHECK_CONTEXT(context);

    oldmpfr = GET_MPFR_PREC(context);
    oldreal = GET_REAL_PREC(context);
    oldmpfr_round = GET_MPFR_ROUND(context);
    oldreal_round = GET_REAL_ROUND(context);

    context->ctx.mpfr_prec = oldreal;
    context->ctx.mpfr_round = oldreal_round;

    tempf = GMPy_MPFR_From_Decimal(obj, rprec, context);

    context->ctx.mpfr_prec = oldmpfr;
    context->ctx.mpfr_round = oldmpfr_round;

    result = GMPy_MPC_New(0, 0, context);
    if (!tempf || !result) {
        Py_XDECREF((PyObject*)tempf);
        Py_XDECREF((PyObject*)result);
        return NULL;
    }

    result->rc = MPC_INEX(tempf->rc, 0);
    mpfr_swap(mpc_realref(result->c), tempf->f);
    Py_DECREF(tempf);
    return result;
}
Ejemplo n.º 13
0
/* return mpfr_cmp (mpc_abs (a), mpc_abs (b)) */
int
mpc_cmp_abs (mpc_srcptr a, mpc_srcptr b)
{
   mpc_t z1, z2;
   mpfr_t n1, n2;
   mpfr_prec_t prec;
   int inex1, inex2, ret;

   /* Handle numbers containing one NaN as mpfr_cmp. */
   if (   mpfr_nan_p (mpc_realref (a)) || mpfr_nan_p (mpc_imagref (a))
       || mpfr_nan_p (mpc_realref (b)) || mpfr_nan_p (mpc_imagref (b)))
     {
       mpfr_t nan;
       mpfr_init (nan);
       mpfr_set_nan (nan);
       ret = mpfr_cmp (nan, nan);
       mpfr_clear (nan);
       return ret;
     }

   /* Handle infinities. */
   if (mpc_inf_p (a))
      if (mpc_inf_p (b))
         return 0;
      else
         return 1;
   else if (mpc_inf_p (b))
      return -1;

   /* Replace all parts of a and b by their absolute values, then order
      them by size. */
   z1 [0] = a [0];
   z2 [0] = b [0];
   if (mpfr_signbit (mpc_realref (a)))
      MPFR_CHANGE_SIGN (mpc_realref (z1));
   if (mpfr_signbit (mpc_imagref (a)))
      MPFR_CHANGE_SIGN (mpc_imagref (z1));
   if (mpfr_signbit (mpc_realref (b)))
      MPFR_CHANGE_SIGN (mpc_realref (z2));
   if (mpfr_signbit (mpc_imagref (b)))
      MPFR_CHANGE_SIGN (mpc_imagref (z2));
   if (mpfr_cmp (mpc_realref (z1), mpc_imagref (z1)) > 0)
      mpfr_swap (mpc_realref (z1), mpc_imagref (z1));
   if (mpfr_cmp (mpc_realref (z2), mpc_imagref (z2)) > 0)
      mpfr_swap (mpc_realref (z2), mpc_imagref (z2));

   /* Handle cases in which only one part differs. */
   if (mpfr_cmp (mpc_realref (z1), mpc_realref (z2)) == 0)
      return mpfr_cmp (mpc_imagref (z1), mpc_imagref (z2));
   if (mpfr_cmp (mpc_imagref (z1), mpc_imagref (z2)) == 0)
      return mpfr_cmp (mpc_realref (z1), mpc_realref (z2));

   /* Implement the algorithm in algorithms.tex. */
   mpfr_init (n1);
   mpfr_init (n2);
   prec = MPC_MAX (50, MPC_MAX (MPC_MAX_PREC (z1), MPC_MAX_PREC (z2)) / 100);
   do {
      mpfr_set_prec (n1, prec);
      mpfr_set_prec (n2, prec);
      inex1 = mpc_norm (n1, z1, MPFR_RNDD);
      inex2 = mpc_norm (n2, z2, MPFR_RNDD);
      ret = mpfr_cmp (n1, n2);
      if (ret != 0)
        goto end;
      else
         if (inex1 == 0) /* n1 = norm(z1) */
            if (inex2)   /* n2 < norm(z2) */
              {
                ret = -1;
                goto end;
              }
            else /* n2 = norm(z2) */
              {
                ret = 0;
                goto end;
              }
         else /* n1 < norm(z1) */
            if (inex2 == 0)
              {
                ret = 1;
                goto end;
              }
      prec *= 2;
   } while (1);
 end:
   mpfr_clear (n1);
   mpfr_clear (n2);
   return ret;
}
Ejemplo n.º 14
0
/* agm(x,y) is between x and y, so we don't need to save exponent range */
int
mpfr_agm (mpfr_ptr r, mpfr_srcptr op2, mpfr_srcptr op1, mp_rnd_t rnd_mode)
{
  int compare, inexact;
  mp_size_t s;
  mp_prec_t p, q;
  mp_limb_t *up, *vp, *tmpp;
  mpfr_t u, v, tmp;
  unsigned long n; /* number of iterations */
  unsigned long err = 0;
  MPFR_ZIV_DECL (loop);
  MPFR_TMP_DECL(marker);

  MPFR_LOG_FUNC (("op2[%#R]=%R op1[%#R]=%R rnd=%d", op2,op2,op1,op1,rnd_mode),
                 ("r[%#R]=%R inexact=%d", r, r, inexact));

  /* Deal with special values */
  if (MPFR_ARE_SINGULAR (op1, op2))
    {
      /* If a or b is NaN, the result is NaN */
      if (MPFR_IS_NAN(op1) || MPFR_IS_NAN(op2))
        {
          MPFR_SET_NAN(r);
          MPFR_RET_NAN;
        }
      /* now one of a or b is Inf or 0 */
      /* If a and b is +Inf, the result is +Inf.
         Otherwise if a or b is -Inf or 0, the result is NaN */
      else if (MPFR_IS_INF(op1) || MPFR_IS_INF(op2))
        {
          if (MPFR_IS_STRICTPOS(op1) && MPFR_IS_STRICTPOS(op2))
            {
              MPFR_SET_INF(r);
              MPFR_SET_SAME_SIGN(r, op1);
              MPFR_RET(0); /* exact */
            }
          else
            {
              MPFR_SET_NAN(r);
              MPFR_RET_NAN;
            }
        }
      else /* a and b are neither NaN nor Inf, and one is zero */
        {  /* If a or b is 0, the result is +0 since a sqrt is positive */
          MPFR_ASSERTD (MPFR_IS_ZERO (op1) || MPFR_IS_ZERO (op2));
          MPFR_SET_POS (r);
          MPFR_SET_ZERO (r);
          MPFR_RET (0); /* exact */
        }
    }
  MPFR_CLEAR_FLAGS (r);

  /* If a or b is negative (excluding -Infinity), the result is NaN */
  if (MPFR_UNLIKELY(MPFR_IS_NEG(op1) || MPFR_IS_NEG(op2)))
    {
      MPFR_SET_NAN(r);
      MPFR_RET_NAN;
    }

  /* Precision of the following calculus */
  q = MPFR_PREC(r);
  p = q + MPFR_INT_CEIL_LOG2(q) + 15;
  MPFR_ASSERTD (p >= 7); /* see algorithms.tex */
  s = (p - 1) / BITS_PER_MP_LIMB + 1;

  /* b (op2) and a (op1) are the 2 operands but we want b >= a */
  compare = mpfr_cmp (op1, op2);
  if (MPFR_UNLIKELY( compare == 0 ))
    {
      mpfr_set (r, op1, rnd_mode);
      MPFR_RET (0); /* exact */
    }
  else if (compare > 0)
    {
      mpfr_srcptr t = op1;
      op1 = op2;
      op2 = t;
    }
  /* Now b(=op2) >= a (=op1) */

  MPFR_TMP_MARK(marker);

  /* Main loop */
  MPFR_ZIV_INIT (loop, p);
  for (;;)
    {
      mp_prec_t eq;

      /* Init temporary vars */
      MPFR_TMP_INIT (up, u, p, s);
      MPFR_TMP_INIT (vp, v, p, s);
      MPFR_TMP_INIT (tmpp, tmp, p, s);

      /* Calculus of un and vn */
      mpfr_mul (u, op1, op2, GMP_RNDN); /* Faster since PREC(op) < PREC(u) */
      mpfr_sqrt (u, u, GMP_RNDN);
      mpfr_add (v, op1, op2, GMP_RNDN); /* add with !=prec is still good*/
      mpfr_div_2ui (v, v, 1, GMP_RNDN);
      n = 1;
      while (mpfr_cmp2 (u, v, &eq) != 0 && eq <= p - 2)
        {
          mpfr_add (tmp, u, v, GMP_RNDN);
          mpfr_div_2ui (tmp, tmp, 1, GMP_RNDN);
          /* See proof in algorithms.tex */
          if (4*eq > p)
            {
              mpfr_t w;
              /* tmp = U(k) */
              mpfr_init2 (w, (p + 1) / 2);
              mpfr_sub (w, v, u, GMP_RNDN);         /* e = V(k-1)-U(k-1) */
              mpfr_sqr (w, w, GMP_RNDN);            /* e = e^2 */
              mpfr_div_2ui (w, w, 4, GMP_RNDN);     /* e*= (1/2)^2*1/4  */
              mpfr_div (w, w, tmp, GMP_RNDN);       /* 1/4*e^2/U(k) */
              mpfr_sub (v, tmp, w, GMP_RNDN);
              err = MPFR_GET_EXP (tmp) - MPFR_GET_EXP (v); /* 0 or 1 */
              mpfr_clear (w);
              break;
            }
          mpfr_mul (u, u, v, GMP_RNDN);
          mpfr_sqrt (u, u, GMP_RNDN);
          mpfr_swap (v, tmp);
          n ++;
        }
      /* the error on v is bounded by (18n+51) ulps, or twice if there
         was an exponent loss in the final subtraction */
      err += MPFR_INT_CEIL_LOG2(18 * n + 51); /* 18n+51 should not overflow
                                                 since n is about log(p) */
      /* we should have n+2 <= 2^(p/4) [see algorithms.tex] */
      if (MPFR_LIKELY (MPFR_INT_CEIL_LOG2(n + 2) <= p / 4 &&
                       MPFR_CAN_ROUND (v, p - err, q, rnd_mode)))
        break; /* Stop the loop */

      /* Next iteration */
      MPFR_ZIV_NEXT (loop, p);
      s = (p - 1) / BITS_PER_MP_LIMB + 1;
    }
  MPFR_ZIV_FREE (loop);

  /* Setting of the result */
  inexact = mpfr_set (r, v, rnd_mode);

  /* Let's clean */
  MPFR_TMP_FREE(marker);

  return inexact; /* agm(u,v) can be exact for u, v rational only for u=v.
                     Proof (due to Nicolas Brisebarre): it suffices to consider
                     u=1 and v<1. Then 1/AGM(1,v) = 2F1(1/2,1/2,1;1-v^2),
                     and a theorem due to G.V. Chudnovsky states that for x a
                     non-zero algebraic number with |x|<1, then
                     2F1(1/2,1/2,1;x) and 2F1(-1/2,1/2,1;x) are algebraically
                     independent over Q. */
}
Ejemplo n.º 15
0
int
mpc_asin (mpc_ptr rop, mpc_srcptr op, mpc_rnd_t rnd)
{
  mpfr_prec_t p, p_re, p_im, incr_p = 0;
  mpfr_rnd_t rnd_re, rnd_im;
  mpc_t z1;
  int inex;

  /* special values */
  if (mpfr_nan_p (mpc_realref (op)) || mpfr_nan_p (mpc_imagref (op)))
    {
      if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
        {
          mpfr_set_nan (mpc_realref (rop));
          mpfr_set_inf (mpc_imagref (rop), mpfr_signbit (mpc_imagref (op)) ? -1 : +1);
        }
      else if (mpfr_zero_p (mpc_realref (op)))
        {
          mpfr_set (mpc_realref (rop), mpc_realref (op), GMP_RNDN);
          mpfr_set_nan (mpc_imagref (rop));
        }
      else
        {
          mpfr_set_nan (mpc_realref (rop));
          mpfr_set_nan (mpc_imagref (rop));
        }

      return 0;
    }

  if (mpfr_inf_p (mpc_realref (op)) || mpfr_inf_p (mpc_imagref (op)))
    {
      int inex_re;
      if (mpfr_inf_p (mpc_realref (op)))
        {
          int inf_im = mpfr_inf_p (mpc_imagref (op));

          inex_re = set_pi_over_2 (mpc_realref (rop),
             (mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
          mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1));

          if (inf_im)
            mpfr_div_2ui (mpc_realref (rop), mpc_realref (rop), 1, GMP_RNDN);
        }
      else
        {
          mpfr_set_zero (mpc_realref (rop), (mpfr_signbit (mpc_realref (op)) ? -1 : 1));
          inex_re = 0;
          mpfr_set_inf (mpc_imagref (rop), (mpfr_signbit (mpc_imagref (op)) ? -1 : 1));
        }

      return MPC_INEX (inex_re, 0);
    }

  /* pure real argument */
  if (mpfr_zero_p (mpc_imagref (op)))
    {
      int inex_re;
      int inex_im;
      int s_im;
      s_im = mpfr_signbit (mpc_imagref (op));

      if (mpfr_cmp_ui (mpc_realref (op), 1) > 0)
        {
          if (s_im)
            inex_im = -mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
                                   INV_RND (MPC_RND_IM (rnd)));
          else
            inex_im = mpfr_acosh (mpc_imagref (rop), mpc_realref (op),
                                  MPC_RND_IM (rnd));
          inex_re = set_pi_over_2 (mpc_realref (rop),
             (mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
          if (s_im)
            mpc_conj (rop, rop, MPC_RNDNN);
        }
      else if (mpfr_cmp_si (mpc_realref (op), -1) < 0)
        {
          mpfr_t minus_op_re;
          minus_op_re[0] = mpc_realref (op)[0];
          MPFR_CHANGE_SIGN (minus_op_re);

          if (s_im)
            inex_im = -mpfr_acosh (mpc_imagref (rop), minus_op_re,
                                   INV_RND (MPC_RND_IM (rnd)));
          else
            inex_im = mpfr_acosh (mpc_imagref (rop), minus_op_re,
                                  MPC_RND_IM (rnd));
          inex_re = set_pi_over_2 (mpc_realref (rop),
             (mpfr_signbit (mpc_realref (op)) ? -1 : 1), MPC_RND_RE (rnd));
          if (s_im)
            mpc_conj (rop, rop, MPC_RNDNN);
        }
      else
        {
          inex_im = mpfr_set_ui (mpc_imagref (rop), 0, MPC_RND_IM (rnd));
          if (s_im)
            mpfr_neg (mpc_imagref (rop), mpc_imagref (rop), GMP_RNDN);
          inex_re = mpfr_asin (mpc_realref (rop), mpc_realref (op), MPC_RND_RE (rnd));
        }

      return MPC_INEX (inex_re, inex_im);
    }

  /* pure imaginary argument */
  if (mpfr_zero_p (mpc_realref (op)))
    {
      int inex_im;
      int s;
      s = mpfr_signbit (mpc_realref (op));
      mpfr_set_ui (mpc_realref (rop), 0, GMP_RNDN);
      if (s)
        mpfr_neg (mpc_realref (rop), mpc_realref (rop), GMP_RNDN);
      inex_im = mpfr_asinh (mpc_imagref (rop), mpc_imagref (op), MPC_RND_IM (rnd));

      return MPC_INEX (0, inex_im);
    }

  /* regular complex: asin(z) = -i*log(i*z+sqrt(1-z^2)) */
  p_re = mpfr_get_prec (mpc_realref(rop));
  p_im = mpfr_get_prec (mpc_imagref(rop));
  rnd_re = MPC_RND_RE(rnd);
  rnd_im = MPC_RND_IM(rnd);
  p = p_re >= p_im ? p_re : p_im;
  mpc_init2 (z1, p);
  while (1)
  {
    mpfr_exp_t ex, ey, err;

    p += mpc_ceil_log2 (p) + 3 + incr_p; /* incr_p is zero initially */
    incr_p = p / 2;
    mpfr_set_prec (mpc_realref(z1), p);
    mpfr_set_prec (mpc_imagref(z1), p);

    /* z1 <- z^2 */
    mpc_sqr (z1, op, MPC_RNDNN);
    /* err(x) <= 1/2 ulp(x), err(y) <= 1/2 ulp(y) */
    /* z1 <- 1-z1 */
    ex = mpfr_get_exp (mpc_realref(z1));
    mpfr_ui_sub (mpc_realref(z1), 1, mpc_realref(z1), GMP_RNDN);
    mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN);
    ex = ex - mpfr_get_exp (mpc_realref(z1));
    ex = (ex <= 0) ? 0 : ex;
    /* err(x) <= 2^ex * ulp(x) */
    ex = ex + mpfr_get_exp (mpc_realref(z1)) - p;
    /* err(x) <= 2^ex */
    ey = mpfr_get_exp (mpc_imagref(z1)) - p - 1;
    /* err(y) <= 2^ey */
    ex = (ex >= ey) ? ex : ey; /* err(x), err(y) <= 2^ex, i.e., the norm
                                  of the error is bounded by |h|<=2^(ex+1/2) */
    /* z1 <- sqrt(z1): if z1 = z + h, then sqrt(z1) = sqrt(z) + h/2/sqrt(t) */
    ey = mpfr_get_exp (mpc_realref(z1)) >= mpfr_get_exp (mpc_imagref(z1))
      ? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
    /* we have |z1| >= 2^(ey-1) thus 1/|z1| <= 2^(1-ey) */
    mpc_sqrt (z1, z1, MPC_RNDNN);
    ex = (2 * ex + 1) - 2 - (ey - 1); /* |h^2/4/|t| <= 2^ex */
    ex = (ex + 1) / 2; /* ceil(ex/2) */
    /* express ex in terms of ulp(z1) */
    ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1))
      ? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
    ex = ex - ey + p;
    /* take into account the rounding error in the mpc_sqrt call */
    err = (ex <= 0) ? 1 : ex + 1;
    /* err(x) <= 2^err * ulp(x), err(y) <= 2^err * ulp(y) */
    /* z1 <- i*z + z1 */
    ex = mpfr_get_exp (mpc_realref(z1));
    ey = mpfr_get_exp (mpc_imagref(z1));
    mpfr_sub (mpc_realref(z1), mpc_realref(z1), mpc_imagref(op), GMP_RNDN);
    mpfr_add (mpc_imagref(z1), mpc_imagref(z1), mpc_realref(op), GMP_RNDN);
    if (mpfr_cmp_ui (mpc_realref(z1), 0) == 0 || mpfr_cmp_ui (mpc_imagref(z1), 0) == 0)
      continue;
    ex -= mpfr_get_exp (mpc_realref(z1)); /* cancellation in x */
    ey -= mpfr_get_exp (mpc_imagref(z1)); /* cancellation in y */
    ex = (ex >= ey) ? ex : ey; /* maximum cancellation */
    err += ex;
    err = (err <= 0) ? 1 : err + 1; /* rounding error in sub/add */
    /* z1 <- log(z1): if z1 = z + h, then log(z1) = log(z) + h/t with
       |t| >= min(|z1|,|z|) */
    ex = mpfr_get_exp (mpc_realref(z1));
    ey = mpfr_get_exp (mpc_imagref(z1));
    ex = (ex >= ey) ? ex : ey;
    err += ex - p; /* revert to absolute error <= 2^err */
    mpc_log (z1, z1, GMP_RNDN);
    err -= ex - 1; /* 1/|t| <= 1/|z| <= 2^(1-ex) */
    /* express err in terms of ulp(z1) */
    ey = mpfr_get_exp (mpc_realref(z1)) <= mpfr_get_exp (mpc_imagref(z1))
      ? mpfr_get_exp (mpc_realref(z1)) : mpfr_get_exp (mpc_imagref(z1));
    err = err - ey + p;
    /* take into account the rounding error in the mpc_log call */
    err = (err <= 0) ? 1 : err + 1;
    /* z1 <- -i*z1 */
    mpfr_swap (mpc_realref(z1), mpc_imagref(z1));
    mpfr_neg (mpc_imagref(z1), mpc_imagref(z1), GMP_RNDN);
    if (mpfr_can_round (mpc_realref(z1), p - err, GMP_RNDN, GMP_RNDZ,
                        p_re + (rnd_re == GMP_RNDN)) &&
        mpfr_can_round (mpc_imagref(z1), p - err, GMP_RNDN, GMP_RNDZ,
                        p_im + (rnd_im == GMP_RNDN)))
      break;
  }

  inex = mpc_set (rop, z1, rnd);
  mpc_clear (z1);

  return inex;
}
Ejemplo n.º 16
0
/* Implements asymptotic expansion for jn or yn (formulae 9.2.5 and 9.2.6
   from Abramowitz & Stegun).
   Assumes |z| > p log(2)/2, where p is the target precision
   (z can be negative only for jn).
   Return 0 if the expansion does not converge enough (the value 0 as inexact
   flag should not happen for normal input).
*/
static int
FUNCTION (mpfr_ptr res, long n, mpfr_srcptr z, mpfr_rnd_t r)
{
  mpfr_t s, c, P, Q, t, iz, err_t, err_s, err_u;
  mpfr_prec_t w;
  long k;
  int inex, stop, diverge = 0;
  mpfr_exp_t err2, err;
  MPFR_ZIV_DECL (loop);

  mpfr_init (c);

  w = MPFR_PREC(res) + MPFR_INT_CEIL_LOG2(MPFR_PREC(res)) + 4;

  MPFR_ZIV_INIT (loop, w);
  for (;;)
    {
      mpfr_set_prec (c, w);
      mpfr_init2 (s, w);
      mpfr_init2 (P, w);
      mpfr_init2 (Q, w);
      mpfr_init2 (t, w);
      mpfr_init2 (iz, w);
      mpfr_init2 (err_t, 31);
      mpfr_init2 (err_s, 31);
      mpfr_init2 (err_u, 31);

      /* Approximate sin(z) and cos(z). In the following, err <= k means that
         the approximate value y and the true value x are related by
         y = x * (1 + u)^k with |u| <= 2^(-w), following Higham's method. */
      mpfr_sin_cos (s, c, z, MPFR_RNDN);
      if (MPFR_IS_NEG(z))
        mpfr_neg (s, s, MPFR_RNDN); /* compute jn/yn(|z|), fix sign later */
      /* The absolute error on s/c is bounded by 1/2 ulp(1/2) <= 2^(-w-1). */
      mpfr_add (t, s, c, MPFR_RNDN);
      mpfr_sub (c, s, c, MPFR_RNDN);
      mpfr_swap (s, t);
      /* now s approximates sin(z)+cos(z), and c approximates sin(z)-cos(z),
         with total absolute error bounded by 2^(1-w). */

      /* precompute 1/(8|z|) */
      mpfr_si_div (iz, MPFR_IS_POS(z) ? 1 : -1, z, MPFR_RNDN);   /* err <= 1 */
      mpfr_div_2ui (iz, iz, 3, MPFR_RNDN);

      /* compute P and Q */
      mpfr_set_ui (P, 1, MPFR_RNDN);
      mpfr_set_ui (Q, 0, MPFR_RNDN);
      mpfr_set_ui (t, 1, MPFR_RNDN); /* current term */
      mpfr_set_ui (err_t, 0, MPFR_RNDN); /* error on t */
      mpfr_set_ui (err_s, 0, MPFR_RNDN); /* error on P and Q (sum of errors) */
      for (k = 1, stop = 0; stop < 4; k++)
        {
          /* compute next term: t(k)/t(k-1) = (2n+2k-1)(2n-2k+1)/(8kz) */
          mpfr_mul_si (t, t, 2 * (n + k) - 1, MPFR_RNDN); /* err <= err_k + 1 */
          mpfr_mul_si (t, t, 2 * (n - k) + 1, MPFR_RNDN); /* err <= err_k + 2 */
          mpfr_div_ui (t, t, k, MPFR_RNDN);               /* err <= err_k + 3 */
          mpfr_mul (t, t, iz, MPFR_RNDN);                 /* err <= err_k + 5 */
          /* the relative error on t is bounded by (1+u)^(5k)-1, which is
             bounded by 6ku for 6ku <= 0.02: first |5 log(1+u)| <= |5.5u|
             for |u| <= 0.15, then |exp(5.5u)-1| <= 6u for |u| <= 0.02. */
          mpfr_mul_ui (err_t, t, 6 * k, MPFR_IS_POS(t) ? MPFR_RNDU : MPFR_RNDD);
          mpfr_abs (err_t, err_t, MPFR_RNDN); /* exact */
          /* the absolute error on t is bounded by err_t * 2^(-w) */
          mpfr_abs (err_u, t, MPFR_RNDU);
          mpfr_mul_2ui (err_u, err_u, w, MPFR_RNDU); /* t * 2^w */
          mpfr_add (err_u, err_u, err_t, MPFR_RNDU); /* max|t| * 2^w */
          if (stop >= 2)
            {
              /* take into account the neglected terms: t * 2^w */
              mpfr_div_2ui (err_s, err_s, w, MPFR_RNDU);
              if (MPFR_IS_POS(t))
                mpfr_add (err_s, err_s, t, MPFR_RNDU);
              else
                mpfr_sub (err_s, err_s, t, MPFR_RNDU);
              mpfr_mul_2ui (err_s, err_s, w, MPFR_RNDU);
              stop ++;
            }
          /* if k is odd, add to Q, otherwise to P */
          else if (k & 1)
            {
              /* if k = 1 mod 4, add, otherwise subtract */
              if ((k & 2) == 0)
                mpfr_add (Q, Q, t, MPFR_RNDN);
              else
                mpfr_sub (Q, Q, t, MPFR_RNDN);
              /* check if the next term is smaller than ulp(Q): if EXP(err_u)
                 <= EXP(Q), since the current term is bounded by
                 err_u * 2^(-w), it is bounded by ulp(Q) */
              if (MPFR_EXP(err_u) <= MPFR_EXP(Q))
                stop ++;
              else
                stop = 0;
            }
          else
            {
              /* if k = 0 mod 4, add, otherwise subtract */
              if ((k & 2) == 0)
                mpfr_add (P, P, t, MPFR_RNDN);
              else
                mpfr_sub (P, P, t, MPFR_RNDN);
              /* check if the next term is smaller than ulp(P) */
              if (MPFR_EXP(err_u) <= MPFR_EXP(P))
                stop ++;
              else
                stop = 0;
            }
          mpfr_add (err_s, err_s, err_t, MPFR_RNDU);
          /* the sum of the rounding errors on P and Q is bounded by
             err_s * 2^(-w) */

          /* stop when start to diverge */
          if (stop < 2 &&
              ((MPFR_IS_POS(z) && mpfr_cmp_ui (z, (k + 1) / 2) < 0) ||
               (MPFR_IS_NEG(z) && mpfr_cmp_si (z, - ((k + 1) / 2)) > 0)))
            {
              /* if we have to stop the series because it diverges, then
                 increasing the precision will most probably fail, since
                 we will stop to the same point, and thus compute a very
                 similar approximation */
              diverge = 1;
              stop = 2; /* force stop */
            }
        }
      /* the sum of the total errors on P and Q is bounded by err_s * 2^(-w) */

      /* Now combine: the sum of the rounding errors on P and Q is bounded by
         err_s * 2^(-w), and the absolute error on s/c is bounded by 2^(1-w) */
      if ((n & 1) == 0) /* n even: P * (sin + cos) + Q (cos - sin) for jn
                                   Q * (sin + cos) + P (sin - cos) for yn */
        {
#ifdef MPFR_JN
          mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
          mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#else
          mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
          mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#endif
          err = MPFR_EXP(c);
          if (MPFR_EXP(s) > err)
            err = MPFR_EXP(s);
#ifdef MPFR_JN
          mpfr_sub (s, s, c, MPFR_RNDN);
#else
          mpfr_add (s, s, c, MPFR_RNDN);
#endif
        }
      else /* n odd: P * (sin - cos) + Q (cos + sin) for jn,
                     Q * (sin - cos) - P (cos + sin) for yn */
        {
#ifdef MPFR_JN
          mpfr_mul (c, c, P, MPFR_RNDN); /* P * (sin - cos) */
          mpfr_mul (s, s, Q, MPFR_RNDN); /* Q * (sin + cos) */
#else
          mpfr_mul (c, c, Q, MPFR_RNDN); /* Q * (sin - cos) */
          mpfr_mul (s, s, P, MPFR_RNDN); /* P * (sin + cos) */
#endif
          err = MPFR_EXP(c);
          if (MPFR_EXP(s) > err)
            err = MPFR_EXP(s);
#ifdef MPFR_JN
          mpfr_add (s, s, c, MPFR_RNDN);
#else
          mpfr_sub (s, c, s, MPFR_RNDN);
#endif
        }
      if ((n & 2) != 0)
        mpfr_neg (s, s, MPFR_RNDN);
      if (MPFR_EXP(s) > err)
        err = MPFR_EXP(s);
      /* the absolute error on s is bounded by P*err(s/c) + Q*err(s/c)
         + err(P)*(s/c) + err(Q)*(s/c) + 3 * 2^(err - w - 1)
         <= (|P|+|Q|) * 2^(1-w) + err_s * 2^(1-w) + 2^err * 2^(1-w),
         since |c|, |old_s| <= 2. */
      err2 = (MPFR_EXP(P) >= MPFR_EXP(Q)) ? MPFR_EXP(P) + 2 : MPFR_EXP(Q) + 2;
      /* (|P| + |Q|) * 2^(1 - w) <= 2^(err2 - w) */
      err = MPFR_EXP(err_s) >= err ? MPFR_EXP(err_s) + 2 : err + 2;
      /* err_s * 2^(1-w) + 2^old_err * 2^(1-w) <= 2^err * 2^(-w) */
      err2 = (err >= err2) ? err + 1 : err2 + 1;
      /* now the absolute error on s is bounded by 2^(err2 - w) */

      /* multiply by sqrt(1/(Pi*z)) */
      mpfr_const_pi (c, MPFR_RNDN);     /* Pi, err <= 1 */
      mpfr_mul (c, c, z, MPFR_RNDN);    /* err <= 2 */
      mpfr_si_div (c, MPFR_IS_POS(z) ? 1 : -1, c, MPFR_RNDN); /* err <= 3 */
      mpfr_sqrt (c, c, MPFR_RNDN);      /* err<=5/2, thus the absolute error is
                                          bounded by 3*u*|c| for |u| <= 0.25 */
      mpfr_mul (err_t, c, s, MPFR_SIGN(c)==MPFR_SIGN(s) ? MPFR_RNDU : MPFR_RNDD);
      mpfr_abs (err_t, err_t, MPFR_RNDU);
      mpfr_mul_ui (err_t, err_t, 3, MPFR_RNDU);
      /* 3*2^(-w)*|old_c|*|s| [see below] is bounded by err_t * 2^(-w) */
      err2 += MPFR_EXP(c);
      /* |old_c| * 2^(err2 - w) [see below] is bounded by 2^(err2-w) */
      mpfr_mul (c, c, s, MPFR_RNDN);    /* the absolute error on c is bounded by
                                          1/2 ulp(c) + 3*2^(-w)*|old_c|*|s|
                                          + |old_c| * 2^(err2 - w) */
      /* compute err_t * 2^(-w) + 1/2 ulp(c) = (err_t + 2^EXP(c)) * 2^(-w) */
      err = (MPFR_EXP(err_t) > MPFR_EXP(c)) ? MPFR_EXP(err_t) + 1 : MPFR_EXP(c) + 1;
      /* err_t * 2^(-w) + 1/2 ulp(c) <= 2^(err - w) */
      /* now err_t * 2^(-w) bounds 1/2 ulp(c) + 3*2^(-w)*|old_c|*|s| */
      err = (err >= err2) ? err + 1 : err2 + 1;
      /* the absolute error on c is bounded by 2^(err - w) */

      mpfr_clear (s);
      mpfr_clear (P);
      mpfr_clear (Q);
      mpfr_clear (t);
      mpfr_clear (iz);
      mpfr_clear (err_t);
      mpfr_clear (err_s);
      mpfr_clear (err_u);

      err -= MPFR_EXP(c);
      if (MPFR_LIKELY (MPFR_CAN_ROUND (c, w - err, MPFR_PREC(res), r)))
        break;
      if (diverge != 0)
        {
          mpfr_set (c, z, r); /* will force inex=0 below, which means the
                               asymptotic expansion failed */
          break;
        }
      MPFR_ZIV_NEXT (loop, w);
    }
  MPFR_ZIV_FREE (loop);

  inex = (MPFR_IS_POS(z) || ((n & 1) == 0)) ? mpfr_set (res, c, r)
    : mpfr_neg (res, c, r);
  mpfr_clear (c);

  return inex;
}
Ejemplo n.º 17
0
Archivo: tatan.c Proyecto: Canar/mpfr
static void
special_atan2 (void)
{
    mpfr_t x, y, z;

    mpfr_inits2 (4, x, y, z, (mpfr_ptr) 0);

    /* Anything with NAN should be set to NAN */
    mpfr_set_ui (y, 0, MPFR_RNDN);
    mpfr_set_nan (x);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (MPFR_IS_NAN (z));
    mpfr_swap (x, y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (MPFR_IS_NAN (z));

    /* 0+ 0+ --> 0+ */
    mpfr_set_ui (y, 0, MPFR_RNDN);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (MPFR_IS_ZERO (z) && MPFR_IS_POS (z));
    /* 0- 0+ --> 0- */
    MPFR_CHANGE_SIGN (y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (MPFR_IS_ZERO (z) && MPFR_IS_NEG (z));
    /* 0- 0- --> -PI */
    MPFR_CHANGE_SIGN (x);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "-3.1415", 10, MPFR_RNDN) == 0);
    /* 0+ 0- --> +PI */
    MPFR_CHANGE_SIGN (y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "3.1415", 10, MPFR_RNDN) == 0);
    /* 0+ -1 --> PI */
    mpfr_set_si (x, -1, MPFR_RNDN);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "3.1415", 10, MPFR_RNDN) == 0);
    /* 0- -1 --> -PI */
    MPFR_CHANGE_SIGN (y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "-3.1415", 10, MPFR_RNDN) == 0);
    /* 0- +1 --> 0- */
    mpfr_set_ui (x, 1, MPFR_RNDN);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (MPFR_IS_ZERO (z) && MPFR_IS_NEG (z));
    /* 0+ +1 --> 0+ */
    MPFR_CHANGE_SIGN (y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (MPFR_IS_ZERO (z) && MPFR_IS_POS (z));
    /* +1 0+ --> PI/2 */
    mpfr_swap (x, y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "1.57075", 10, MPFR_RNDN) == 0);
    /* +1 0- --> PI/2 */
    MPFR_CHANGE_SIGN (x);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "1.57075", 10, MPFR_RNDN) == 0);
    /* -1 0- --> -PI/2 */
    MPFR_CHANGE_SIGN (y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "-1.57075", 10, MPFR_RNDN) == 0);
    /* -1 0+ --> -PI/2 */
    MPFR_CHANGE_SIGN (x);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "-1.57075", 10, MPFR_RNDN) == 0);

    /* -1 +INF --> -0 */
    MPFR_SET_INF (x);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (MPFR_IS_ZERO (z) && MPFR_IS_NEG (z));
    /* +1 +INF --> +0 */
    MPFR_CHANGE_SIGN (y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (MPFR_IS_ZERO (z) && MPFR_IS_POS (z));
    /* +1 -INF --> +PI */
    MPFR_CHANGE_SIGN (x);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "3.1415", 10, MPFR_RNDN) == 0);
    /* -1 -INF --> -PI */
    MPFR_CHANGE_SIGN (y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "-3.1415", 10, MPFR_RNDN) == 0);
    /* -INF -1 --> -PI/2 */
    mpfr_swap (x, y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "-1.57075", 10, MPFR_RNDN) == 0);
    /* +INF -1  --> PI/2 */
    MPFR_CHANGE_SIGN (y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "1.57075", 10, MPFR_RNDN) == 0);
    /* +INF -INF --> 3*PI/4 */
    MPFR_SET_INF (x);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "2.356194490192344928", 10, MPFR_RNDN) == 0);
    /* +INF +INF --> PI/4 */
    MPFR_CHANGE_SIGN (x);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "0.785375", 10, MPFR_RNDN) == 0);
    /* -INF +INF --> -PI/4 */
    MPFR_CHANGE_SIGN (y);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "-0.785375", 10, MPFR_RNDN) == 0);
    /* -INF -INF --> -3*PI/4 */
    MPFR_CHANGE_SIGN (x);
    mpfr_atan2 (z, y, x, MPFR_RNDN);
    MPFR_ASSERTN (mpfr_cmp_str (z, "-2.356194490192344928", 10, MPFR_RNDN) == 0);
    mpfr_set_prec (z, 905); /* exercises Ziv's loop */
    mpfr_atan2 (z, y, x, MPFR_RNDZ);
    MPFR_ASSERTN (mpfr_cmp_str (z, "-2.35619449019234492884698253745962716314787704953132936573120844423086230471465674897102611900658780098661106488496172998532038345716293667379401955609636083808771307702645389082916973346721171619778647332160823174945008459635673617534008737395340143185923642519259526145784", 10, MPFR_RNDN) == 0);

    mpfr_clears (x, y, z, (mpfr_ptr) 0);
}
Ejemplo n.º 18
0
int my_mpfr_lbeta(mpfr_t R, mpfr_t a, mpfr_t b, mpfr_rnd_t RND)
{
    mpfr_prec_t p_a = mpfr_get_prec(a), p_b = mpfr_get_prec(b);
    if(p_a < p_b) p_a = p_b;// p_a := max(p_a, p_b)
    if(mpfr_get_prec(R) < p_a)
	mpfr_prec_round(R, p_a, RND);// so prec(R) = max( prec(a), prec(b) )
    int ans;
    mpfr_t s;
    mpfr_init2(s, p_a);

    /* "FIXME": check each 'ans' below, and return when not ok ... */
    ans = mpfr_add(s, a, b, RND);

    if(mpfr_integer_p(s) && mpfr_sgn(s) <= 0) { // (a + b) is integer <= 0
	if(!mpfr_integer_p(a) && !mpfr_integer_p(b)) {
	    // but a,b not integer ==> R = ln(finite / +-Inf) = ln(0) = -Inf :
	    mpfr_set_inf (R, -1);
	    mpfr_clear (s);
	    return ans;
	}// else: sum is integer; at least one integer ==> both integer

	int sX = mpfr_sgn(a), sY = mpfr_sgn(b);
	if(sX * sY < 0) { // one negative, one positive integer
	    // ==> special treatment here :
	    if(sY < 0) // ==> sX > 0; swap the two
		mpfr_swap(a, b);
	    /* now have --- a < 0 < b <= |a|  integer ------------------
	     *              ================
	     * --> see my_mpfr_beta() above */
	    unsigned long b_ = 0;// -Wall
	    Rboolean
		b_fits_ulong = mpfr_fits_ulong_p(b, RND),
		small_b = b_fits_ulong &&  (b_ = mpfr_get_ui(b, RND)) < b_large;
	    if(small_b) {
		//----------------- small b ------------------
		// use GMP big integer arithmetic:
		mpz_t S; mpz_init(S); mpfr_get_z(S, s, RND); // S := s
		mpz_sub_ui (S, S, (unsigned long) 1); // S = s - 1 = (a+b-1)
		/* binomial coefficient choose(N, k) requires k a 'long int';
		 * here, b must fit into a long: */
		mpz_bin_ui (S, S, b_); // S = choose(S, b) = choose(a+b-1, b)
		mpz_mul_ui (S, S, b_); // S = S*b =  b * choose(a+b-1, b)

		// back to mpfr: R = log(|1 / S|) =  - log(|S|)
		mpz_abs(S, S);
		mpfr_set_z(s, S, RND); // <mpfr> s :=  |S|
		mpfr_log(R, s, RND);   // R := log(s) = log(|S|)
		mpfr_neg(R, R, RND);   // R = -R = -log(|S|)
		mpz_clear(S);
	    }
	    else { // b is "large", use direct B(.,.) formula
		// a := (-1)^b -- not needed here, neither 'neg': want log( |.| )
		// s' := 1-s = 1-a-b
		mpfr_ui_sub(s, 1, s, RND);
		// R := log(|B(1-a-b, b)|) = log(|B(s', b)|)
		my_mpfr_lbeta (R, s, b, RND);
	    }
	    mpfr_clear(s);
	    return ans;
	}
    }

    ans = mpfr_lngamma(s, s, RND); // s = lngamma(a + b)
    ans = mpfr_lngamma(a, a, RND);
    ans = mpfr_lngamma(b, b, RND);
    ans = mpfr_add (b, b, a, RND); // b' = lngamma(a) + lngamma(b)
    ans = mpfr_sub (R, b, s, RND);

    mpfr_clear (s);
    return ans;
}
Ejemplo n.º 19
0
/* Swapping the two arguments */
void
mpfi_swap (mpfi_ptr a, mpfi_ptr b)
{
  mpfr_swap (&(a->left), &(b->left));
  mpfr_swap (&(a->right), &(b->right));
}
Ejemplo n.º 20
0
/*------------------------------------------------------------------------*/
int my_mpfr_beta (mpfr_t R, mpfr_t a, mpfr_t b, mpfr_rnd_t RND)
{
    mpfr_prec_t p_a = mpfr_get_prec(a), p_b = mpfr_get_prec(b);
    if(p_a < p_b) p_a = p_b;// p_a := max(p_a, p_b)
    if(mpfr_get_prec(R) < p_a)
	mpfr_prec_round(R, p_a, RND);// so prec(R) = max( prec(a), prec(b) )
    int ans;
    mpfr_t s; mpfr_init2(s, p_a);
#ifdef DEBUG_Rmpfr
    R_CheckUserInterrupt();
    int cc = 0;
#endif

    /* "FIXME": check each 'ans' below, and return when not ok ... */
    ans = mpfr_add(s, a, b, RND);

    if(mpfr_integer_p(s) && mpfr_sgn(s) <= 0) { // (a + b) is integer <= 0
	if(!mpfr_integer_p(a) && !mpfr_integer_p(b)) {
	    // but a,b not integer ==> R =  finite / +-Inf  = 0 :
	    mpfr_set_zero (R, +1);
	    mpfr_clear (s);
	    return ans;
	}// else: sum is integer; at least one {a,b} integer ==> both integer

	int sX = mpfr_sgn(a), sY = mpfr_sgn(b);
	if(sX * sY < 0) { // one negative, one positive integer
	    // ==> special treatment here :
	    if(sY < 0) // ==> sX > 0; swap the two
		mpfr_swap(a, b);
	    // now have --- a < 0 < b <= |a|  integer ------------------
	    /*              ================  and in this case:
	       B(a,b) = (-1)^b  B(1-a-b, b) = (-1)^b B(1-s, b)

		      = (1*2*..*b) / (-s-1)*(-s-2)*...*(-s-b)
	    */
	    /* where in the 2nd form, both numerator and denominator have exactly
	     * b integer factors. This is attractive {numerically & speed wise}
	     * for 'small' b */
#define b_large 100
#ifdef DEBUG_Rmpfr
	    Rprintf(" my_mpfr_beta(<neg int>): s = a+b= "); R_PRT(s);
	    Rprintf("\n   a = "); R_PRT(a);
	    Rprintf("\n   b = "); R_PRT(b); Rprintf("\n");
	    if(cc++ > 999) { mpfr_set_zero (R, +1); mpfr_clear (s); return ans; }
#endif
	    unsigned long b_ = 0;// -Wall
	    Rboolean
		b_fits_ulong = mpfr_fits_ulong_p(b, RND),
		small_b = b_fits_ulong &&  (b_ = mpfr_get_ui(b, RND)) < b_large;
	    if(small_b) {
#ifdef DEBUG_Rmpfr
		Rprintf("   b <= b_large = %d...\n", b_large);
#endif
		//----------------- small b ------------------
		// use GMP big integer arithmetic:
		mpz_t S; mpz_init(S); mpfr_get_z(S, s, RND); // S := s
		mpz_sub_ui (S, S, (unsigned long) 1); // S = s - 1 = (a+b-1)
		/* binomial coefficient choose(N, k) requires k a 'long int';
		 * here, b must fit into a long: */
		mpz_bin_ui (S, S, b_); // S = choose(S, b) = choose(a+b-1, b)
		mpz_mul_ui (S, S, b_); // S = S*b =  b * choose(a+b-1, b)
		// back to mpfr: R = 1 / S  = 1 / (b * choose(a+b-1, b))
		mpfr_set_ui(s, (unsigned long) 1, RND);
		mpfr_div_z(R, s, S, RND);
		mpz_clear(S);
	    }
	    else { // b is "large", use direct B(.,.) formula
#ifdef DEBUG_Rmpfr
		Rprintf("   b > b_large = %d...\n", b_large);
#endif
		// a := (-1)^b :
		// there is no  mpfr_si_pow(a, -1, b, RND);
		int neg; // := 1 ("TRUE") if (-1)^b = -1, i.e. iff  b is odd
		if(b_fits_ulong) { // (i.e. not very large)
		    neg = (b_ % 2); // 1 iff b_ is odd,  0 otherwise
		} else { // really large b; as we know it is integer, can still..
		    // b2 := b / 2
		    mpfr_t b2; mpfr_init2(b2, p_a);
		    mpfr_div_2ui(b2, b, 1, RND);
		    neg = !mpfr_integer_p(b2); // b is odd, if b/2 is *not* integer
#ifdef DEBUG_Rmpfr
		    Rprintf("   really large b; neg = ('b is odd') = %d\n", neg);
#endif
		}
		// s' := 1-s = 1-a-b
		mpfr_ui_sub(s, 1, s, RND);
#ifdef DEBUG_Rmpfr
		Rprintf("  neg = %d\n", neg);
		Rprintf("  s' = 1-a-b = "); R_PRT(s);
		Rprintf("\n  -> calling B(s',b)\n");
#endif
		// R := B(1-a-b, b) = B(s', b)
		if(small_b) {
		    my_mpfr_beta (R, s, b, RND);
		} else {
		    my_mpfr_lbeta (R, s, b, RND);
		    mpfr_exp(R, R, RND); // correct *if* beta() >= 0
		}
#ifdef DEBUG_Rmpfr
		Rprintf("  R' = beta(s',b) = "); R_PRT(R); Rprintf("\n");
#endif
		// Result = (-1)^b  B(1-a-b, b) = +/- s'
		if(neg) mpfr_neg(R, R, RND);
	    }
	    mpfr_clear(s);
	    return ans;
	}
   }

    ans = mpfr_gamma(s, s, RND);  /* s = gamma(a + b) */
#ifdef DEBUG_Rmpfr
    Rprintf("my_mpfr_beta(): s = gamma(a+b)= "); R_PRT(s);
    Rprintf("\n   a = "); R_PRT(a);
    Rprintf("\n   b = "); R_PRT(b);
#endif

    ans = mpfr_gamma(a, a, RND);
    ans = mpfr_gamma(b, b, RND);
    ans = mpfr_mul(b, b, a, RND); /* b' = gamma(a) * gamma(b) */

#ifdef DEBUG_Rmpfr
    Rprintf("\n    G(a) * G(b) = "); R_PRT(b); Rprintf("\n");
#endif

    ans = mpfr_div(R, b, s, RND);
    mpfr_clear (s);
    /* mpfr_free_cache() must be called in the caller !*/
    return ans;
}
Ejemplo n.º 21
0
/* Generic random tests with cancellations.
 *
 * In summary, we do 4000 tests of the following form:
 * 1. We set the first MPFR_NCANCEL members of an array to random values,
 *    with a random exponent taken in 4 ranges, depending on the value of
 *    i % 4 (see code below).
 * 2. For each of the next MPFR_NCANCEL iterations:
 *    A. we randomly permute some terms of the array (to make sure that a
 *       particular order doesn't have an influence on the result);
 *    B. we compute the sum in a random rounding mode;
 *    C. if this sum is zero, we end the current test (there is no longer
 *       anything interesting to test);
 *    D. we check that this sum is below some bound (chosen as infinite
 *       for the first iteration of (2), i.e. this test will be useful
 *       only for the next iterations, after cancellations);
 *    E. we put the opposite of this sum in the array, the goal being to
 *       introduce a chain of cancellations;
 *    F. we compute the bound for the next iteration, derived from (E).
 * 3. We do another iteration like (2), but with reusing a random element
 *    of the array. This last test allows one to check the support of
 *    reused arguments. Before this support (r10467), it triggers an
 *    assertion failure with (almost?) all seeds, and if assertions are
 *    not checked, tsum fails in most cases but not all.
 */
static void
cancel (void)
{
  mpfr_t x[2 * MPFR_NCANCEL], bound;
  mpfr_ptr px[2 * MPFR_NCANCEL];
  int i, j, k, n;

  mpfr_init2 (bound, 2);

  /* With 4000 tests, tsum will fail in most cases without support of
     reused arguments (before r10467). */
  for (i = 0; i < 4000; i++)
    {
      mpfr_set_inf (bound, 1);
      for (n = 0; n <= numberof (x); n++)
        {
          mpfr_prec_t p;
          mpfr_rnd_t rnd;

          if (n < numberof (x))
            {
              px[n] = x[n];
              p = MPFR_PREC_MIN + (randlimb () % 256);
              mpfr_init2 (x[n], p);
              k = n;
            }
          else
            {
              /* Reuse of a random member of the array. */
              k = randlimb () % n;
            }

          if (n < MPFR_NCANCEL)
            {
              mpfr_exp_t e;

              MPFR_ASSERTN (n < numberof (x));
              e = (i & 1) ? 0 : mpfr_get_emin ();
              tests_default_random (x[n], 256, e,
                                    ((i & 2) ? e + 2000 : mpfr_get_emax ()),
                                    0);
            }
          else
            {
              /* random permutation with n random transpositions */
              for (j = 0; j < n; j++)
                {
                  int k1, k2;

                  k1 = randlimb () % (n-1);
                  k2 = randlimb () % (n-1);
                  mpfr_swap (x[k1], x[k2]);
                }

              rnd = RND_RAND ();

#if DEBUG
              printf ("mpfr_sum cancellation test\n");
              for (j = 0; j < n; j++)
                {
                  printf ("  x%d[%3ld] = ", j, mpfr_get_prec(x[j]));
                  mpfr_out_str (stdout, 16, 0, x[j], MPFR_RNDN);
                  printf ("\n");
                }
              printf ("  rnd = %s, output prec = %ld\n",
                      mpfr_print_rnd_mode (rnd), mpfr_get_prec (x[n]));
#endif

              mpfr_sum (x[k], px, n, rnd);

              if (mpfr_zero_p (x[k]))
                {
                  if (k == n)
                    n++;
                  break;
                }

              if (mpfr_cmpabs (x[k], bound) > 0)
                {
                  printf ("Error in cancel on i = %d, n = %d\n", i, n);
                  printf ("Expected bound: ");
                  mpfr_dump (bound);
                  printf ("x[%d]: ", k);
                  mpfr_dump (x[k]);
                  exit (1);
                }

              if (k != n)
                break;

              /* For the bound, use MPFR_RNDU due to possible underflow.
                 It would be nice to add some specific underflow checks,
                 though there are already ones in check_underflow(). */
              mpfr_set_ui_2exp (bound, 1,
                                mpfr_get_exp (x[n]) - p - (rnd == MPFR_RNDN),
                                MPFR_RNDU);
              /* The next sum will be <= bound in absolute value
                 (the equality can be obtained in all rounding modes
                 since the sum will be rounded). */

              mpfr_neg (x[n], x[n], MPFR_RNDN);
            }
        }

      while (--n >= 0)
        mpfr_clear (x[n]);
    }

  mpfr_clear (bound);
}
Ejemplo n.º 22
0
 void swap(ElementType &a, ElementType &b) const
 {
   mpfr_swap(&a, &b);
 }
Ejemplo n.º 23
0
int
main (void)
{
  mpfr_t xx, yy;
  int c;

  tests_start_mpfr ();

  mpfr_init2 (xx, 2);
  mpfr_init2 (yy, 2);

  mpfr_clear_erangeflag ();
  MPFR_SET_NAN (xx);
  MPFR_SET_NAN (yy);
  if (mpfr_cmpabs (xx, yy) != 0)
    ERROR ("mpfr_cmpabs (NAN,NAN) returns non-zero\n");
  if (!mpfr_erangeflag_p ())
    ERROR ("mpfr_cmpabs (NAN,NAN) doesn't set erange flag\n");

  mpfr_set_str_binary (xx, "0.10E0");
  mpfr_set_str_binary (yy, "-0.10E0");
  if (mpfr_cmpabs (xx, yy) != 0)
    ERROR ("mpfr_cmpabs (xx, yy) returns non-zero for prec=2\n");

  mpfr_set_prec (xx, 65);
  mpfr_set_prec (yy, 65);
  mpfr_set_str_binary (xx, "-0.10011010101000110101010000000011001001001110001011101011111011101E623");
  mpfr_set_str_binary (yy, "0.10011010101000110101010000000011001001001110001011101011111011100E623");
  if (mpfr_cmpabs (xx, yy) <= 0)
    ERROR ("Error (1) in mpfr_cmpabs\n");

  mpfr_set_str_binary (xx, "-0.10100010001110110111000010001000010011111101000100011101000011100");
  mpfr_set_str_binary (yy, "-0.10100010001110110111000010001000010011111101000100011101000011011");
  if (mpfr_cmpabs (xx, yy) <= 0)
    ERROR ("Error (2) in mpfr_cmpabs\n");

  mpfr_set_prec (xx, 160);
  mpfr_set_prec (yy, 160);
  mpfr_set_str_binary (xx, "0.1E1");
  mpfr_set_str_binary (yy, "-0.1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111100000110001110100");
  if (mpfr_cmpabs (xx, yy) <= 0)
    ERROR ("Error (3) in mpfr_cmpabs\n");

  mpfr_set_prec(xx, 53);
  mpfr_set_prec(yy, 200);
  mpfr_set_ui (xx, 1, (mpfr_rnd_t) 0);
  mpfr_set_ui (yy, 1, (mpfr_rnd_t) 0);
  if (mpfr_cmpabs(xx, yy) != 0)
    ERROR ("Error in mpfr_cmpabs: 1.0 != 1.0\n");

  mpfr_set_prec (yy, 31);
  mpfr_set_str (xx, "-1.0000000002", 10, (mpfr_rnd_t) 0);
  mpfr_set_ui (yy, 1, (mpfr_rnd_t) 0);
  if (!(mpfr_cmpabs(xx,yy)>0))
    ERROR ("Error in mpfr_cmpabs: not 1.0000000002 > 1.0\n");
  mpfr_set_prec(yy, 53);

  mpfr_set_ui(xx, 0, MPFR_RNDN);
  mpfr_set_str (yy, "-0.1", 10, MPFR_RNDN);
  if (mpfr_cmpabs(xx, yy) >= 0)
    ERROR ("Error in mpfr_cmpabs(0.0, 0.1)\n");

  mpfr_set_inf (xx, -1);
  mpfr_set_str (yy, "23489745.0329", 10, MPFR_RNDN);
  if (mpfr_cmpabs(xx, yy) <= 0)
    ERROR ("Error in mpfr_cmp(-Inf, 23489745.0329)\n");

  mpfr_set_inf (xx, 1);
  mpfr_set_inf (yy, -1);
  if (mpfr_cmpabs(xx, yy) != 0)
    ERROR ("Error in mpfr_cmpabs(Inf, -Inf)\n");

  mpfr_set_inf (yy, -1);
  mpfr_set_str (xx, "2346.09234", 10, MPFR_RNDN);
  if (mpfr_cmpabs (xx, yy) >= 0)
    ERROR ("Error in mpfr_cmpabs(-Inf, 2346.09234)\n");

  mpfr_set_prec (xx, 2);
  mpfr_set_prec (yy, 128);
  mpfr_set_str_binary (xx, "0.1E10");
  mpfr_set_str_binary (yy,
                       "0.100000000000000000000000000000000000000000000000"
                       "00000000000000000000000000000000000000000000001E10");
  if (mpfr_cmpabs (xx, yy) >= 0)
    ERROR ("Error in mpfr_cmpabs(10.235, 2346.09234)\n");
  mpfr_swap (xx, yy);
  if (mpfr_cmpabs(xx, yy) <= 0)
    ERROR ("Error in mpfr_cmpabs(2346.09234, 10.235)\n");
  mpfr_swap (xx, yy);

  /* Check for NAN */
  mpfr_set_nan (xx);
  mpfr_clear_erangeflag ();
  c = (mpfr_cmp) (xx, yy);
  if (c != 0 || !mpfr_erangeflag_p () )
    {
      printf ("NAN error (1)\n");
      exit (1);
    }
  mpfr_clear_erangeflag ();
  c = (mpfr_cmp) (yy, xx);
  if (c != 0 || !mpfr_erangeflag_p () )
    {
      printf ("NAN error (2)\n");
      exit (1);
    }
  mpfr_clear_erangeflag ();
  c = (mpfr_cmp) (xx, xx);
  if (c != 0 || !mpfr_erangeflag_p () )
    {
      printf ("NAN error (3)\n");
      exit (1);
    }

  mpfr_clear (xx);
  mpfr_clear (yy);

  tests_end_mpfr ();
  return 0;
}
Ejemplo n.º 24
0
static void
_assympt_mpfr (gulong l, mpq_t q, mpfr_ptr res, mp_rnd_t rnd)
{
  NcmBinSplit **bs_ptr = _ncm_mpsf_sbessel_get_bs ();
  NcmBinSplit *bs = *bs_ptr;
  _binsplit_spherical_bessel *data = (_binsplit_spherical_bessel *) bs->userdata;
  gulong prec = mpfr_get_prec (res);
#define sin_x data->sin
#define cos_x data->cos
  mpfr_set_prec (sin_x, prec);
  mpfr_set_prec (cos_x, prec);

  mpfr_set_q (res, q, rnd);
  mpfr_sin_cos (sin_x, cos_x, res, rnd);

  switch (l % 4)
  {
    case 0:
      break;
    case 1:
      mpfr_swap (sin_x, cos_x);
      mpfr_neg (sin_x, sin_x, rnd);
      break;
    case 2:
      mpfr_neg (sin_x, sin_x, rnd);
      mpfr_neg (cos_x, cos_x, rnd);
      break;
    case 3:
      mpfr_swap (sin_x, cos_x);
      mpfr_neg (cos_x, cos_x, rnd);
      break;
  }

  if (l > 0)
  {
    mpfr_mul_ui (cos_x, cos_x, l * (l + 1), rnd);
    mpfr_div (cos_x, cos_x, res, rnd);
    mpfr_div (cos_x, cos_x, res, rnd);
    mpfr_div_2ui (cos_x, cos_x, 1, rnd);
  }

  mpfr_div (sin_x, sin_x, res, rnd);

  data->l = l;
  mpq_inv (data->mq2_2, q);
  mpq_mul (data->mq2_2, data->mq2_2, data->mq2_2);
  mpq_neg (data->mq2_2, data->mq2_2);
  mpq_div_2exp (data->mq2_2, data->mq2_2, 2);

  data->sincos = 0;
  binsplit_spherical_bessel_assympt (bs, 0, (l + 1) / 2 + (l + 1) % 2);
  mpfr_mul_z (sin_x, sin_x, bs->T, rnd);
  mpfr_div_z (sin_x, sin_x, bs->Q, rnd);

  data->sincos = 1;
  if (l > 0)
  {
    binsplit_spherical_bessel_assympt (bs, 0, l / 2 + l % 2);
    mpfr_mul_z (cos_x, cos_x, bs->T, rnd);
    mpfr_div_z (cos_x, cos_x, bs->Q, rnd);
    mpfr_add (res, sin_x, cos_x, rnd);
  }
  else
    mpfr_set (res, sin_x, rnd);

  ncm_memory_pool_return (bs_ptr);
  return;
}