• Main Page
  • Modules
  • Data Structures
  • Files
  • File List
  • Globals

missing/lgamma_r.c

Go to the documentation of this file.
00001 /* lgamma_r.c  - public domain implementation of function lgamma_r(3m)
00002 
00003 lgamma_r() is based on gamma().  modified by Tanaka Akira.
00004 
00005 reference - Haruhiko Okumura: C-gengo niyoru saishin algorithm jiten
00006             (New Algorithm handbook in C language) (Gijyutsu hyouron
00007             sha, Tokyo, 1991) [in Japanese]
00008             http://oku.edu.mie-u.ac.jp/~okumura/algo/
00009 */
00010 
00011 /***********************************************************
00012     gamma.c -- Gamma function
00013 ***********************************************************/
00014 #include <math.h>
00015 #include <errno.h>
00016 #define PI      3.14159265358979324  /* $\pi$ */
00017 #define LOG_2PI 1.83787706640934548  /* $\log 2\pi$ */
00018 #define LOG_PI  1.14472988584940017  /* $\log_e \pi$ */
00019 #define N       8
00020 
00021 #define B0  1                 /* Bernoulli numbers */
00022 #define B1  (-1.0 / 2.0)
00023 #define B2  ( 1.0 / 6.0)
00024 #define B4  (-1.0 / 30.0)
00025 #define B6  ( 1.0 / 42.0)
00026 #define B8  (-1.0 / 30.0)
00027 #define B10 ( 5.0 / 66.0)
00028 #define B12 (-691.0 / 2730.0)
00029 #define B14 ( 7.0 / 6.0)
00030 #define B16 (-3617.0 / 510.0)
00031 
00032 static double
00033 loggamma(double x)  /* the natural logarithm of the Gamma function. */
00034 {
00035     double v, w;
00036 
00037     if (x == 1.0 || x == 2.0) return 0.0;
00038 
00039     v = 1;
00040     while (x < N) {  v *= x;  x++;  }
00041     w = 1 / (x * x);
00042     return ((((((((B16 / (16 * 15))  * w + (B14 / (14 * 13))) * w
00043                 + (B12 / (12 * 11))) * w + (B10 / (10 *  9))) * w
00044                 + (B8  / ( 8 *  7))) * w + (B6  / ( 6 *  5))) * w
00045                 + (B4  / ( 4 *  3))) * w + (B2  / ( 2 *  1))) / x
00046                 + 0.5 * LOG_2PI - log(v) - x + (x - 0.5) * log(x);
00047 }
00048 
00049 /* the natural logarithm of the absolute value of the Gamma function */
00050 double
00051 lgamma_r(double x, int *signp)
00052 {
00053     if (x <= 0) {
00054         double i, f, s;
00055         f = modf(-x, &i);
00056         if (f == 0.0) { /* pole error */
00057             *signp = 1;
00058             errno = ERANGE;
00059             return HUGE_VAL;
00060         }
00061         *signp = (fmod(i, 2.0) != 0.0) ? 1 : -1;
00062         s = sin(PI * f);
00063         if (s < 0) s = -s;
00064         return LOG_PI - log(s) - loggamma(1 - x);
00065     }
00066     *signp = 1;
00067     return loggamma(x);
00068 }
00069 

Generated on Wed Sep 8 2010 09:56:00 for Ruby by  doxygen 1.7.1