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)); } }