Ruby
2.7.0p0(2019-12-25revision647ee6f091eafcce70ffb75ddf7e121e192ab217)
missing
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
Generated by
1.8.17