S4 = 0.0008417508417508417508417508; /* 1/1188 */
#endregion
/* R file: lgamma.c
*/
private static double lgammafn_sign(double x, ref int?sgn)
{
double ans, y, sinpiy;
const double
xmax = 2.5327372760800758e+305,
dxrel = 1.490116119384765625e-8;
if (sgn != null)
{
sgn = 1;
}
if (double.IsNaN(x))
{
return(x);
}
if ((sgn != null) && (x < 0) && ((Math.Floor(-x) % 2.0) == 0)) // fmod était utilisé
{
sgn = -1;
}
if (x <= 0 && x == Math.Truncate(x))
{ /* Negative integer argument */
// ML_ERROR(ME_RANGE, "lgamma");
return(double.PositiveInfinity); /* +Inf, since lgamma(x) = log|gamma(x)| */
}
y = Math.Abs(x);
if (y < 1e-306)
{
return(-Math.Log(y)); // denormalized range, R change
}
if (y <= 10)
{
return(Math.Log(Math.Abs(Gamma(x))));
}
/*
* ELSE y = |x| > 10 ---------------------- */
if (y > xmax)
{
// ML_ERROR(ME_RANGE, "lgamma");
return(double.PositiveInfinity);
}
if (x > 0)
{ /* i.e. y = x > 10 */
if (x > 1e17)
{
return(x * (Math.Log(x) - 1.0));
}
else if (x > 4934720.0)
{
return(RVaria.M_LN_SQRT_2PI + (x - 0.5) * Math.Log(x) - x);
}
else
{
return(RVaria.M_LN_SQRT_2PI + (x - 0.5) * Math.Log(x) - x + lgammacor(x));
}
}
/* else: x < -10; y = -x */
sinpiy = Math.Abs(RVaria.sinpi(y));
if (sinpiy == 0)
{ /* Negative integer argument ===
* Now UNNECESSARY: caught above */
// MATHLIB_WARNING(" ** should NEVER happen! *** [lgamma.c: Neg.int, y=%g]\n",y);
return(RVaria.R_NaN);
// ML_ERR_return_NAN;
}
ans = RVaria.M_LN_SQRT_PId2 + (x - 0.5) * Math.Log(y) - x - Math.Log(sinpiy) - lgammacor(y);
if (Math.Abs((x - Math.Truncate(x - 0.5)) * ans / x) < dxrel)
{
/* The answer is less than half precision because
* the argument is too near a negative integer. */
// ML_ERROR(ME_PRECISION, "lgamma");
}
return(ans);
}
/* R file: gamma.c
* name used in R: gammafn
*/
public static double Gamma(double x)
{
int i, n;
double y;
double sinpiy, value;
const double
xmin = -170.5674972726612,
xmax = 171.61447887182298,
xsml = 2.2474362225598545e-308,
dxrel = 1.490116119384765696e-8;
const int
ngam = 22;
if (double.IsNaN(x))
{
return(x);
}
/* If the argument is exactly zero or a negative integer
* then return NaN. */
if (x == 0 || (x < 0 && x == Math.Round(x)))
{
// ML_ERROR(ME_DOMAIN, "gammafn");
return(double.NaN);
}
y = Math.Abs(x);
if (y <= 10)
{
/* Compute gamma(x) for -10 <= x <= 10
* Reduce the interval and find gamma(1 + y) for 0 <= y < 1
* first of all. */
n = (int)x;
if (x < 0)
{
--n;
}
y = x - n;/* n = floor(x) ==> y in [ 0, 1 ) */
--n;
value = RVaria.chebyshev_eval(y * 2 - 1, gamcs, ngam) + .9375;
if (n == 0)
{
return(value);/* x = 1.dddd = 1+y */
}
if (n < 0)
{
/* compute gamma(x) for -10 <= x < 1 */
/* exact 0 or "-n" checked already above */
/* The answer is less than half precision */
/* because x too near a negative integer. */
if ((x < -0.5) && (Math.Abs(x - (int)(x - 0.5) / x) < dxrel))
{
// ML_ERROR(ME_PRECISION, "gammafn");
}
/* The argument is so close to 0 that the result would overflow. */
if (y < xsml)
{
// ML_ERROR(ME_RANGE, "gammafn");
if (x > 0)
{
return(double.PositiveInfinity);
}
else
{
return(double.NegativeInfinity);
}
}
n = -n;
for (i = 0; i < n; i++)
{
value /= (x + i);
}
return(value);
}
else
{
/* gamma(x) for 2 <= x <= 10 */
for (i = 1; i <= n; i++)
{
value *= (y + i);
}
return(value);
}
}
else
{
/* gamma(x) for y = |x| > 10. */
if (x > xmax)
{ /* Overflow */
// ML_ERROR(ME_RANGE, "gammafn");
return(double.PositiveInfinity);
}
if (x < xmin)
{ /* Underflow */
// ML_ERROR(ME_UNDERFLOW, "gammafn");
return(0.0);
}
if (y <= 50 && y == (int)y)
{ /* compute (n - 1)! */
value = 1.0;
for (i = 2; i < y; i++)
{
value *= i;
}
}
else
{ /* normal case */
value = Math.Exp((y - 0.5) * Math.Log(y) - y + RVaria.M_LN_SQRT_2PI +
((2 * y == (int)2 * y) ? StirlingError(y) : lgammacor(y)));
}
if (x > 0)
{
return(value);
}
if (Math.Abs((x - (int)(x - 0.5)) / x) < dxrel)
{
/* The answer is less than half precision because */
/* the argument is too near a negative integer. */
// ML_ERROR(ME_PRECISION, "gammafn");
}
sinpiy = RVaria.sinpi(y);
if (sinpiy == 0)
{ /* Negative integer arg - overflow */
// ML_ERROR(ME_RANGE, "gammafn");
return(double.PositiveInfinity);
}
return(-RVaria.M_PI / (y * sinpiy * value));
}
}