Ruby 2.7.0p0(2019-12-25revision647ee6f091eafcce70ffb75ddf7e121e192ab217)

tgamma.c
Go to the documentation of this file.
1 /* tgamma.c - public domain implementation of function tgamma(3m)
2
3 reference - 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 "ruby/missing.h"
14 #include <math.h>
15 #include <errno.h>
16
17 #ifdef _WIN32
18 # include <float.h>
19 # if !defined __MINGW32__ || defined __NO_ISOCEXT
20 # ifndef isnan
21 # define isnan(x) _isnan(x)
22 # endif
23 # ifndef isinf
24 # define isinf(x) (!_finite(x) && !_isnan(x))
25 # endif
26 # ifndef finite
27 # define finite(x) _finite(x)
28 # endif
29 # endif
30 #endif
31
32 #ifndef HAVE_LGAMMA_R
33
34 #include <errno.h>
35 #define PI 3.14159265358979324 /* $\pi$ */
36 #define LOG_2PI 1.83787706640934548 /* $\log 2\pi$ */
37 #define N 8
38
39 #define B0 1 /* Bernoulli numbers */
40 #define B1 (-1.0 / 2.0)
41 #define B2 ( 1.0 / 6.0)
42 #define B4 (-1.0 / 30.0)
43 #define B6 ( 1.0 / 42.0)
44 #define B8 (-1.0 / 30.0)
45 #define B10 ( 5.0 / 66.0)
46 #define B12 (-691.0 / 2730.0)
47 #define B14 ( 7.0 / 6.0)
48 #define B16 (-3617.0 / 510.0)
49
50 static double
51 loggamma(double x) /* the natural logarithm of the Gamma function. */
52 {
53 double v, w;
54
55 v = 1;
56 while (x < N) { v *= x; x++; }
57 w = 1 / (x * x);
58 return ((((((((B16 / (16 * 15)) * w + (B14 / (14 * 13))) * w
59 + (B12 / (12 * 11))) * w + (B10 / (10 * 9))) * w
60 + (B8 / ( 8 * 7))) * w + (B6 / ( 6 * 5))) * w
61 + (B4 / ( 4 * 3))) * w + (B2 / ( 2 * 1))) / x
62 + 0.5 * LOG_2PI - log(v) - x + (x - 0.5) * log(x);
63 }
64 #endif
65
66 double tgamma(double x) /* Gamma function */
67 {
68 int sign;
69 if (x == 0.0) { /* Pole Error */
70 errno = ERANGE;
71 return 1/x < 0 ? -HUGE_VAL : HUGE_VAL;
72 }
73 if (isinf(x)) {
74 if (x < 0) goto domain_error;
75 return x;
76 }
77 if (x < 0) {
78 static double zero = 0.0;
79 double i, f;
80 f = modf(-x, &i);
81 if (f == 0.0) { /* Domain Error */
82 domain_error:
83 errno = EDOM;
84 return zero/zero;
85 }
86 #ifndef HAVE_LGAMMA_R
87 sign = (fmod(i, 2.0) != 0.0) ? 1 : -1;
88 return sign * PI / (sin(PI * f) * exp(loggamma(1 - x)));
89 #endif
90 }
91 #ifndef HAVE_LGAMMA_R
92 return exp(loggamma(x));
93 #else
94 x = lgamma_r(x, &sign);
95 return sign * exp(x);
96 #endif
97 }
B8
#define B8
Definition: tgamma.c:44
B4
#define B4
Definition: tgamma.c:42
ERANGE
#define ERANGE
Definition: rb_mjit_min_header-2.7.0.h:10971
sin
double sin(double)
fmod
double fmod(double, double)
v
int VALUE v
Definition: rb_mjit_min_header-2.7.0.h:12332
HUGE_VAL
#define HUGE_VAL
Definition: missing.h:161
B10
#define B10
Definition: tgamma.c:45
B14
#define B14
Definition: tgamma.c:47
i
uint32_t i
Definition: rb_mjit_min_header-2.7.0.h:5464
lgamma_r
RUBY_EXTERN double lgamma_r(double, int *)
Definition: lgamma_r.c:63
isinf
#define isinf(__x)
Definition: rb_mjit_min_header-2.7.0.h:3673
PI
#define PI
Definition: tgamma.c:35
log
double log(double)
missing.h
f
#define f
exp
double exp(double)
modf
double modf(double, double *)
N
#define N
Definition: tgamma.c:37
EDOM
#define EDOM
Definition: rb_mjit_min_header-2.7.0.h:10970
tgamma
double tgamma(double x)
Definition: tgamma.c:66
errno
int errno
LOG_2PI
#define LOG_2PI
Definition: tgamma.c:36
B2
#define B2
Definition: tgamma.c:41
domain_error
#define domain_error(msg)
Definition: math.c:32
B6
#define B6
Definition: tgamma.c:43
B12
#define B12
Definition: tgamma.c:46
B16
#define B16
Definition: tgamma.c:48