Ruby 2.7.6p219 (2022-04-12 revision c9c2245c0a25176072e02db9254f0e0c84c805cd)
tgamma.c
Go to the documentation of this file.
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 "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
50static double
51loggamma(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
66double 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 */
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}
int errno
#define domain_error(msg)
Definition: math.c:32
#define EDOM
double modf(double, double *)
#define isinf(__x)
uint32_t i
double fmod(double, double)
int VALUE v
#define ERANGE
double lgamma_r(double, int *)
Definition: lgamma_r.c:63
double sin(double)
double exp(double)
#define HUGE_VAL
double log(double)
#define f
#define N
Definition: tgamma.c:37
#define B4
Definition: tgamma.c:42
double tgamma(double x)
Definition: tgamma.c:66
#define PI
Definition: tgamma.c:35
#define B2
Definition: tgamma.c:41
#define B12
Definition: tgamma.c:46
#define B6
Definition: tgamma.c:43
#define B16
Definition: tgamma.c:48
#define B14
Definition: tgamma.c:47
#define LOG_2PI
Definition: tgamma.c:36
#define B8
Definition: tgamma.c:44
#define B10
Definition: tgamma.c:45