1 /*
2 * Ruby's missing/lgamma_r.c took from
3 * https://github.com/ruby/ruby/commit/39330d6b79c95f67006453156d8405242da04d7b
4 */
5
6 /* lgamma_r.c - public domain implementation of function lgamma_r(3m)
7
8 lgamma_r() is based on gamma(). modified by Tanaka Akira.
9
10 reference - Haruhiko Okumura: C-gengo niyoru saishin algorithm jiten
11 (New Algorithm handbook in C language) (Gijyutsu hyouron
12 sha, Tokyo, 1991) [in Japanese]
13 http://oku.edu.mie-u.ac.jp/~okumura/algo/
14 */
15
16 /***********************************************************
17 gamma.c -- Gamma function
18 ***********************************************************/
19 #include <math.h>
20 #include <errno.h>
21 #define PI 3.14159265358979324 /* $\pi$ */
22 #define LOG_2PI 1.83787706640934548 /* $\log 2\pi$ */
23 #define LOG_PI 1.14472988584940017 /* $\log_e \pi$ */
24 #define N 8
25
26 #define B0 1 /* Bernoulli numbers */
27 #define B1 (-1.0 / 2.0)
28 #define B2 ( 1.0 / 6.0)
29 #define B4 (-1.0 / 30.0)
30 #define B6 ( 1.0 / 42.0)
31 #define B8 (-1.0 / 30.0)
32 #define B10 ( 5.0 / 66.0)
33 #define B12 (-691.0 / 2730.0)
34 #define B14 ( 7.0 / 6.0)
35 #define B16 (-3617.0 / 510.0)
36
37 static double
loggamma(double x)38 loggamma(double x) /* the natural logarithm of the Gamma function. */
39 {
40 double v, w;
41
42 if (x == 1.0 || x == 2.0) return 0.0;
43
44 v = 1;
45 while (x < N) { v *= x; x++; }
46 w = 1 / (x * x);
47 return ((((((((B16 / (16 * 15)) * w + (B14 / (14 * 13))) * w
48 + (B12 / (12 * 11))) * w + (B10 / (10 * 9))) * w
49 + (B8 / ( 8 * 7))) * w + (B6 / ( 6 * 5))) * w
50 + (B4 / ( 4 * 3))) * w + (B2 / ( 2 * 1))) / x
51 + 0.5 * LOG_2PI - log(v) - x + (x - 0.5) * log(x);
52 }
53
54
55 #ifdef __MINGW_ATTRIB_PURE
56 /* get rid of bugs in math.h of mingw */
57 #define modf(_X, _Y) __extension__ ({\
58 double intpart_modf_bug = intpart_modf_bug;\
59 double result_modf_bug = modf((_X), &intpart_modf_bug);\
60 *(_Y) = intpart_modf_bug;\
61 result_modf_bug;\
62 })
63 #endif
64
65 /* the natural logarithm of the absolute value of the Gamma function */
66 double
lgamma_r(double x,int * signp)67 lgamma_r(double x, int *signp)
68 {
69 if (x <= 0) {
70 double i, f, s;
71 f = modf(-x, &i);
72 if (f == 0.0) { /* pole error */
73 *signp = signbit(x) ? -1 : 1;
74 errno = ERANGE;
75 return HUGE_VAL;
76 }
77 *signp = (fmod(i, 2.0) != 0.0) ? 1 : -1;
78 s = sin(PI * f);
79 if (s < 0) s = -s;
80 return LOG_PI - log(s) - loggamma(1 - x);
81 }
82 *signp = 1;
83 return loggamma(x);
84 }
85