1/* tgamma.c - public domain implementation of function tgamma(3m) 2 3reference - Haruhiko Okumura: C-gengo niyoru saishin algorithm jiten 4 (New Algorithm handbook in C language) (Gijyutsu hyouron 5 sha, Tokyo, 1991) [in Japanese] 6 http://oku.edu.mie-u.ac.jp/~okumura/algo/ 7*/ 8 9/*********************************************************** 10 gamma.c -- Gamma function 11***********************************************************/ 12#include "ruby/config.h" 13#include <math.h> 14#include <errno.h> 15 16#ifdef HAVE_LGAMMA_R 17 18double tgamma(double x) 19{ 20 int sign; 21 double d; 22 if (x == 0.0) { /* Pole Error */ 23 errno = ERANGE; 24 return 1/x < 0 ? -HUGE_VAL : HUGE_VAL; 25 } 26 if (x < 0) { 27 static double zero = 0.0; 28 double i, f; 29 f = modf(-x, &i); 30 if (f == 0.0) { /* Domain Error */ 31 errno = EDOM; 32 return zero/zero; 33 } 34 } 35 d = lgamma_r(x, &sign); 36 return sign * exp(d); 37} 38 39#else 40 41#include <errno.h> 42#define PI 3.14159265358979324 /* $\pi$ */ 43#define LOG_2PI 1.83787706640934548 /* $\log 2\pi$ */ 44#define N 8 45 46#define B0 1 /* Bernoulli numbers */ 47#define B1 (-1.0 / 2.0) 48#define B2 ( 1.0 / 6.0) 49#define B4 (-1.0 / 30.0) 50#define B6 ( 1.0 / 42.0) 51#define B8 (-1.0 / 30.0) 52#define B10 ( 5.0 / 66.0) 53#define B12 (-691.0 / 2730.0) 54#define B14 ( 7.0 / 6.0) 55#define B16 (-3617.0 / 510.0) 56 57static double 58loggamma(double x) /* the natural logarithm of the Gamma function. */ 59{ 60 double v, w; 61 62 v = 1; 63 while (x < N) { v *= x; x++; } 64 w = 1 / (x * x); 65 return ((((((((B16 / (16 * 15)) * w + (B14 / (14 * 13))) * w 66 + (B12 / (12 * 11))) * w + (B10 / (10 * 9))) * w 67 + (B8 / ( 8 * 7))) * w + (B6 / ( 6 * 5))) * w 68 + (B4 / ( 4 * 3))) * w + (B2 / ( 2 * 1))) / x 69 + 0.5 * LOG_2PI - log(v) - x + (x - 0.5) * log(x); 70} 71 72double tgamma(double x) /* Gamma function */ 73{ 74 if (x == 0.0) { /* Pole Error */ 75 errno = ERANGE; 76 return 1/x < 0 ? -HUGE_VAL : HUGE_VAL; 77 } 78 if (x < 0) { 79 int sign; 80 static double zero = 0.0; 81 double i, f; 82 f = modf(-x, &i); 83 if (f == 0.0) { /* Domain Error */ 84 errno = EDOM; 85 return zero/zero; 86 } 87 sign = (fmod(i, 2.0) != 0.0) ? 1 : -1; 88 return sign * PI / (sin(PI * f) * exp(loggamma(1 - x))); 89 } 90 return exp(loggamma(x)); 91} 92#endif 93