static void
special (void)
{
mpfr_t x, y;
mpfr_init (x);
mpfr_init (y);
mpfr_set_inf (y, -1);
mpfr_set_inf (x, 1);
mpfr_digamma (y, x, MPFR_RNDN);
if (mpfr_inf_p (y) == 0 || mpfr_sgn (y) < 0)
{
printf ("error for Psi(+Inf)\n");
printf ("expected +Inf\n");
printf ("got ");
mpfr_dump (y);
exit (1);
}
mpfr_clear (x);
mpfr_clear (y);
}
/* Use the reflection formula Digamma(1-x) = Digamma(x) + Pi * cot(Pi*x),
i.e., Digamma(x) = Digamma(1-x) - Pi * cot(Pi*x).
Assume x < 1/2. */
static int
mpfr_digamma_reflection (mpfr_ptr y, mpfr_srcptr x, mpfr_rnd_t rnd_mode)
{
mpfr_prec_t p = MPFR_PREC(y) + 10, q;
mpfr_t t, u, v;
mpfr_exp_t e1, expv;
int inex;
MPFR_ZIV_DECL (loop);
/* we want that 1-x is exact with precision q: if 0 < x < 1/2, then
q = PREC(x)-EXP(x) is ok, otherwise if -1 <= x < 0, q = PREC(x)-EXP(x)
is ok, otherwise for x < -1, PREC(x) is ok if EXP(x) <= PREC(x),
otherwise we need EXP(x) */
if (MPFR_EXP(x) < 0)
q = MPFR_PREC(x) + 1 - MPFR_EXP(x);
else if (MPFR_EXP(x) <= MPFR_PREC(x))
q = MPFR_PREC(x) + 1;
else
q = MPFR_EXP(x);
mpfr_init2 (u, q);
MPFR_DBGRES(inex = mpfr_ui_sub (u, 1, x, MPFR_RNDN));
MPFR_ASSERTN(inex == 0);
/* if x is half an integer, cot(Pi*x) = 0, thus Digamma(x) = Digamma(1-x) */
mpfr_mul_2exp (u, u, 1, MPFR_RNDN);
inex = mpfr_integer_p (u);
mpfr_div_2exp (u, u, 1, MPFR_RNDN);
if (inex)
{
inex = mpfr_digamma (y, u, rnd_mode);
goto end;
}
mpfr_init2 (t, p);
mpfr_init2 (v, p);
MPFR_ZIV_INIT (loop, p);
for (;;)
{
mpfr_const_pi (v, MPFR_RNDN); /* v = Pi*(1+theta) for |theta|<=2^(-p) */
mpfr_mul (t, v, x, MPFR_RNDN); /* (1+theta)^2 */
e1 = MPFR_EXP(t) - (mpfr_exp_t) p + 1; /* bound for t: err(t) <= 2^e1 */
mpfr_cot (t, t, MPFR_RNDN);
/* cot(t * (1+h)) = cot(t) - theta * (1 + cot(t)^2) with |theta|<=t*h */
if (MPFR_EXP(t) > 0)
e1 = e1 + 2 * MPFR_EXP(t) + 1;
else
e1 = e1 + 1;
/* now theta * (1 + cot(t)^2) <= 2^e1 */
e1 += (mpfr_exp_t) p - MPFR_EXP(t); /* error is now 2^e1 ulps */
mpfr_mul (t, t, v, MPFR_RNDN);
e1 ++;
mpfr_digamma (v, u, MPFR_RNDN); /* error <= 1/2 ulp */
expv = MPFR_EXP(v);
mpfr_sub (v, v, t, MPFR_RNDN);
if (MPFR_EXP(v) < MPFR_EXP(t))
e1 += MPFR_EXP(t) - MPFR_EXP(v); /* scale error for t wrt new v */
/* now take into account the 1/2 ulp error for v */
if (expv - MPFR_EXP(v) - 1 > e1)
e1 = expv - MPFR_EXP(v) - 1;
else
e1 ++;
e1 ++; /* rounding error for mpfr_sub */
if (MPFR_CAN_ROUND (v, p - e1, MPFR_PREC(y), rnd_mode))
break;
MPFR_ZIV_NEXT (loop, p);
mpfr_set_prec (t, p);
mpfr_set_prec (v, p);
}
MPFR_ZIV_FREE (loop);
inex = mpfr_set (y, v, rnd_mode);
mpfr_clear (t);
mpfr_clear (v);
end:
mpfr_clear (u);
return inex;
}
