missing/tgamma.c

   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