00001 #include <math.h>
00002 #include "special_func.h"
00003 #include <iostream>
00004 #include <complex>
00005
00006 using namespace std;
00007
00008
00009
00010
00011
00012
00013
00014
00015 double_complex Gamma(double_complex z)
00016 {
00017 const double PI=4.0*atan(1.0);
00018 int l,k;
00019 double_complex u,v,h,s,fk,cdgamma;
00020 static double g[16]={
00021 41.624436916439068e0,-51.224241022374774e0,
00022 +11.338755813488977e0,-0.747732687772388e0,
00023 +0.008782877493061e0, -0.000001899030264e0,
00024 +0.000000001946335e0, -0.000000000199345e0,
00025 +0.000000000008433e0, +0.000000000001486e0,
00026 -0.000000000000806e0, +0.000000000000293e0,
00027 -0.000000000000102e0, +0.000000000000037e0,
00028 -0.000000000000014e0, +0.000000000000006e0
00029 };
00030 double x;
00031
00032 u=z;
00033 while(true) {
00034 x=u.real();
00035
00036 if ( x >= 1.) {
00037 v=u;
00038 l=3;
00039 } else if (x >= 0. ) {
00040 v=u+1.0;
00041 l=2;
00042 } else {
00043 v=1.0-u;
00044 l=1;
00045 }
00046
00047 h=double_complex(1.0,0.);
00048 s=g[0];
00049 for (k = 2; k <= 16; k++) {
00050 fk=k-2.0;
00051 h=((v-(fk+1.0))/(v+fk))*h;
00052 s=s+g[k-1]*h;
00053 }
00054 h=v+4.5;
00055 cdgamma=2.506628274631001*exp((v-0.5)*log(h)-h)*s;
00056
00057 if (l < 0) {
00058 return PI/(sin(PI*u)*cdgamma);
00059 } else if (l == 0) {
00060 return cdgamma/u;
00061 } else {
00062 return cdgamma;
00063 }
00064
00065
00066 u=z+1.0;
00067 }
00068
00069 }
00070
00071
00072
00073
00074
00075
00076 double LnGamma(double xx)
00077 {
00078 double x,y,tmp,ser;
00079 static double cof[6]={76.18009172947146,-86.50532032941677,
00080 24.01409824083091,-1.231739572450155,
00081 0.1208650973866179e-2,-0.5395239384953e-5};
00082 int j;
00083
00084 y=x=xx;
00085 tmp=x+5.5;
00086 tmp -= (x+0.5)*log(tmp);
00087 ser=1.000000000190015;
00088 for (j=0;j<=5;j++) ser += cof[j]/++y;
00089 return -tmp+log(2.5066282746310005*ser/x);
00090 }
00091
00092
00093
00094
00095
00096 double Gamma(double xx)
00097 {
00098 return exp(LnGamma(xx));
00099 }
00100
00101
00102
00103
00104
00105 double Factorial(int n)
00106 {
00107 static int ntop=4;
00108 static double answertable[33]={1.0,1.0,2.0,6.0,24.0};
00109 int i;
00110
00111 if (n<0) {cerr << "Negative factorial in function Factorial!"<<endl;}
00112 if (n>32) return Gamma((double)n+1.0);
00113 while (ntop<n) {
00114 i=ntop++;
00115 answertable[ntop]=answertable[i]*ntop;
00116 }
00117 return answertable[n];
00118 }
00119
00120
00121
00122
00123
00124 double BinomialCoeff(int n, int k)
00125 {
00126 return floor(0.5+exp(LnFactorial(n)-LnFactorial(k)-LnFactorial(n-k)));
00127 }
00128
00129
00130
00131
00132
00133 double LnFactorial(int n)
00134 {
00135 static double answertable[101];
00136
00137 if (n < 0) cerr<<"Negative factorial in function LnFactorial";
00138 if (n <= 1) return 0.0;
00139 if (n <= 100) return answertable[n] ? answertable[n] : (answertable[n]=LnGamma((double)n+1.0));
00140 else return LnGamma((double)n+1.0);
00141 }
00142
00143 void contfrac_IncGammaQ(double *gammcf, double a, double x, double *gln);
00144 void series_IncGammaP(double *gamser, double a, double x, double *gln);
00145
00146
00147
00148
00149
00150 double IncGammaP(double a, double x)
00151 {
00152 double gamser,gammcf,gln;
00153
00154 if (x < 0.0 || a <= 0.0) cerr<<"Invalid arguments in function IncGammaP"<<endl;
00155 if (x < (a+1.0)) {
00156 series_IncGammaP(&gamser,a,x,&gln);
00157 return gamser;
00158 } else {
00159 contfrac_IncGammaQ(&gammcf,a,x,&gln);
00160 return 1.0-gammcf;
00161 }
00162 }
00163
00164
00165
00166
00167
00168 double IncGammaQ(double a, double x)
00169 {
00170 double gamser,gammcf,gln;
00171
00172 if (x < 0.0 || a <= 0.0) cerr<<"Invalid arguments in routine IncGammaQ"<<endl;
00173 if (x < (a+1.0)) {
00174 series_IncGammaP(&gamser,a,x,&gln);
00175 return 1.0-gamser;
00176 } else {
00177 contfrac_IncGammaQ(&gammcf,a,x,&gln);
00178 return gammcf;
00179 }
00180 }
00181
00182
00183
00184
00185
00186 #define INCGAMP_ITMAX 100
00187 #define INCGAMP_EPS 3.0e-7
00188
00189 void series_IncGammaP(double *gamser, double a, double x, double *gln)
00190 {
00191 int n;
00192 double sum,del,ap;
00193
00194 *gln=LnGamma(a);
00195 if (x <= 0.0) {
00196 if (x < 0.0) cerr<<"x less than 0 in routine series_IncGammaP"<<endl;
00197 *gamser=0.0;
00198 return;
00199 } else {
00200 ap=a;
00201 del=sum=1.0/a;
00202 for (n=1;n<=INCGAMP_ITMAX;n++) {
00203 ++ap;
00204 del *= x/ap;
00205 sum += del;
00206 if (fabs(del) < fabs(sum)*INCGAMP_EPS) {
00207 *gamser=sum*exp(-x+a*log(x)-(*gln));
00208 return;
00209 }
00210 }
00211 cerr<<"a too large, INCGAMP_ITMAX too small in routine series_IncGammaP"<<endl;
00212 return;
00213 }
00214 }
00215 #undef INCGAMP_ITMAX
00216 #undef INCGAMP_EPS
00217
00218
00219
00220
00221
00222 #define INCGAMQ_ITMAX 100
00223 #define INCGAMQ_EPS 3.0e-7
00224 #define INCGAMQ_FPMIN 1.0e-30
00225
00226 void contfrac_IncGammaQ(double *gammcf, double a, double x, double *gln)
00227 {
00228 int i;
00229 double an,b,c,d,del,h;
00230
00231 *gln=LnGamma(a);
00232 b=x+1.0-a;
00233 c=1.0/INCGAMQ_FPMIN;
00234 d=1.0/b;
00235 h=d;
00236 for (i=1;i<=INCGAMQ_ITMAX;i++) {
00237 an = -i*(i-a);
00238 b += 2.0;
00239 d=an*d+b;
00240 if (fabs(d) < INCGAMQ_FPMIN) d=INCGAMQ_FPMIN;
00241 c=b+an/c;
00242 if (fabs(c) < INCGAMQ_FPMIN) c=INCGAMQ_FPMIN;
00243 d=1.0/d;
00244 del=d*c;
00245 h *= del;
00246 if (fabs(del-1.0) < INCGAMQ_EPS) break;
00247 }
00248 if (i > INCGAMQ_ITMAX) cerr<<"a too large, INCGAMQ_ITMAX too small in contfrac_IncGammaQ"<<endl;
00249 *gammcf=exp(-x+a*log(x)-(*gln))*h;
00250 }
00251 #undef INCGAMQ_ITMAX
00252 #undef INCGAMQ_EPS
00253 #undef INCGAMQ_FPMIN