Subversion Repositories Kolibri OS

Rev

Go to most recent revision | Blame | Last modification | View Log | Download | RSS feed

  1. /*                                                      lgamf()
  2.  *
  3.  *      Natural logarithm of gamma function
  4.  *
  5.  *
  6.  *
  7.  * SYNOPSIS:
  8.  *
  9.  * float x, y, __lgammaf_r();
  10.  * int* sgngamf;
  11.  * y = __lgammaf_r( x, sgngamf );
  12.  *
  13.  * float x, y, lgammaf();
  14.  * y = lgammaf( x);
  15.  *
  16.  *
  17.  *
  18.  * DESCRIPTION:
  19.  *
  20.  * Returns the base e (2.718...) logarithm of the absolute
  21.  * value of the gamma function of the argument. In the reentrant
  22.  * version the sign (+1 or -1) of the gamma function is returned in
  23.  * variable referenced by sgngamf.
  24.  *
  25.  * For arguments greater than 6.5, the logarithm of the gamma
  26.  * function is approximated by the logarithmic version of
  27.  * Stirling's formula.  Arguments between 0 and +6.5 are reduced by
  28.  * by recurrence to the interval [.75,1.25] or [1.5,2.5] of a rational
  29.  * approximation.  The cosecant reflection formula is employed for
  30.  * arguments less than zero.
  31.  *
  32.  * Arguments greater than MAXLGM = 2.035093e36 return MAXNUM and an
  33.  * error message.
  34.  *
  35.  *
  36.  *
  37.  * ACCURACY:
  38.  *
  39.  *
  40.  *
  41.  * arithmetic      domain        # trials     peak         rms
  42.  *    IEEE        -100,+100       500,000    7.4e-7       6.8e-8
  43.  * The error criterion was relative when the function magnitude
  44.  * was greater than one but absolute when it was less than one.
  45.  * The routine has low relative error for positive arguments.
  46.  *
  47.  * The following test used the relative error criterion.
  48.  *    IEEE    -2, +3              100000     4.0e-7      5.6e-8
  49.  *
  50.  */
  51.  
  52.  
  53. /*
  54.   Cephes Math Library Release 2.7:  July, 1998
  55.   Copyright 1984, 1987, 1989, 1992, 1998 by Stephen L. Moshier
  56. */
  57.  
  58. /*
  59.   26-11-2002 Modified for mingw.
  60.   Danny Smith <dannysmith@users.sourceforge.net>
  61. */
  62.  
  63.  
  64. /* log gamma(x+2), -.5 < x < .5 */
  65. static const float B[] = {
  66.  6.055172732649237E-004,
  67. -1.311620815545743E-003,
  68.  2.863437556468661E-003,
  69. -7.366775108654962E-003,
  70.  2.058355474821512E-002,
  71. -6.735323259371034E-002,
  72.  3.224669577325661E-001,
  73.  4.227843421859038E-001
  74. };
  75.  
  76. /* log gamma(x+1), -.25 < x < .25 */
  77. static const float C[] = {
  78.  1.369488127325832E-001,
  79. -1.590086327657347E-001,
  80.  1.692415923504637E-001,
  81. -2.067882815621965E-001,
  82.  2.705806208275915E-001,
  83. -4.006931650563372E-001,
  84.  8.224670749082976E-001,
  85. -5.772156501719101E-001
  86. };
  87.  
  88. /* log( sqrt( 2*pi ) ) */
  89. static const float LS2PI  =  0.91893853320467274178;
  90. #define MAXLGM 2.035093e36
  91. static const float PIINV =  0.318309886183790671538;
  92.  
  93. #ifndef __MINGW32__
  94. #include "mconf.h"
  95. float floorf(float);
  96. float polevlf( float, float *, int );
  97. float p1evlf( float, float *, int );
  98. #else
  99. #include "cephes_mconf.h"
  100. #endif
  101.  
  102. /* Reentrant version */
  103. /* Logarithm of gamma function */
  104.  
  105. float __lgammaf_r( float x, int* sgngamf )
  106. {
  107. float p, q, w, z;
  108. float nx, tx;
  109. int i, direction;
  110.  
  111. *sgngamf = 1;
  112. #ifdef NANS
  113. if( isnan(x) )
  114.         return(x);
  115. #endif
  116.  
  117. #ifdef INFINITIES
  118. if( !isfinite(x) )
  119.         return(x);
  120. #endif
  121.  
  122.  
  123. if( x < 0.0 )
  124.         {
  125.         q = -x;
  126.         w = __lgammaf_r(q, sgngamf); /* note this modifies sgngam! */
  127.         p = floorf(q);
  128.         if( p == q )
  129.                 {
  130. lgsing:
  131.                 _SET_ERRNO(EDOM);
  132.                 mtherr( "lgamf", SING );
  133. #ifdef INFINITIES
  134.                 return (INFINITYF);
  135. #else
  136.         return( *sgngamf * MAXNUMF );
  137. #endif
  138.                 }
  139.         i = p;
  140.         if( (i & 1) == 0 )
  141.                 *sgngamf = -1;
  142.         else
  143.                 *sgngamf = 1;
  144.         z = q - p;
  145.         if( z > 0.5 )
  146.                 {
  147.                 p += 1.0;
  148.                 z = p - q;
  149.                 }
  150.         z = q * sinf( PIF * z );
  151.         if( z == 0.0 )
  152.                 goto lgsing;
  153.         z = -logf( PIINV*z ) - w;
  154.         return( z );
  155.         }
  156.  
  157. if( x < 6.5 )
  158.         {
  159.         direction = 0;
  160.         z = 1.0;
  161.         tx = x;
  162.         nx = 0.0;
  163.         if( x >= 1.5 )
  164.                 {
  165.                 while( tx > 2.5 )
  166.                         {
  167.                         nx -= 1.0;
  168.                         tx = x + nx;
  169.                         z *=tx;
  170.                         }
  171.                 x += nx - 2.0;
  172. iv1r5:
  173.                 p = x * polevlf( x, B, 7 );
  174.                 goto cont;
  175.                 }
  176.         if( x >= 1.25 )
  177.                 {
  178.                 z *= x;
  179.                 x -= 1.0; /* x + 1 - 2 */
  180.                 direction = 1;
  181.                 goto iv1r5;
  182.                 }
  183.         if( x >= 0.75 )
  184.                 {
  185.                 x -= 1.0;
  186.                 p = x * polevlf( x, C, 7 );
  187.                 q = 0.0;
  188.                 goto contz;
  189.                 }
  190.         while( tx < 1.5 )
  191.                 {
  192.                 if( tx == 0.0 )
  193.                         goto lgsing;
  194.                 z *=tx;
  195.                 nx += 1.0;
  196.                 tx = x + nx;
  197.                 }
  198.         direction = 1;
  199.         x += nx - 2.0;
  200.         p = x * polevlf( x, B, 7 );
  201.  
  202. cont:
  203.         if( z < 0.0 )
  204.                 {
  205.                 *sgngamf = -1;
  206.                 z = -z;
  207.                 }
  208.         else
  209.                 {
  210.                 *sgngamf = 1;
  211.                 }
  212.         q = logf(z);
  213.         if( direction )
  214.                 q = -q;
  215. contz:
  216.         return( p + q );
  217.         }
  218.  
  219. if( x > MAXLGM )
  220.         {
  221.         _SET_ERRNO(ERANGE);
  222.         mtherr( "lgamf", OVERFLOW );
  223. #ifdef INFINITIES
  224.         return( *sgngamf * INFINITYF );
  225. #else
  226.         return( *sgngamf * MAXNUMF );
  227. #endif
  228.  
  229.         }
  230.  
  231. /* Note, though an asymptotic formula could be used for x >= 3,
  232.  * there is cancellation error in the following if x < 6.5.  */
  233. q = LS2PI - x;
  234. q += ( x - 0.5 ) * logf(x);
  235.  
  236. if( x <= 1.0e4 )
  237.         {
  238.         z = 1.0/x;
  239.         p = z * z;
  240.         q += ((    6.789774945028216E-004 * p
  241.                  - 2.769887652139868E-003 ) * p
  242.                 +  8.333316229807355E-002 ) * z;
  243.         }
  244. return( q );
  245. }
  246.  
  247. /* This is the C99 version */
  248.  
  249. float lgammaf(float x)
  250. {
  251.   int local_sgngamf=0;
  252.   return (__lgammaf_r(x, &local_sgngamf));
  253. }
  254.