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