Sindbad~EG File Manager

/* M. Beeson, following ideas in Numerical Recipes pp. 108-109
  compute factorials, Gamma function, binomial coefficients
  producing decimal answers
  12.17.91 original date
  3.24.95  modified
  1.7.97  modified dbinomial to avoid warnings in VC
*/
#include <math.h>
#include <assert.h>
#define DEVAL_DLL
#include "export.h"
#include "terms.h"
#include "deval.h"
#include "baker.h"  /* for PI_DECIMAL */


#define BADVAL 2.0E300
double gammln(double);
int gamma2(double, double *);   /* called by deval.c */
int dfactorial(double, double *);
int dbinomial(double,double, double *);
/*_____________________________________________________________________*/
#define TABLEDIM 33
int dfactorial(double x, double *ansp)
/* compute factorial of x if x > 0 -- integer or not */
/* if isn't an int, but is very close to an int k, will not fail but
will compute k factorial */
/* return 0 to indicate success */
/* return 18 if factorial would overflow a double */

{ static int ntop = 4;
  long k;
  static double a[TABLEDIM] = {1.0, 1.0, 2.0, 6.0, 24.0}; /* fill in as needed */
  int j;
  if(x<0)
     return 19;
  if(x > 170 )  /* determined by exact calculation of 170! */
     return 18;
  if(x > 32)
     { *ansp = exp(gammln(x + 1.0));
       return 0;
     }
  if(nearint(x,&k) && ((k >> 17) == 0))
     { x = (double) k;  /* fix a slight deviation from an integer,
                      which would probably be due to roundoff error.  */
       if(k < TABLEDIM)  /* fill in the static lookup table */
          { while(ntop < k)
               { j = ntop++;
                 a[ntop] = a[j]*ntop;
               }
            *ansp = a[(int) k];
            return 0;
          }
     }
  *ansp = exp(gammln(x+1.0));
  return 0;
}
/*___________________________________________________________________*/
#define NFTABLE 25  /* small to save space -- was 100 in Numerical Recipes */
double factln(int n)
/* returns ln(n!) */
/* never overflows */
/* n is assumed to be positive */
{  static double a[NFTABLE];  /* table of function values */
   if(n <= 1)
      return 0.0;
   if(n < NFTABLE)  /* use or add to the table */
      return a[n] ? a[n] : (a[n]=gammln(n+1.0));
   return gammln(n+1.0);  /* out of range of the table */
}
#undef NFTABLE
/*___________________________________________________________________*/
int dbinomial( double x, double y, double *ansp)

/*  compute x choose y  if y is actually an integer */
/*  x isn't required even to be close to an integer */

{ double arg;
  long xx,yy;
  if(x <= 0.0 || y <= 0.0 )
     return 1;
  if( x-y < y)
     y = x-y;
  if (!nearint(y,&xx))
     return 17;  /* error value wanted by deval */
  if (nearint(x,&xx) && (xx >> 17) == 0  /* x converts to an int */
      && nearint(y,&yy) && (yy >> 17) == 0
     )
     { arg = factln((int)x) - factln((int)yy) - factln((int)(xx-yy));
       if(arg >= 709)   /* 308 ln 10 */
          { *ansp = BADVAL;
            return 16;
          }
       *ansp = floor(0.5 + exp(arg));
       return 0;
     }
  else
     { arg = gammln(x+1.0) - gammln(y+1.0) - gammln(x-y+1.0);
       if(arg >= 709)   /* 308 ln 10 */
          { *ansp = BADVAL;
            return 16;
          }
       *ansp = exp(arg);
       return 0;
     }
}
/*______________________________________________________________*/
double gammln(double xx)
/* computes ln of the gamma function for arguments > 1 */
{ double x,tmp,ser;
  static double cof[6]={76.18009173,-86.50532033,24.01409822,
                -1.231739516,0.120858003e-2,-0.536382e-5};
  int j;
  x=xx-1.0;
  tmp=x+5.5;
  tmp -= (x+0.5)*log(tmp);
  ser=1.0;
  for (j=0;j<=5;j++)
     { x += 1.0;
       ser += cof[j]/x;
     }
  return -tmp+log(2.50662827465*ser);
}
/*_____________________________________________________________*/
int gamma2 (double x, double *ansp)
{ long k;
  double y;
  if( x > 1.0)
     { *ansp = exp(gammln(x));
       return 0;
     }
  if(nearint(x,&k) && k==1)
     { *ansp = 1.0;
       return 0;
     }
      /* and now for x<1 : Gamma(x) = �x/(Gamma(2-x)sin(�x))
                                   or �/(Gamma(1-x)sin(�x))
             (p. 167 Numerical Recipes)  */
  y = sin(PI_DECIMAL*x);
  if(nearint(y,&k) && k==0)
     { *ansp = BADVAL;
       return 26;
     }
  if(x > 0.0)
     *ansp = (1.0-x) * PI_DECIMAL * exp(- gammln(2.0-x))/y;
  else /* x < 0.0 */
     *ansp = PI_DECIMAL * exp(- gammln(1.0-x))/y;
  return 0;
}