Ruby  2.0.0p594(2014-10-27revision48167)
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 <math.h>
14 #include <errno.h>
15 
16 #ifdef HAVE_LGAMMA_R
17 
18 double 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 
57 static double
58 loggamma(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 
72 double 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
static double zero(void)
Definition: isinf.c:51
static double loggamma(double x)
Definition: tgamma.c:58
#define B16
Definition: tgamma.c:55
ssize_t i
Definition: bigdecimal.c:5676
#define LOG_2PI
Definition: tgamma.c:43
#define B4
Definition: tgamma.c:49
d
Definition: strlcat.c:58
#define B10
Definition: tgamma.c:52
#define N
Definition: tgamma.c:44
int errno
#define B6
Definition: tgamma.c:50
#define B14
Definition: tgamma.c:54
RUBY_EXTERN double lgamma_r(double, int *)
Definition: lgamma_r.c:63
#define B2
Definition: tgamma.c:48
#define f
RUBY_EXTERN double tgamma(double)
Definition: tgamma.c:72
#define B12
Definition: tgamma.c:53
#define B8
Definition: tgamma.c:51
BDIGIT v
Definition: bigdecimal.c:5677
#define PI
Definition: tgamma.c:42