Main Page Alphabetical List Data Structures File List Data Fields Globals Search

nifti_stats.c File Reference

#include "nifti1.h"
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <ctype.h>
#include <string.h>

Go to the source code of this file.


Data Structures
struct	pqpair
Defines
#define	hln2pi 0.91893853320467274178e0
#define	tol (1.0e-8)
#define	atol (1.0e-50)
#define	zero (1.0e-300)
#define	inf 1.0e300
#define	one 1.0e0
#define	atol (1.0e-50)
#define	tol (1.0e-8)
#define	zero (1.0e-300)
#define	inf 1.0e300
#define	one 1.0e0
#define	tol (1.0e-8)
#define	atol (1.0e-50)
#define	zero (1.0e-300)
#define	inf 1.0e300
#define	tent4 1.0e4
#define	tol (1.0e-8)
#define	atol (1.0e-50)
#define	zero (1.0e-300)
#define	one (1.0e0-1.0e-16)
#define	inf 1.0e300
#define	tol (1.0e-8)
#define	atol (1.0e-50)
#define	zero (1.0e-300)
#define	inf 1.0e300
#define	tent4 1.0e4
#define	tol (1.0e-8)
#define	atol (1.0e-50)
#define	zero (1.0e-300)
#define	one (1.0e0-1.0e-16)
#define	inf 1.0e300
#define	tol (1.0e-8)
#define	atol (1.0e-50)
#define	zero (1.0e-300)
#define	inf 1.0e300
#define	tol (1.0e-8)
#define	atol (1.0e-50)
#define	inf 1.0e300
#define	one 1.0e0
#define	tol (1.0e-8)
#define	atol (1.0e-50)
#define	inf 1.0e300
#define	tol (1.0e-8)
#define	atol (1.0e-50)
#define	zero (1.0e-300)
#define	inf 1.0e300
#define	maxdf 1.0e10
#define	dg(i) (df+2.0e0(double)(i))
#define	qsmall(xx) (int)(sum < 1.0e-20 \|\| (xx) < eps*sum)
#define	qtired(i) (int)((i) > ntired)
#define	half 0.5e0
#define	done 1.0e0
#define	qsmall(x) (int)(sum < 1.0e-20 \|\| (x) < eps*sum)
#define	half 0.5e0
#define	done 1.0e0
#define	maxit 100
#define	eps (1.0e-13)
#define	r2pi 0.3989422804014326e0
#define	nhalf (-0.5e0)
#define	dennor(x) (r2piexp(nhalf(x)*(x)))
#define	qxmon(zx, zy, zz) (int)((zx) <= (zy) && (zy) <= (zz))
#define	dlsqpi 0.91893853320467274177e0
#define	hln2pi 0.91893853320467274178e0
#define	ncoef 10
#define	ftol(zx) (0.5e0fifdmax1(abstol,reltolfabs((zx))))
#define	BIGG 9.99e+37
Functions
double	algdiv (double , double )
double	alngam (double *)
double	alnrel (double *)
double	apser (double , double , double , double )
double	basym (double , double , double , double )
double	bcorr (double , double )
double	betaln (double , double )
double	bfrac (double , double , double , double , double , double )
void	bgrat (double , double , double , double , double , double , int *i)
double	bpser (double , double , double , double )
void	bratio (double , double , double , double , double , double , int *)
double	brcmp1 (int , double , double , double , double *)
double	brcomp (double , double , double , double )
double	bup (double , double , double , double , int , double )
void	cdfbet (int , double , double , double , double , double , double , int , double *)
void	cdfbin (int , double , double , double , double , double , double , int , double *)
void	cdfchi (int , double , double , double , double , int , double *)
void	cdfchn (int , double , double , double , double , double , int , double )
void	cdff (int , double , double , double , double , double , int , double )
void	cdffnc (int , double , double , double , double , double , double , int s, double *)
void	cdfgam (int , double , double , double , double , double , int , double )
void	cdfnbn (int , double , double , double , double , double , double , int , double *)
void	cdfnor (int , double , double , double , double , double , int , double )
void	cdfpoi (int , double , double , double , double , int , double *)
void	cdft (int , double , double , double , double , int , double *)
void	cumbet (double , double , double , double , double , double )
void	cumbin (double , double , double , double , double , double )
void	cumchi (double , double , double , double )
void	cumchn (double , double , double , double , double *)
void	cumf (double , double , double , double , double *)
void	cumfnc (double , double , double , double , double , double )
void	cumgam (double , double , double , double )
void	cumnbn (double , double , double , double , double , double )
void	cumnor (double , double , double *)
void	cumpoi (double , double , double , double )
void	cumt (double , double , double , double )
double	dbetrm (double , double )
double	devlpl (double[], int , double )
double	dexpm1 (double *)
double	dinvnr (double p, double q)
void	E0000 (int, int , double , double , unsigned long , unsigned long , double , double , double , double , double , double , double )
void	dinvr (int , double , double , unsigned long , unsigned long *)
void	dstinv (double , double , double , double , double , double , double *)
double	dlanor (double *)
double	dln1mx (double *)
double	dln1px (double *)
double	dlnbet (double , double )
double	dlngam (double *)
double	dstrem (double *)
double	dt1 (double , double , double *)
void	E0001 (int, int , double , double , double , double , unsigned long , unsigned long , double , double , double , double *)
void	dzror (int , double , double , double , double , unsigned long , unsigned long *)
void	dstzr (double zxlo, double zxhi, double zabstl, double zreltl)
double	erf1 (double *)
double	erfc1 (int , double )
double	esum (int , double )
double	exparg (int *)
double	fpser (double , double , double , double )
double	gam1 (double *)
void	gaminv (double , double , double , double , double , int )
double	gamln (double *)
double	gamln1 (double *)
double	Xgamm (double *)
void	grat1 (double , double , double , double , double , double )
void	gratio (double , double , double , double , int *)
double	gsumln (double , double )
double	psi (double *)
double	rcomp (double , double )
double	rexp (double *)
double	rlog (double *)
double	rlog1 (double *)
double	spmpar (int *)
double	stvaln (double *)
double	fifdint (double)
double	fifdmax1 (double, double)
double	fifdmin1 (double, double)
double	fifdsign (double, double)
long	fifidint (double)
long	fifmod (long, long)
void	ftnstop (char *)
int	ipmpar (int *)
double	fstat_pq2s (pqpair pq, double dofnum, double dofden)
pqpair	fstat_s2pq (double ff, double dofnum, double dofden)
double	fnonc_pq2s (pqpair pq, double dofnum, double dofden, double nonc)
pqpair	fnonc_s2pq (double ff, double dofnum, double dofden, double nonc)
pqpair	normal_s2pq (double zz)
double	normal_pq2s (pqpair pq)
pqpair	chisq_s2pq (double xx, double dof)
double	chisq_pq2s (pqpair pq, double dof)
pqpair	chsqnonc_s2pq (double xx, double dof, double nonc)
double	chsqnonc_pq2s (pqpair pq, double dof, double nonc)
pqpair	beta_s2pq (double xx, double aa, double bb)
double	beta_pq2s (pqpair pq, double aa, double bb)
pqpair	binomial_s2pq (double ss, double ntrial, double ptrial)
double	binomial_pq2s (pqpair pq, double ntrial, double ptrial)
pqpair	gamma_s2pq (double xx, double sh, double sc)
double	gamma_pq2s (pqpair pq, double sh, double sc)
pqpair	poisson_s2pq (double xx, double lambda)
double	poisson_pq2s (pqpair pq, double lambda)
pqpair	student_s2pq (double xx, double dof)
double	student_pq2s (pqpair pq, double dof)
pqpair	correl_s2pq (double rr, double dof)
double	correl_pq2s (pqpair pq, double dof)
pqpair	uniform_s2pq (double xx)
double	uniform_pq2s (pqpair pq)
pqpair	logistic_s2pq (double xx)
double	logistic_pq2s (pqpair pq)
pqpair	laplace_s2pq (double xx)
double	laplace_pq2s (pqpair pq)
double	alng (double x)
double	gaudf (double x)
double	betadf (double x, double p, double q)
pqpair	tnonc_s2pq (double t, double df, double delta)
double	tnonc_pq2s (pqpair pq, double dof, double nonc)
pqpair	chi_s2pq (double xx, double dof)
double	chi_pq2s (pqpair pq, double dof)
pqpair	extval1_s2pq (double x)
double	extval1_pq2s (pqpair pq)
pqpair	weibull_s2pq (double x, double c)
double	weibull_pq2s (pqpair pq, double c)
pqpair	invgauss_s2pq (double x, double c)
double	invgauss_pq2s (pqpair pq, double c)
pqpair	stat2pq (double val, int code, double p1, double p2, double p3)
double	pq2stat (pqpair pq, int code, double p1, double p2, double p3)
int	nifti_intent_code (char *name)
double	nifti_stat2cdf (double val, int code, double p1, double p2, double p3)
double	nifti_stat2rcdf (double val, int code, double p1, double p2, double p3)
double	nifti_cdf2stat (double p, int code, double p1, double p2, double p3)
double	nifti_rcdf2stat (double q, int code, double p1, double p2, double p3)
double	nifti_stat2zscore (double val, int code, double p1, double p2, double p3)
double	nifti_stat2hzscore (double val, int code, double p1, double p2, double p3)
int	main (int argc, char *argv[])
Variables
char *	inam []

Define Documentation

#define atol (1.0e-50)

#define BIGG 9.99e+37

Definition at line 9935 of file nifti_stats.c.

Referenced by chi_pq2s(), chisq_pq2s(), chsqnonc_pq2s(), extval1_pq2s(), fnonc_pq2s(), fstat_pq2s(), gamma_pq2s(), invgauss_pq2s(), laplace_pq2s(), logistic_pq2s(), normal_pq2s(), pq2stat(), tnonc_pq2s(), and weibull_pq2s().

#define dennor

(

)

(r2pi*exp(nhalf*(x)*(x)))

#define dg

(

)

(*df+2.0e0*(double)(i))

#define dlsqpi 0.91893853320467274177e0

#define done 1.0e0

#define eps (1.0e-13)

#define ftol

(

)

(0.5e0*fifdmax1(abstol,reltol*fabs((zx))))

#define half 0.5e0

#define hln2pi 0.91893853320467274178e0

#define inf 1.0e300

#define maxdf 1.0e10

#define maxit 100

#define ncoef 10

#define nhalf (-0.5e0)

#define one 1.0e0

#define one (1.0e0-1.0e-16)

#define one 1.0e0

#define qsmall

(

)

(int)(sum < 1.0e-20 || (x) < eps*sum)

#define qsmall

(

)

(int)(sum < 1.0e-20 || (xx) < eps*sum)

#define qtired

(

)

(int)((i) > ntired)

#define qxmon	(	zx,
		zy,
		zz	)	(int)((zx) <= (zy) && (zy) <= (zz))

#define r2pi 0.3989422804014326e0

#define tent4 1.0e4

#define tol (1.0e-8)

#define zero (1.0e-300)

Function Documentation

double algdiv	(	double *	,
		double *
	)	`[static]`

Prototypes for cdflib functions *

Definition at line 140 of file nifti_stats.c.

References a, algdiv(), alnrel(), c, v, and x2.

Referenced by algdiv(), betaln(), bgrat(), bpser(), brcmp1(), brcomp(), and dlnbet().

00153 {
00154 static double c0 = .833333333333333e-01;
00155 static double c1 = -.277777777760991e-02;
00156 static double c2 = .793650666825390e-03;
00157 static double c3 = -.595202931351870e-03;
00158 static double c4 = .837308034031215e-03;
00159 static double c5 = -.165322962780713e-02;
00160 static double algdiv,c,d,h,s11,s3,s5,s7,s9,t,u,v,w,x,x2,T1;
00161 /*
00162      ..
00163      .. Executable Statements ..
00164 */
00165     if(*a <= *b) goto S10;
00166     h = *b/ *a;
00167     c = 1.0e0/(1.0e0+h);
00168     x = h/(1.0e0+h);
00169     d = *a+(*b-0.5e0);
00170     goto S20;
00171 S10:
00172     h = *a/ *b;
00173     c = h/(1.0e0+h);
00174     x = 1.0e0/(1.0e0+h);
00175     d = *b+(*a-0.5e0);
00176 S20:
00177 /*
00178                 SET SN = (1 - X**N)/(1 - X)
00179 */
00180     x2 = x*x;
00181     s3 = 1.0e0+(x+x2);
00182     s5 = 1.0e0+(x+x2*s3);
00183     s7 = 1.0e0+(x+x2*s5);
00184     s9 = 1.0e0+(x+x2*s7);
00185     s11 = 1.0e0+(x+x2*s9);
00186 /*
00187                 SET W = DEL(B) - DEL(A + B)
00188 */
00189     t = pow(1.0e0/ *b,2.0);
00190     w = ((((c5*s11*t+c4*s9)*t+c3*s7)*t+c2*s5)*t+c1*s3)*t+c0;
00191     w *= (c/ *b);
00192 /*
00193                     COMBINE THE RESULTS
00194 */
00195     T1 = *a/ *b;
00196     u = d*alnrel(&T1);
00197     v = *a*(log(*b)-1.0e0);
00198     if(u <= v) goto S30;
00199     algdiv = w-v-u;
00200     return algdiv;
00201 S30:
00202     algdiv = w-u-v;
00203     return algdiv;
00204 } /* END */

double alng ( double x ) [static]

Definition at line 10444 of file nifti_stats.c.

References alngam().

10445 {
10446   double xx=x ; return alngam( &xx ) ;
10447 }

double alngam ( double * ) [static]

Definition at line 207 of file nifti_stats.c.

References alngam(), devlpl(), fifidint(), i, and offset.

Referenced by alng(), alngam(), cumchn(), and cumfnc().

00241 {
00242 #define hln2pi 0.91893853320467274178e0
00243 static double coef[5] = {
00244     0.83333333333333023564e-1,-0.27777777768818808e-2,0.79365006754279e-3,
00245     -0.594997310889e-3,0.8065880899e-3
00246 };
00247 static double scoefd[4] = {
00248     0.62003838007126989331e2,0.9822521104713994894e1,-0.8906016659497461257e1,
00249     0.1000000000000000000e1
00250 };
00251 static double scoefn[9] = {
00252     0.62003838007127258804e2,0.36036772530024836321e2,0.20782472531792126786e2,
00253     0.6338067999387272343e1,0.215994312846059073e1,0.3980671310203570498e0,
00254     0.1093115956710439502e0,0.92381945590275995e-2,0.29737866448101651e-2
00255 };
00256 static int K1 = 9;
00257 static int K3 = 4;
00258 static int K5 = 5;
00259 static double alngam,offset,prod,xx;
00260 static int i,n;
00261 static double T2,T4,T6;
00262 /*
00263      ..
00264      .. Executable Statements ..
00265 */
00266     if(!(*x <= 6.0e0)) goto S70;
00267     prod = 1.0e0;
00268     xx = *x;
00269     if(!(*x > 3.0e0)) goto S30;
00270 S10:
00271     if(!(xx > 3.0e0)) goto S20;
00272     xx -= 1.0e0;
00273     prod *= xx;
00274     goto S10;
00275 S30:
00276 S20:
00277     if(!(*x < 2.0e0)) goto S60;
00278 S40:
00279     if(!(xx < 2.0e0)) goto S50;
00280     prod /= xx;
00281     xx += 1.0e0;
00282     goto S40;
00283 S60:
00284 S50:
00285     T2 = xx-2.0e0;
00286     T4 = xx-2.0e0;
00287     alngam = devlpl(scoefn,&K1,&T2)/devlpl(scoefd,&K3,&T4);
00288 /*
00289      COMPUTE RATIONAL APPROXIMATION TO GAMMA(X)
00290 */
00291     alngam *= prod;
00292     alngam = log(alngam);
00293     goto S110;
00294 S70:
00295     offset = hln2pi;
00296 /*
00297      IF NECESSARY MAKE X AT LEAST 12 AND CARRY CORRECTION IN OFFSET
00298 */
00299     n = fifidint(12.0e0-*x);
00300     if(!(n > 0)) goto S90;
00301     prod = 1.0e0;
00302     for(i=1; i<=n; i++) prod *= (*x+(double)(i-1));
00303     offset -= log(prod);
00304     xx = *x+(double)n;
00305     goto S100;
00306 S90:
00307     xx = *x;
00308 S100:
00309 /*
00310      COMPUTE POWER SERIES
00311 */
00312     T6 = 1.0e0/pow(xx,2.0);
00313     alngam = devlpl(coef,&K5,&T6)/xx;
00314     alngam += (offset+(xx-0.5e0)*log(xx)-xx);
00315 S110:
00316     return alngam;
00317 #undef hln2pi
00318 } /* END */

double alnrel ( double * ) [static]

Definition at line 321 of file nifti_stats.c.

References a, and alnrel().

Referenced by algdiv(), alnrel(), betaln(), bgrat(), brcmp1(), brcomp(), dlnbet(), gaminv(), and gsumln().

00327 {
00328 static double p1 = -.129418923021993e+01;
00329 static double p2 = .405303492862024e+00;
00330 static double p3 = -.178874546012214e-01;
00331 static double q1 = -.162752256355323e+01;
00332 static double q2 = .747811014037616e+00;
00333 static double q3 = -.845104217945565e-01;
00334 static double alnrel,t,t2,w,x;
00335 /*
00336      ..
00337      .. Executable Statements ..
00338 */
00339     if(fabs(*a) > 0.375e0) goto S10;
00340     t = *a/(*a+2.0e0);
00341     t2 = t*t;
00342     w = (((p3*t2+p2)*t2+p1)*t2+1.0e0)/(((q3*t2+q2)*t2+q1)*t2+1.0e0);
00343     alnrel = 2.0e0*t*w;
00344     return alnrel;
00345 S10:
00346     x = 1.e0+*a;
00347     alnrel = log(x);
00348     return alnrel;
00349 } /* END */

double apser	(	double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 352 of file nifti_stats.c.

References a, apser(), c, and psi().

Referenced by apser(), and bratio().

00360 {
00361 static double g = .577215664901533e0;
00362 static double apser,aj,bx,c,j,s,t,tol;
00363 /*
00364      ..
00365      .. Executable Statements ..
00366 */
00367     bx = *b**x;
00368     t = *x-bx;
00369     if(*b**eps > 2.e-2) goto S10;
00370     c = log(*x)+psi(b)+g+t;
00371     goto S20;
00372 S10:
00373     c = log(bx)+g+t;
00374 S20:
00375     tol = 5.0e0**eps*fabs(c);
00376     j = 1.0e0;
00377     s = 0.0e0;
00378 S30:
00379     j += 1.0e0;
00380     t *= (*x-bx/j);
00381     aj = t/j;
00382     s += aj;
00383     if(fabs(aj) > tol) goto S30;
00384     apser = -(*a*(c+s));
00385     return apser;
00386 } /* END */

double basym	(	double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 389 of file nifti_stats.c.

References a, basym(), bcorr(), c, erfc1(), i, r, rlog1(), z0, and zn.

Referenced by basym(), and bratio().

00398 {
00399 static double e0 = 1.12837916709551e0;
00400 static double e1 = .353553390593274e0;
00401 static int num = 20;
00402 /*
00403 ------------------------
00404      ****** NUM IS THE MAXIMUM VALUE THAT N CAN TAKE IN THE DO LOOP
00405             ENDING AT STATEMENT 50. IT IS REQUIRED THAT NUM BE EVEN.
00406             THE ARRAYS A0, B0, C, D HAVE DIMENSION NUM + 1.
00407 ------------------------
00408      E0 = 2/SQRT(PI)
00409      E1 = 2**(-3/2)
00410 ------------------------
00411 */
00412 static int K3 = 1;
00413 static double basym,bsum,dsum,f,h,h2,hn,j0,j1,r,r0,r1,s,sum,t,t0,t1,u,w,w0,z,z0,
00414     z2,zn,znm1;
00415 static int i,im1,imj,j,m,mm1,mmj,n,np1;
00416 static double a0[21],b0[21],c[21],d[21],T1,T2;
00417 /*
00418      ..
00419      .. Executable Statements ..
00420 */
00421     basym = 0.0e0;
00422     if(*a >= *b) goto S10;
00423     h = *a/ *b;
00424     r0 = 1.0e0/(1.0e0+h);
00425     r1 = (*b-*a)/ *b;
00426     w0 = 1.0e0/sqrt(*a*(1.0e0+h));
00427     goto S20;
00428 S10:
00429     h = *b/ *a;
00430     r0 = 1.0e0/(1.0e0+h);
00431     r1 = (*b-*a)/ *a;
00432     w0 = 1.0e0/sqrt(*b*(1.0e0+h));
00433 S20:
00434     T1 = -(*lambda/ *a);
00435     T2 = *lambda/ *b;
00436     f = *a*rlog1(&T1)+*b*rlog1(&T2);
00437     t = exp(-f);
00438     if(t == 0.0e0) return basym;
00439     z0 = sqrt(f);
00440     z = 0.5e0*(z0/e1);
00441     z2 = f+f;
00442     a0[0] = 2.0e0/3.0e0*r1;
00443     c[0] = -(0.5e0*a0[0]);
00444     d[0] = -c[0];
00445     j0 = 0.5e0/e0*erfc1(&K3,&z0);
00446     j1 = e1;
00447     sum = j0+d[0]*w0*j1;
00448     s = 1.0e0;
00449     h2 = h*h;
00450     hn = 1.0e0;
00451     w = w0;
00452     znm1 = z;
00453     zn = z2;
00454     for(n=2; n<=num; n+=2) {
00455         hn = h2*hn;
00456         a0[n-1] = 2.0e0*r0*(1.0e0+h*hn)/((double)n+2.0e0);
00457         np1 = n+1;
00458         s += hn;
00459         a0[np1-1] = 2.0e0*r1*s/((double)n+3.0e0);
00460         for(i=n; i<=np1; i++) {
00461             r = -(0.5e0*((double)i+1.0e0));
00462             b0[0] = r*a0[0];
00463             for(m=2; m<=i; m++) {
00464                 bsum = 0.0e0;
00465                 mm1 = m-1;
00466                 for(j=1; j<=mm1; j++) {
00467                     mmj = m-j;
00468                     bsum += (((double)j*r-(double)mmj)*a0[j-1]*b0[mmj-1]);
00469                 }
00470                 b0[m-1] = r*a0[m-1]+bsum/(double)m;
00471             }
00472             c[i-1] = b0[i-1]/((double)i+1.0e0);
00473             dsum = 0.0e0;
00474             im1 = i-1;
00475             for(j=1; j<=im1; j++) {
00476                 imj = i-j;
00477                 dsum += (d[imj-1]*c[j-1]);
00478             }
00479             d[i-1] = -(dsum+c[i-1]);
00480         }
00481         j0 = e1*znm1+((double)n-1.0e0)*j0;
00482         j1 = e1*zn+(double)n*j1;
00483         znm1 = z2*znm1;
00484         zn = z2*zn;
00485         w = w0*w;
00486         t0 = d[n-1]*w*j0;
00487         w = w0*w;
00488         t1 = d[np1-1]*w*j1;
00489         sum += (t0+t1);
00490         if(fabs(t0)+fabs(t1) <= *eps*sum) goto S80;
00491     }
00492 S80:
00493     u = exp(-bcorr(a,b));
00494     basym = e0*t*u*sum;
00495     return basym;
00496 } /* END */

double bcorr	(	double *	,
		double *
	)	`[static]`

Definition at line 499 of file nifti_stats.c.

References a, bcorr(), c, fifdmax1(), fifdmin1(), and x2.

Referenced by basym(), bcorr(), betaln(), brcmp1(), brcomp(), and dlnbet().

00509 {
00510 static double c0 = .833333333333333e-01;
00511 static double c1 = -.277777777760991e-02;
00512 static double c2 = .793650666825390e-03;
00513 static double c3 = -.595202931351870e-03;
00514 static double c4 = .837308034031215e-03;
00515 static double c5 = -.165322962780713e-02;
00516 static double bcorr,a,b,c,h,s11,s3,s5,s7,s9,t,w,x,x2;
00517 /*
00518      ..
00519      .. Executable Statements ..
00520 */
00521     a = fifdmin1(*a0,*b0);
00522     b = fifdmax1(*a0,*b0);
00523     h = a/b;
00524     c = h/(1.0e0+h);
00525     x = 1.0e0/(1.0e0+h);
00526     x2 = x*x;
00527 /*
00528                 SET SN = (1 - X**N)/(1 - X)
00529 */
00530     s3 = 1.0e0+(x+x2);
00531     s5 = 1.0e0+(x+x2*s3);
00532     s7 = 1.0e0+(x+x2*s5);
00533     s9 = 1.0e0+(x+x2*s7);
00534     s11 = 1.0e0+(x+x2*s9);
00535 /*
00536                 SET W = DEL(B) - DEL(A + B)
00537 */
00538     t = pow(1.0e0/b,2.0);
00539     w = ((((c5*s11*t+c4*s9)*t+c3*s7)*t+c2*s5)*t+c1*s3)*t+c0;
00540     w *= (c/b);
00541 /*
00542                    COMPUTE  DEL(A) + W
00543 */
00544     t = pow(1.0e0/a,2.0);
00545     bcorr = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/a+w;
00546     return bcorr;
00547 } /* END */

double beta_pq2s	(	pqpair	pq,
		double	aa,
		double	bb
	)	`[static]`

Definition at line 10146 of file nifti_stats.c.

References a, cdfbet(), pqpair::p, p, and pqpair::q.

Referenced by correl_pq2s(), and pq2stat().

10147 {
10148    int which , status ;
10149    double p,q,x,y,a,b,bound ;
10150 
10151    which  = 2 ;
10152    p      = pq.p ; if( p <= 0.0 ) return 0.0 ;
10153    q      = pq.q ; if( q <= 0.0 ) return 1.0 ;
10154    x      = 0.0 ;
10155    y      = 1.0 ;
10156    a      = aa ;
10157    b      = bb ;
10158 
10159    cdfbet( &which , &p , &q , &x , &y , &a , &b ,  &status , &bound ) ;
10160    return x ;
10161 }

pqpair beta_s2pq	(	double	xx,
		double	aa,
		double	bb
	)	`[static]`

Definition at line 10126 of file nifti_stats.c.

References a, cdfbet(), pqpair::p, p, and pqpair::q.

Referenced by correl_s2pq(), and stat2pq().

10127 {
10128    int which , status ;
10129    double p,q,x,y,a,b,bound ;
10130    pqpair pq={0.0,1.0} ;
10131 
10132    which  = 1 ;
10133    p      = 0.0 ;
10134    q      = 1.0 ;
10135    x      = xx ;       if( x <= 0.0 ) return pq ;
10136    y      = 1.0 - xx ; if( y <= 0.0 ){ pq.p=1.0; pq.q=0.0; return pq; }
10137    a      = aa ;       if( a <  0.0 ) return pq ;
10138    b      = bb ;       if( b <  0.0 ) return pq ;
10139 
10140    cdfbet( &which , &p , &q , &x , &y , &a , &b ,  &status , &bound ) ;
10141    pq.p = p ; pq.q = q ; return pq ;
10142 }

double betadf	(	double	x,
		double	p,
		double	q
	)	`[static]`

Definition at line 10538 of file nifti_stats.c.

References cumbet(), and p.

Referenced by tnonc_s2p(), and tnonc_s2pq().

10539 {
10540    double xx=x,yy=1.0-x , aa=p,bb=q , pp,qq ;
10541    cumbet( &xx,&yy , &aa,&bb , &pp,&qq ) ; return pp ;
10542 }

double betaln	(	double *	,
		double *
	)	`[static]`

Definition at line 550 of file nifti_stats.c.

References a, algdiv(), alnrel(), bcorr(), betaln(), c, fifdmax1(), fifdmin1(), gamln(), gsumln(), i, and v.

Referenced by betaln(), bpser(), brcmp1(), and brcomp().

00558 {
00559 static double e = .918938533204673e0;
00560 static double betaln,a,b,c,h,u,v,w,z;
00561 static int i,n;
00562 static double T1;
00563 /*
00564      ..
00565      .. Executable Statements ..
00566 */
00567     a = fifdmin1(*a0,*b0);
00568     b = fifdmax1(*a0,*b0);
00569     if(a >= 8.0e0) goto S100;
00570     if(a >= 1.0e0) goto S20;
00571 /*
00572 -----------------------------------------------------------------------
00573                    PROCEDURE WHEN A .LT. 1
00574 -----------------------------------------------------------------------
00575 */
00576     if(b >= 8.0e0) goto S10;
00577     T1 = a+b;
00578     betaln = gamln(&a)+(gamln(&b)-gamln(&T1));
00579     return betaln;
00580 S10:
00581     betaln = gamln(&a)+algdiv(&a,&b);
00582     return betaln;
00583 S20:
00584 /*
00585 -----------------------------------------------------------------------
00586                 PROCEDURE WHEN 1 .LE. A .LT. 8
00587 -----------------------------------------------------------------------
00588 */
00589     if(a > 2.0e0) goto S40;
00590     if(b > 2.0e0) goto S30;
00591     betaln = gamln(&a)+gamln(&b)-gsumln(&a,&b);
00592     return betaln;
00593 S30:
00594     w = 0.0e0;
00595     if(b < 8.0e0) goto S60;
00596     betaln = gamln(&a)+algdiv(&a,&b);
00597     return betaln;
00598 S40:
00599 /*
00600                 REDUCTION OF A WHEN B .LE. 1000
00601 */
00602     if(b > 1000.0e0) goto S80;
00603     n = a-1.0e0;
00604     w = 1.0e0;
00605     for(i=1; i<=n; i++) {
00606         a -= 1.0e0;
00607         h = a/b;
00608         w *= (h/(1.0e0+h));
00609     }
00610     w = log(w);
00611     if(b < 8.0e0) goto S60;
00612     betaln = w+gamln(&a)+algdiv(&a,&b);
00613     return betaln;
00614 S60:
00615 /*
00616                  REDUCTION OF B WHEN B .LT. 8
00617 */
00618     n = b-1.0e0;
00619     z = 1.0e0;
00620     for(i=1; i<=n; i++) {
00621         b -= 1.0e0;
00622         z *= (b/(a+b));
00623     }
00624     betaln = w+log(z)+(gamln(&a)+(gamln(&b)-gsumln(&a,&b)));
00625     return betaln;
00626 S80:
00627 /*
00628                 REDUCTION OF A WHEN B .GT. 1000
00629 */
00630     n = a-1.0e0;
00631     w = 1.0e0;
00632     for(i=1; i<=n; i++) {
00633         a -= 1.0e0;
00634         w *= (a/(1.0e0+a/b));
00635     }
00636     betaln = log(w)-(double)n*log(b)+(gamln(&a)+algdiv(&a,&b));
00637     return betaln;
00638 S100:
00639 /*
00640 -----------------------------------------------------------------------
00641                    PROCEDURE WHEN A .GE. 8
00642 -----------------------------------------------------------------------
00643 */
00644     w = bcorr(&a,&b);
00645     h = a/b;
00646     c = h/(1.0e0+h);
00647     u = -((a-0.5e0)*log(c));
00648     v = b*alnrel(&h);
00649     if(u <= v) goto S110;
00650     betaln = -(0.5e0*log(b))+e+w-v-u;
00651     return betaln;
00652 S110:
00653     betaln = -(0.5e0*log(b))+e+w-u-v;
00654     return betaln;
00655 } /* END */

double bfrac	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 658 of file nifti_stats.c.

References a, bfrac(), brcomp(), c, p, and r.

Referenced by bfrac(), and bratio().

00666 {
00667 static double bfrac,alpha,an,anp1,beta,bn,bnp1,c,c0,c1,e,n,p,r,r0,s,t,w,yp1;
00668 /*
00669      ..
00670      .. Executable Statements ..
00671 */
00672     bfrac = brcomp(a,b,x,y);
00673     if(bfrac == 0.0e0) return bfrac;
00674     c = 1.0e0+*lambda;
00675     c0 = *b/ *a;
00676     c1 = 1.0e0+1.0e0/ *a;
00677     yp1 = *y+1.0e0;
00678     n = 0.0e0;
00679     p = 1.0e0;
00680     s = *a+1.0e0;
00681     an = 0.0e0;
00682     bn = anp1 = 1.0e0;
00683     bnp1 = c/c1;
00684     r = c1/c;
00685 S10:
00686 /*
00687         CONTINUED FRACTION CALCULATION
00688 */
00689     n += 1.0e0;
00690     t = n/ *a;
00691     w = n*(*b-n)**x;
00692     e = *a/s;
00693     alpha = p*(p+c0)*e*e*(w**x);
00694     e = (1.0e0+t)/(c1+t+t);
00695     beta = n+w/s+e*(c+n*yp1);
00696     p = 1.0e0+t;
00697     s += 2.0e0;
00698 /*
00699         UPDATE AN, BN, ANP1, AND BNP1
00700 */
00701     t = alpha*an+beta*anp1;
00702     an = anp1;
00703     anp1 = t;
00704     t = alpha*bn+beta*bnp1;
00705     bn = bnp1;
00706     bnp1 = t;
00707     r0 = r;
00708     r = anp1/bnp1;
00709     if(fabs(r-r0) <= *eps*r) goto S20;
00710 /*
00711         RESCALE AN, BN, ANP1, AND BNP1
00712 */
00713     an /= bnp1;
00714     bn /= bnp1;
00715     anp1 = r;
00716     bnp1 = 1.0e0;
00717     goto S10;
00718 S20:
00719 /*
00720                  TERMINATION
00721 */
00722     bfrac *= r;
00723     return bfrac;
00724 } /* END */

void bgrat	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	i
	)	`[static]`

Definition at line 727 of file nifti_stats.c.

References a, algdiv(), alnrel(), c, gam1(), grat1(), i, l, n2, p, r, and v.

Referenced by bratio().

00737 {
00738 static double bm1,bp2n,cn,coef,dj,j,l,lnx,n2,nu,p,q,r,s,sum,t,t2,u,v,z;
00739 static int i,n,nm1;
00740 static double c[30],d[30],T1;
00741 /*
00742      ..
00743      .. Executable Statements ..
00744 */
00745     bm1 = *b-0.5e0-0.5e0;
00746     nu = *a+0.5e0*bm1;
00747     if(*y > 0.375e0) goto S10;
00748     T1 = -*y;
00749     lnx = alnrel(&T1);
00750     goto S20;
00751 S10:
00752     lnx = log(*x);
00753 S20:
00754     z = -(nu*lnx);
00755     if(*b*z == 0.0e0) goto S70;
00756 /*
00757                  COMPUTATION OF THE EXPANSION
00758                  SET R = EXP(-Z)*Z**B/GAMMA(B)
00759 */
00760     r = *b*(1.0e0+gam1(b))*exp(*b*log(z));
00761     r *= (exp(*a*lnx)*exp(0.5e0*bm1*lnx));
00762     u = algdiv(b,a)+*b*log(nu);
00763     u = r*exp(-u);
00764     if(u == 0.0e0) goto S70;
00765     grat1(b,&z,&r,&p,&q,eps);
00766     v = 0.25e0*pow(1.0e0/nu,2.0);
00767     t2 = 0.25e0*lnx*lnx;
00768     l = *w/u;
00769     j = q/r;
00770     sum = j;
00771     t = cn = 1.0e0;
00772     n2 = 0.0e0;
00773     for(n=1; n<=30; n++) {
00774         bp2n = *b+n2;
00775         j = (bp2n*(bp2n+1.0e0)*j+(z+bp2n+1.0e0)*t)*v;
00776         n2 += 2.0e0;
00777         t *= t2;
00778         cn /= (n2*(n2+1.0e0));
00779         c[n-1] = cn;
00780         s = 0.0e0;
00781         if(n == 1) goto S40;
00782         nm1 = n-1;
00783         coef = *b-(double)n;
00784         for(i=1; i<=nm1; i++) {
00785             s += (coef*c[i-1]*d[n-i-1]);
00786             coef += *b;
00787         }
00788 S40:
00789         d[n-1] = bm1*cn+s/(double)n;
00790         dj = d[n-1]*j;
00791         sum += dj;
00792         if(sum <= 0.0e0) goto S70;
00793         if(fabs(dj) <= *eps*(sum+l)) goto S60;
00794     }
00795 S60:
00796 /*
00797                     ADD THE RESULTS TO W
00798 */
00799     *ierr = 0;
00800     *w += (u*sum);
00801     return;
00802 S70:
00803 /*
00804                THE EXPANSION CANNOT BE COMPUTED
00805 */
00806     *ierr = 1;
00807     return;
00808 } /* END */

double binomial_pq2s	(	pqpair	pq,
		double	ntrial,
		double	ptrial
	)	`[static]`

Definition at line 10189 of file nifti_stats.c.

References cdfbin(), pqpair::p, p, pqpair::q, and xn.

Referenced by pq2stat().

10190 {
10191    int which , status ;
10192    double p,q, s,xn,pr,ompr,bound ;
10193 
10194    which  = 2 ;
10195    p      = pq.p ;
10196    q      = pq.q ;
10197    s      = 0.0 ;
10198    xn     = ntrial ;
10199    pr     = ptrial ;
10200    ompr   = 1.0 - ptrial ;
10201 
10202    cdfbin( &which , &p , &q , &s , &xn , &pr , &ompr , &status , &bound ) ;
10203    return s ;
10204 }

pqpair binomial_s2pq	(	double	ss,
		double	ntrial,
		double	ptrial
	)	`[static]`

Definition at line 10169 of file nifti_stats.c.

References cdfbin(), pqpair::p, p, pqpair::q, and xn.

Referenced by stat2pq().

10170 {
10171    int which , status ;
10172    double p,q, s,xn,pr,ompr,bound ;
10173    pqpair pq={0.0,1.0} ;
10174 
10175    which  = 1 ;
10176    p      = 0.0 ;
10177    q      = 1.0 ;
10178    s      = ss ;            if( s  <  0.0 ) return pq ;
10179    xn     = ntrial ;        if( xn <= 0.0 ) return pq ;
10180    pr     = ptrial ;        if( pr <  0.0 ) return pq ;
10181    ompr   = 1.0 - ptrial ;
10182 
10183    cdfbin( &which , &p , &q , &s , &xn , &pr , &ompr , &status , &bound ) ;
10184    pq.p = p ; pq.q = q ; return pq ;
10185 }

double bpser	(	double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 811 of file nifti_stats.c.

References a, algdiv(), betaln(), bpser(), c, fifdmax1(), fifdmin1(), gam1(), gamln1(), and i.

Referenced by bpser(), and bratio().

00818 {
00819 static double bpser,a0,apb,b0,c,n,sum,t,tol,u,w,z;
00820 static int i,m;
00821 /*
00822      ..
00823      .. Executable Statements ..
00824 */
00825     bpser = 0.0e0;
00826     if(*x == 0.0e0) return bpser;
00827 /*
00828 -----------------------------------------------------------------------
00829             COMPUTE THE FACTOR X**A/(A*BETA(A,B))
00830 -----------------------------------------------------------------------
00831 */
00832     a0 = fifdmin1(*a,*b);
00833     if(a0 < 1.0e0) goto S10;
00834     z = *a*log(*x)-betaln(a,b);
00835     bpser = exp(z)/ *a;
00836     goto S100;
00837 S10:
00838     b0 = fifdmax1(*a,*b);
00839     if(b0 >= 8.0e0) goto S90;
00840     if(b0 > 1.0e0) goto S40;
00841 /*
00842             PROCEDURE FOR A0 .LT. 1 AND B0 .LE. 1
00843 */
00844     bpser = pow(*x,*a);
00845     if(bpser == 0.0e0) return bpser;
00846     apb = *a+*b;
00847     if(apb > 1.0e0) goto S20;
00848     z = 1.0e0+gam1(&apb);
00849     goto S30;
00850 S20:
00851     u = *a+*b-1.e0;
00852     z = (1.0e0+gam1(&u))/apb;
00853 S30:
00854     c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z;
00855     bpser *= (c*(*b/apb));
00856     goto S100;
00857 S40:
00858 /*
00859          PROCEDURE FOR A0 .LT. 1 AND 1 .LT. B0 .LT. 8
00860 */
00861     u = gamln1(&a0);
00862     m = b0-1.0e0;
00863     if(m < 1) goto S60;
00864     c = 1.0e0;
00865     for(i=1; i<=m; i++) {
00866         b0 -= 1.0e0;
00867         c *= (b0/(a0+b0));
00868     }
00869     u = log(c)+u;
00870 S60:
00871     z = *a*log(*x)-u;
00872     b0 -= 1.0e0;
00873     apb = a0+b0;
00874     if(apb > 1.0e0) goto S70;
00875     t = 1.0e0+gam1(&apb);
00876     goto S80;
00877 S70:
00878     u = a0+b0-1.e0;
00879     t = (1.0e0+gam1(&u))/apb;
00880 S80:
00881     bpser = exp(z)*(a0/ *a)*(1.0e0+gam1(&b0))/t;
00882     goto S100;
00883 S90:
00884 /*
00885             PROCEDURE FOR A0 .LT. 1 AND B0 .GE. 8
00886 */
00887     u = gamln1(&a0)+algdiv(&a0,&b0);
00888     z = *a*log(*x)-u;
00889     bpser = a0/ *a*exp(z);
00890 S100:
00891     if(bpser == 0.0e0 || *a <= 0.1e0**eps) return bpser;
00892 /*
00893 -----------------------------------------------------------------------
00894                      COMPUTE THE SERIES
00895 -----------------------------------------------------------------------
00896 */
00897     sum = n = 0.0e0;
00898     c = 1.0e0;
00899     tol = *eps/ *a;
00900 S110:
00901     n += 1.0e0;
00902     c *= ((0.5e0+(0.5e0-*b/n))**x);
00903     w = c/(*a+n);
00904     sum += w;
00905     if(fabs(w) > tol) goto S110;
00906     bpser *= (1.0e0+*a*sum);
00907     return bpser;
00908 } /* END */

void bratio	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *
	)	`[static]`

Definition at line 911 of file nifti_stats.c.

References a, apser(), basym(), bfrac(), bgrat(), bpser(), bup(), fifdmax1(), fifdmin1(), fpser(), ind, spmpar(), x0, and y0.

Referenced by cumbet(), cumf(), and cumfnc().

00947 {
00948 static int K1 = 1;
00949 static double a0,b0,eps,lambda,t,x0,y0,z;
00950 static int ierr1,ind,n;
00951 static double T2,T3,T4,T5;
00952 /*
00953      ..
00954      .. Executable Statements ..
00955 */
00956 /*
00957      ****** EPS IS A MACHINE DEPENDENT CONSTANT. EPS IS THE SMALLEST
00958             FLOATING POINT NUMBER FOR WHICH 1.0 + EPS .GT. 1.0
00959 */
00960     eps = spmpar(&K1);
00961     *w = *w1 = 0.0e0;
00962     if(*a < 0.0e0 || *b < 0.0e0) goto S270;
00963     if(*a == 0.0e0 && *b == 0.0e0) goto S280;
00964     if(*x < 0.0e0 || *x > 1.0e0) goto S290;
00965     if(*y < 0.0e0 || *y > 1.0e0) goto S300;
00966     z = *x+*y-0.5e0-0.5e0;
00967     if(fabs(z) > 3.0e0*eps) goto S310;
00968     *ierr = 0;
00969     if(*x == 0.0e0) goto S210;
00970     if(*y == 0.0e0) goto S230;
00971     if(*a == 0.0e0) goto S240;
00972     if(*b == 0.0e0) goto S220;
00973     eps = fifdmax1(eps,1.e-15);
00974     if(fifdmax1(*a,*b) < 1.e-3*eps) goto S260;
00975     ind = 0;
00976     a0 = *a;
00977     b0 = *b;
00978     x0 = *x;
00979     y0 = *y;
00980     if(fifdmin1(a0,b0) > 1.0e0) goto S40;
00981 /*
00982              PROCEDURE FOR A0 .LE. 1 OR B0 .LE. 1
00983 */
00984     if(*x <= 0.5e0) goto S10;
00985     ind = 1;
00986     a0 = *b;
00987     b0 = *a;
00988     x0 = *y;
00989     y0 = *x;
00990 S10:
00991     if(b0 < fifdmin1(eps,eps*a0)) goto S90;
00992     if(a0 < fifdmin1(eps,eps*b0) && b0*x0 <= 1.0e0) goto S100;
00993     if(fifdmax1(a0,b0) > 1.0e0) goto S20;
00994     if(a0 >= fifdmin1(0.2e0,b0)) goto S110;
00995     if(pow(x0,a0) <= 0.9e0) goto S110;
00996     if(x0 >= 0.3e0) goto S120;
00997     n = 20;
00998     goto S140;
00999 S20:
01000     if(b0 <= 1.0e0) goto S110;
01001     if(x0 >= 0.3e0) goto S120;
01002     if(x0 >= 0.1e0) goto S30;
01003     if(pow(x0*b0,a0) <= 0.7e0) goto S110;
01004 S30:
01005     if(b0 > 15.0e0) goto S150;
01006     n = 20;
01007     goto S140;
01008 S40:
01009 /*
01010              PROCEDURE FOR A0 .GT. 1 AND B0 .GT. 1
01011 */
01012     if(*a > *b) goto S50;
01013     lambda = *a-(*a+*b)**x;
01014     goto S60;
01015 S50:
01016     lambda = (*a+*b)**y-*b;
01017 S60:
01018     if(lambda >= 0.0e0) goto S70;
01019     ind = 1;
01020     a0 = *b;
01021     b0 = *a;
01022     x0 = *y;
01023     y0 = *x;
01024     lambda = fabs(lambda);
01025 S70:
01026     if(b0 < 40.0e0 && b0*x0 <= 0.7e0) goto S110;
01027     if(b0 < 40.0e0) goto S160;
01028     if(a0 > b0) goto S80;
01029     if(a0 <= 100.0e0) goto S130;
01030     if(lambda > 0.03e0*a0) goto S130;
01031     goto S200;
01032 S80:
01033     if(b0 <= 100.0e0) goto S130;
01034     if(lambda > 0.03e0*b0) goto S130;
01035     goto S200;
01036 S90:
01037 /*
01038             EVALUATION OF THE APPROPRIATE ALGORITHM
01039 */
01040     *w = fpser(&a0,&b0,&x0,&eps);
01041     *w1 = 0.5e0+(0.5e0-*w);
01042     goto S250;
01043 S100:
01044     *w1 = apser(&a0,&b0,&x0,&eps);
01045     *w = 0.5e0+(0.5e0-*w1);
01046     goto S250;
01047 S110:
01048     *w = bpser(&a0,&b0,&x0,&eps);
01049     *w1 = 0.5e0+(0.5e0-*w);
01050     goto S250;
01051 S120:
01052     *w1 = bpser(&b0,&a0,&y0,&eps);
01053     *w = 0.5e0+(0.5e0-*w1);
01054     goto S250;
01055 S130:
01056     T2 = 15.0e0*eps;
01057     *w = bfrac(&a0,&b0,&x0,&y0,&lambda,&T2);
01058     *w1 = 0.5e0+(0.5e0-*w);
01059     goto S250;
01060 S140:
01061     *w1 = bup(&b0,&a0,&y0,&x0,&n,&eps);
01062     b0 += (double)n;
01063 S150:
01064     T3 = 15.0e0*eps;
01065     bgrat(&b0,&a0,&y0,&x0,w1,&T3,&ierr1);
01066     *w = 0.5e0+(0.5e0-*w1);
01067     goto S250;
01068 S160:
01069     n = b0;
01070     b0 -= (double)n;
01071     if(b0 != 0.0e0) goto S170;
01072     n -= 1;
01073     b0 = 1.0e0;
01074 S170:
01075     *w = bup(&b0,&a0,&y0,&x0,&n,&eps);
01076     if(x0 > 0.7e0) goto S180;
01077     *w += bpser(&a0,&b0,&x0,&eps);
01078     *w1 = 0.5e0+(0.5e0-*w);
01079     goto S250;
01080 S180:
01081     if(a0 > 15.0e0) goto S190;
01082     n = 20;
01083     *w += bup(&a0,&b0,&x0,&y0,&n,&eps);
01084     a0 += (double)n;
01085 S190:
01086     T4 = 15.0e0*eps;
01087     bgrat(&a0,&b0,&x0,&y0,w,&T4,&ierr1);
01088     *w1 = 0.5e0+(0.5e0-*w);
01089     goto S250;
01090 S200:
01091     T5 = 100.0e0*eps;
01092     *w = basym(&a0,&b0,&lambda,&T5);
01093     *w1 = 0.5e0+(0.5e0-*w);
01094     goto S250;
01095 S210:
01096 /*
01097                TERMINATION OF THE PROCEDURE
01098 */
01099     if(*a == 0.0e0) goto S320;
01100 S220:
01101     *w = 0.0e0;
01102     *w1 = 1.0e0;
01103     return;
01104 S230:
01105     if(*b == 0.0e0) goto S330;
01106 S240:
01107     *w = 1.0e0;
01108     *w1 = 0.0e0;
01109     return;
01110 S250:
01111     if(ind == 0) return;
01112     t = *w;
01113     *w = *w1;
01114     *w1 = t;
01115     return;
01116 S260:
01117 /*
01118            PROCEDURE FOR A AND B .LT. 1.E-3*EPS
01119 */
01120     *w = *b/(*a+*b);
01121     *w1 = *a/(*a+*b);
01122     return;
01123 S270:
01124 /*
01125                        ERROR RETURN
01126 */
01127     *ierr = 1;
01128     return;
01129 S280:
01130     *ierr = 2;
01131     return;
01132 S290:
01133     *ierr = 3;
01134     return;
01135 S300:
01136     *ierr = 4;
01137     return;
01138 S310:
01139     *ierr = 5;
01140     return;
01141 S320:
01142     *ierr = 6;
01143     return;
01144 S330:
01145     *ierr = 7;
01146     return;
01147 } /* END */

double brcmp1	(	int *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 1150 of file nifti_stats.c.

References a, algdiv(), alnrel(), bcorr(), betaln(), brcmp1(), c, esum(), fifdmax1(), fifdmin1(), gam1(), gamln1(), i, rlog1(), v, x0, and y0.

Referenced by brcmp1(), and bup().

01156 {
01157 static double Const = .398942280401433e0;
01158 static double brcmp1,a0,apb,b0,c,e,h,lambda,lnx,lny,t,u,v,x0,y0,z;
01159 static int i,n;
01160 /*
01161 -----------------
01162      CONST = 1/SQRT(2*PI)
01163 -----------------
01164 */
01165 static double T1,T2,T3,T4;
01166 /*
01167      ..
01168      .. Executable Statements ..
01169 */
01170     a0 = fifdmin1(*a,*b);
01171     if(a0 >= 8.0e0) goto S130;
01172     if(*x > 0.375e0) goto S10;
01173     lnx = log(*x);
01174     T1 = -*x;
01175     lny = alnrel(&T1);
01176     goto S30;
01177 S10:
01178     if(*y > 0.375e0) goto S20;
01179     T2 = -*y;
01180     lnx = alnrel(&T2);
01181     lny = log(*y);
01182     goto S30;
01183 S20:
01184     lnx = log(*x);
01185     lny = log(*y);
01186 S30:
01187     z = *a*lnx+*b*lny;
01188     if(a0 < 1.0e0) goto S40;
01189     z -= betaln(a,b);
01190     brcmp1 = esum(mu,&z);
01191     return brcmp1;
01192 S40:
01193 /*
01194 -----------------------------------------------------------------------
01195               PROCEDURE FOR A .LT. 1 OR B .LT. 1
01196 -----------------------------------------------------------------------
01197 */
01198     b0 = fifdmax1(*a,*b);
01199     if(b0 >= 8.0e0) goto S120;
01200     if(b0 > 1.0e0) goto S70;
01201 /*
01202                    ALGORITHM FOR B0 .LE. 1
01203 */
01204     brcmp1 = esum(mu,&z);
01205     if(brcmp1 == 0.0e0) return brcmp1;
01206     apb = *a+*b;
01207     if(apb > 1.0e0) goto S50;
01208     z = 1.0e0+gam1(&apb);
01209     goto S60;
01210 S50:
01211     u = *a+*b-1.e0;
01212     z = (1.0e0+gam1(&u))/apb;
01213 S60:
01214     c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z;
01215     brcmp1 = brcmp1*(a0*c)/(1.0e0+a0/b0);
01216     return brcmp1;
01217 S70:
01218 /*
01219                 ALGORITHM FOR 1 .LT. B0 .LT. 8
01220 */
01221     u = gamln1(&a0);
01222     n = b0-1.0e0;
01223     if(n < 1) goto S90;
01224     c = 1.0e0;
01225     for(i=1; i<=n; i++) {
01226         b0 -= 1.0e0;
01227         c *= (b0/(a0+b0));
01228     }
01229     u = log(c)+u;
01230 S90:
01231     z -= u;
01232     b0 -= 1.0e0;
01233     apb = a0+b0;
01234     if(apb > 1.0e0) goto S100;
01235     t = 1.0e0+gam1(&apb);
01236     goto S110;
01237 S100:
01238     u = a0+b0-1.e0;
01239     t = (1.0e0+gam1(&u))/apb;
01240 S110:
01241     brcmp1 = a0*esum(mu,&z)*(1.0e0+gam1(&b0))/t;
01242     return brcmp1;
01243 S120:
01244 /*
01245                    ALGORITHM FOR B0 .GE. 8
01246 */
01247     u = gamln1(&a0)+algdiv(&a0,&b0);
01248     T3 = z-u;
01249     brcmp1 = a0*esum(mu,&T3);
01250     return brcmp1;
01251 S130:
01252 /*
01253 -----------------------------------------------------------------------
01254               PROCEDURE FOR A .GE. 8 AND B .GE. 8
01255 -----------------------------------------------------------------------
01256 */
01257     if(*a > *b) goto S140;
01258     h = *a/ *b;
01259     x0 = h/(1.0e0+h);
01260     y0 = 1.0e0/(1.0e0+h);
01261     lambda = *a-(*a+*b)**x;
01262     goto S150;
01263 S140:
01264     h = *b/ *a;
01265     x0 = 1.0e0/(1.0e0+h);
01266     y0 = h/(1.0e0+h);
01267     lambda = (*a+*b)**y-*b;
01268 S150:
01269     e = -(lambda/ *a);
01270     if(fabs(e) > 0.6e0) goto S160;
01271     u = rlog1(&e);
01272     goto S170;
01273 S160:
01274     u = e-log(*x/x0);
01275 S170:
01276     e = lambda/ *b;
01277     if(fabs(e) > 0.6e0) goto S180;
01278     v = rlog1(&e);
01279     goto S190;
01280 S180:
01281     v = e-log(*y/y0);
01282 S190:
01283     T4 = -(*a*u+*b*v);
01284     z = esum(mu,&T4);
01285     brcmp1 = Const*sqrt(*b*x0)*z*exp(-bcorr(a,b));
01286     return brcmp1;
01287 } /* END */

double brcomp	(	double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 1290 of file nifti_stats.c.

References a, algdiv(), alnrel(), bcorr(), betaln(), brcomp(), c, fifdmax1(), fifdmin1(), gam1(), gamln1(), i, rlog1(), v, x0, and y0.

Referenced by bfrac(), and brcomp().

01296 {
01297 static double Const = .398942280401433e0;
01298 static double brcomp,a0,apb,b0,c,e,h,lambda,lnx,lny,t,u,v,x0,y0,z;
01299 static int i,n;
01300 /*
01301 -----------------
01302      CONST = 1/SQRT(2*PI)
01303 -----------------
01304 */
01305 static double T1,T2;
01306 /*
01307      ..
01308      .. Executable Statements ..
01309 */
01310     brcomp = 0.0e0;
01311     if(*x == 0.0e0 || *y == 0.0e0) return brcomp;
01312     a0 = fifdmin1(*a,*b);
01313     if(a0 >= 8.0e0) goto S130;
01314     if(*x > 0.375e0) goto S10;
01315     lnx = log(*x);
01316     T1 = -*x;
01317     lny = alnrel(&T1);
01318     goto S30;
01319 S10:
01320     if(*y > 0.375e0) goto S20;
01321     T2 = -*y;
01322     lnx = alnrel(&T2);
01323     lny = log(*y);
01324     goto S30;
01325 S20:
01326     lnx = log(*x);
01327     lny = log(*y);
01328 S30:
01329     z = *a*lnx+*b*lny;
01330     if(a0 < 1.0e0) goto S40;
01331     z -= betaln(a,b);
01332     brcomp = exp(z);
01333     return brcomp;
01334 S40:
01335 /*
01336 -----------------------------------------------------------------------
01337               PROCEDURE FOR A .LT. 1 OR B .LT. 1
01338 -----------------------------------------------------------------------
01339 */
01340     b0 = fifdmax1(*a,*b);
01341     if(b0 >= 8.0e0) goto S120;
01342     if(b0 > 1.0e0) goto S70;
01343 /*
01344                    ALGORITHM FOR B0 .LE. 1
01345 */
01346     brcomp = exp(z);
01347     if(brcomp == 0.0e0) return brcomp;
01348     apb = *a+*b;
01349     if(apb > 1.0e0) goto S50;
01350     z = 1.0e0+gam1(&apb);
01351     goto S60;
01352 S50:
01353     u = *a+*b-1.e0;
01354     z = (1.0e0+gam1(&u))/apb;
01355 S60:
01356     c = (1.0e0+gam1(a))*(1.0e0+gam1(b))/z;
01357     brcomp = brcomp*(a0*c)/(1.0e0+a0/b0);
01358     return brcomp;
01359 S70:
01360 /*
01361                 ALGORITHM FOR 1 .LT. B0 .LT. 8
01362 */
01363     u = gamln1(&a0);
01364     n = b0-1.0e0;
01365     if(n < 1) goto S90;
01366     c = 1.0e0;
01367     for(i=1; i<=n; i++) {
01368         b0 -= 1.0e0;
01369         c *= (b0/(a0+b0));
01370     }
01371     u = log(c)+u;
01372 S90:
01373     z -= u;
01374     b0 -= 1.0e0;
01375     apb = a0+b0;
01376     if(apb > 1.0e0) goto S100;
01377     t = 1.0e0+gam1(&apb);
01378     goto S110;
01379 S100:
01380     u = a0+b0-1.e0;
01381     t = (1.0e0+gam1(&u))/apb;
01382 S110:
01383     brcomp = a0*exp(z)*(1.0e0+gam1(&b0))/t;
01384     return brcomp;
01385 S120:
01386 /*
01387                    ALGORITHM FOR B0 .GE. 8
01388 */
01389     u = gamln1(&a0)+algdiv(&a0,&b0);
01390     brcomp = a0*exp(z-u);
01391     return brcomp;
01392 S130:
01393 /*
01394 -----------------------------------------------------------------------
01395               PROCEDURE FOR A .GE. 8 AND B .GE. 8
01396 -----------------------------------------------------------------------
01397 */
01398     if(*a > *b) goto S140;
01399     h = *a/ *b;
01400     x0 = h/(1.0e0+h);
01401     y0 = 1.0e0/(1.0e0+h);
01402     lambda = *a-(*a+*b)**x;
01403     goto S150;
01404 S140:
01405     h = *b/ *a;
01406     x0 = 1.0e0/(1.0e0+h);
01407     y0 = h/(1.0e0+h);
01408     lambda = (*a+*b)**y-*b;
01409 S150:
01410     e = -(lambda/ *a);
01411     if(fabs(e) > 0.6e0) goto S160;
01412     u = rlog1(&e);
01413     goto S170;
01414 S160:
01415     u = e-log(*x/x0);
01416 S170:
01417     e = lambda/ *b;
01418     if(fabs(e) > 0.6e0) goto S180;
01419     v = rlog1(&e);
01420     goto S190;
01421 S180:
01422     v = e-log(*y/y0);
01423 S190:
01424     z = exp(-(*a*u+*b*v));
01425     brcomp = Const*sqrt(*b*x0)*z*exp(-bcorr(a,b));
01426     return brcomp;
01427 } /* END */

double bup	(	double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 1430 of file nifti_stats.c.

References a, brcmp1(), bup(), exparg(), i, l, and r.

Referenced by bratio(), and bup().

01437 {
01438 static int K1 = 1;
01439 static int K2 = 0;
01440 static double bup,ap1,apb,d,l,r,t,w;
01441 static int i,k,kp1,mu,nm1;
01442 /*
01443      ..
01444      .. Executable Statements ..
01445 */
01446 /*
01447           OBTAIN THE SCALING FACTOR EXP(-MU) AND
01448              EXP(MU)*(X**A*Y**B/BETA(A,B))/A
01449 */
01450     apb = *a+*b;
01451     ap1 = *a+1.0e0;
01452     mu = 0;
01453     d = 1.0e0;
01454     if(*n == 1 || *a < 1.0e0) goto S10;
01455     if(apb < 1.1e0*ap1) goto S10;
01456     mu = fabs(exparg(&K1));
01457     k = exparg(&K2);
01458     if(k < mu) mu = k;
01459     t = mu;
01460     d = exp(-t);
01461 S10:
01462     bup = brcmp1(&mu,a,b,x,y)/ *a;
01463     if(*n == 1 || bup == 0.0e0) return bup;
01464     nm1 = *n-1;
01465     w = d;
01466 /*
01467           LET K BE THE INDEX OF THE MAXIMUM TERM
01468 */
01469     k = 0;
01470     if(*b <= 1.0e0) goto S50;
01471     if(*y > 1.e-4) goto S20;
01472     k = nm1;
01473     goto S30;
01474 S20:
01475     r = (*b-1.0e0)**x/ *y-*a;
01476     if(r < 1.0e0) goto S50;
01477     k = t = nm1;
01478     if(r < t) k = r;
01479 S30:
01480 /*
01481           ADD THE INCREASING TERMS OF THE SERIES
01482 */
01483     for(i=1; i<=k; i++) {
01484         l = i-1;
01485         d = (apb+l)/(ap1+l)**x*d;
01486         w += d;
01487     }
01488     if(k == nm1) goto S70;
01489 S50:
01490 /*
01491           ADD THE REMAINING TERMS OF THE SERIES
01492 */
01493     kp1 = k+1;
01494     for(i=kp1; i<=nm1; i++) {
01495         l = i-1;
01496         d = (apb+l)/(ap1+l)**x*d;
01497         w += d;
01498         if(d <= *eps*w) goto S70;
01499     }
01500 S70:
01501 /*
01502                TERMINATE THE PROCEDURE
01503 */
01504     bup *= w;
01505     return bup;
01506 } /* END */

void cdfbet	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 1509 of file nifti_stats.c.

References a, cumbet(), dinvr(), dstinv(), dstzr(), dzror(), p, and spmpar().

Referenced by beta_p2t(), beta_pq2s(), beta_s2pq(), and beta_t2p().

01532                           : 1..4
01533                iwhich = 1 : Calculate P and Q from X,Y,A and B
01534                iwhich = 2 : Calculate X and Y from P,Q,A and B
01535                iwhich = 3 : Calculate A from P,Q,X,Y and B
01536                iwhich = 4 : Calculate B from P,Q,X,Y and A
01537 
01538      P <--> The integral from 0 to X of the chi-square
01539             distribution.
01540             Input range: [0, 1].
01541 
01542      Q <--> 1-P.
01543             Input range: [0, 1].
01544             P + Q = 1.0.
01545 
01546      X <--> Upper limit of integration of beta density.
01547             Input range: [0,1].
01548             Search range: [0,1]
01549 
01550      Y <--> 1-X.
01551             Input range: [0,1].
01552             Search range: [0,1]
01553             X + Y = 1.0.
01554 
01555      A <--> The first parameter of the beta density.
01556             Input range: (0, +infinity).
01557             Search range: [1D-300,1D300]
01558 
01559      B <--> The second parameter of the beta density.
01560             Input range: (0, +infinity).
01561             Search range: [1D-300,1D300]
01562 
01563      STATUS <-- 0 if calculation completed correctly
01564                -I if input parameter number I is out of range
01565                 1 if answer appears to be lower than lowest
01566                   search bound
01567                 2 if answer appears to be higher than greatest
01568                   search bound
01569                 3 if P + Q .ne. 1
01570                 4 if X + Y .ne. 1
01571 
01572      BOUND <-- Undefined if STATUS is 0
01573 
01574                Bound exceeded by parameter number I if STATUS
01575                is negative.
01576 
01577                Lower search bound if STATUS is 1.
01578 
01579                Upper search bound if STATUS is 2.
01580 
01581 
01582                               Method
01583 
01584 
01585      Cumulative distribution function  (P)  is calculated directly by
01586      code associated with the following reference.
01587 
01588      DiDinato, A. R. and Morris,  A.   H.  Algorithm 708: Significant
01589      Digit Computation of the Incomplete  Beta  Function Ratios.  ACM
01590      Trans. Math.  Softw. 18 (1993), 360-373.
01591 
01592      Computation of other parameters involve a seach for a value that
01593      produces  the desired  value  of P.   The search relies  on  the
01594      monotinicity of P with the other parameter.
01595 
01596 
01597                               Note
01598 
01599 
01600      The beta density is proportional to
01601                t^(A-1) * (1-t)^(B-1)
01602 
01603 **********************************************************************/
01604 {
01605 #define tol (1.0e-8)
01606 #define atol (1.0e-50)
01607 #define zero (1.0e-300)
01608 #define inf 1.0e300
01609 #define one 1.0e0
01610 static int K1 = 1;
01611 static double K2 = 0.0e0;
01612 static double K3 = 1.0e0;
01613 static double K8 = 0.5e0;
01614 static double K9 = 5.0e0;
01615 static double fx,xhi,xlo,cum,ccum,xy,pq;
01616 static unsigned long qhi,qleft,qporq;
01617 static double T4,T5,T6,T7,T10,T11,T12,T13,T14,T15;
01618 /*
01619      ..
01620      .. Executable Statements ..
01621 */
01622 /*
01623      Check arguments
01624 */
01625     if(!(*which < 1 || *which > 4)) goto S30;
01626     if(!(*which < 1)) goto S10;
01627     *bound = 1.0e0;
01628     goto S20;
01629 S10:
01630     *bound = 4.0e0;
01631 S20:
01632     *status = -1;
01633     return;
01634 S30:
01635     if(*which == 1) goto S70;
01636 /*
01637      P
01638 */
01639     if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
01640     if(!(*p < 0.0e0)) goto S40;
01641     *bound = 0.0e0;
01642     goto S50;
01643 S40:
01644     *bound = 1.0e0;
01645 S50:
01646     *status = -2;
01647     return;
01648 S70:
01649 S60:
01650     if(*which == 1) goto S110;
01651 /*
01652      Q
01653 */
01654     if(!(*q < 0.0e0 || *q > 1.0e0)) goto S100;
01655     if(!(*q < 0.0e0)) goto S80;
01656     *bound = 0.0e0;
01657     goto S90;
01658 S80:
01659     *bound = 1.0e0;
01660 S90:
01661     *status = -3;
01662     return;
01663 S110:
01664 S100:
01665     if(*which == 2) goto S150;
01666 /*
01667      X
01668 */
01669     if(!(*x < 0.0e0 || *x > 1.0e0)) goto S140;
01670     if(!(*x < 0.0e0)) goto S120;
01671     *bound = 0.0e0;
01672     goto S130;
01673 S120:
01674     *bound = 1.0e0;
01675 S130:
01676     *status = -4;
01677     return;
01678 S150:
01679 S140:
01680     if(*which == 2) goto S190;
01681 /*
01682      Y
01683 */
01684     if(!(*y < 0.0e0 || *y > 1.0e0)) goto S180;
01685     if(!(*y < 0.0e0)) goto S160;
01686     *bound = 0.0e0;
01687     goto S170;
01688 S160:
01689     *bound = 1.0e0;
01690 S170:
01691     *status = -5;
01692     return;
01693 S190:
01694 S180:
01695     if(*which == 3) goto S210;
01696 /*
01697      A
01698 */
01699     if(!(*a <= 0.0e0)) goto S200;
01700     *bound = 0.0e0;
01701     *status = -6;
01702     return;
01703 S210:
01704 S200:
01705     if(*which == 4) goto S230;
01706 /*
01707      B
01708 */
01709     if(!(*b <= 0.0e0)) goto S220;
01710     *bound = 0.0e0;
01711     *status = -7;
01712     return;
01713 S230:
01714 S220:
01715     if(*which == 1) goto S270;
01716 /*
01717      P + Q
01718 */
01719     pq = *p+*q;
01720     if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S260;
01721     if(!(pq < 0.0e0)) goto S240;
01722     *bound = 0.0e0;
01723     goto S250;
01724 S240:
01725     *bound = 1.0e0;
01726 S250:
01727     *status = 3;
01728     return;
01729 S270:
01730 S260:
01731     if(*which == 2) goto S310;
01732 /*
01733      X + Y
01734 */
01735     xy = *x+*y;
01736     if(!(fabs(xy-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S300;
01737     if(!(xy < 0.0e0)) goto S280;
01738     *bound = 0.0e0;
01739     goto S290;
01740 S280:
01741     *bound = 1.0e0;
01742 S290:
01743     *status = 4;
01744     return;
01745 S310:
01746 S300:
01747     if(!(*which == 1)) qporq = *p <= *q;
01748 /*
01749      Select the minimum of P or Q
01750      Calculate ANSWERS
01751 */
01752     if(1 == *which) {
01753 /*
01754      Calculating P and Q
01755 */
01756         cumbet(x,y,a,b,p,q);
01757         *status = 0;
01758     }
01759     else if(2 == *which) {
01760 /*
01761      Calculating X and Y
01762 */
01763         T4 = atol;
01764         T5 = tol;
01765         dstzr(&K2,&K3,&T4,&T5);
01766         if(!qporq) goto S340;
01767         *status = 0;
01768         dzror(status,x,&fx,&xlo,&xhi,&qleft,&qhi);
01769         *y = one-*x;
01770 S320:
01771         if(!(*status == 1)) goto S330;
01772         cumbet(x,y,a,b,&cum,&ccum);
01773         fx = cum-*p;
01774         dzror(status,x,&fx,&xlo,&xhi,&qleft,&qhi);
01775         *y = one-*x;
01776         goto S320;
01777 S330:
01778         goto S370;
01779 S340:
01780         *status = 0;
01781         dzror(status,y,&fx,&xlo,&xhi,&qleft,&qhi);
01782         *x = one-*y;
01783 S350:
01784         if(!(*status == 1)) goto S360;
01785         cumbet(x,y,a,b,&cum,&ccum);
01786         fx = ccum-*q;
01787         dzror(status,y,&fx,&xlo,&xhi,&qleft,&qhi);
01788         *x = one-*y;
01789         goto S350;
01790 S370:
01791 S360:
01792         if(!(*status == -1)) goto S400;
01793         if(!qleft) goto S380;
01794         *status = 1;
01795         *bound = 0.0e0;
01796         goto S390;
01797 S380:
01798         *status = 2;
01799         *bound = 1.0e0;
01800 S400:
01801 S390:
01802         ;
01803     }
01804     else if(3 == *which) {
01805 /*
01806      Computing A
01807 */
01808         *a = 5.0e0;
01809         T6 = zero;
01810         T7 = inf;
01811         T10 = atol;
01812         T11 = tol;
01813         dstinv(&T6,&T7,&K8,&K8,&K9,&T10,&T11);
01814         *status = 0;
01815         dinvr(status,a,&fx,&qleft,&qhi);
01816 S410:
01817         if(!(*status == 1)) goto S440;
01818         cumbet(x,y,a,b,&cum,&ccum);
01819         if(!qporq) goto S420;
01820         fx = cum-*p;
01821         goto S430;
01822 S420:
01823         fx = ccum-*q;
01824 S430:
01825         dinvr(status,a,&fx,&qleft,&qhi);
01826         goto S410;
01827 S440:
01828         if(!(*status == -1)) goto S470;
01829         if(!qleft) goto S450;
01830         *status = 1;
01831         *bound = zero;
01832         goto S460;
01833 S450:
01834         *status = 2;
01835         *bound = inf;
01836 S470:
01837 S460:
01838         ;
01839     }
01840     else if(4 == *which) {
01841 /*
01842      Computing B
01843 */
01844         *b = 5.0e0;
01845         T12 = zero;
01846         T13 = inf;
01847         T14 = atol;
01848         T15 = tol;
01849         dstinv(&T12,&T13,&K8,&K8,&K9,&T14,&T15);
01850         *status = 0;
01851         dinvr(status,b,&fx,&qleft,&qhi);
01852 S480:
01853         if(!(*status == 1)) goto S510;
01854         cumbet(x,y,a,b,&cum,&ccum);
01855         if(!qporq) goto S490;
01856         fx = cum-*p;
01857         goto S500;
01858 S490:
01859         fx = ccum-*q;
01860 S500:
01861         dinvr(status,b,&fx,&qleft,&qhi);
01862         goto S480;
01863 S510:
01864         if(!(*status == -1)) goto S540;
01865         if(!qleft) goto S520;
01866         *status = 1;
01867         *bound = zero;
01868         goto S530;
01869 S520:
01870         *status = 2;
01871         *bound = inf;
01872 S530:
01873         ;
01874     }
01875 S540:
01876     return;
01877 #undef tol
01878 #undef atol
01879 #undef zero
01880 #undef inf
01881 #undef one
01882 } /* END */

void cdfbin	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 1885 of file nifti_stats.c.

References cumbin(), dinvr(), dstinv(), dstzr(), dzror(), p, spmpar(), and xn.

Referenced by binomial_p2t(), binomial_pq2s(), binomial_s2pq(), and binomial_t2p().

01908                           : 1..4
01909                iwhich = 1 : Calculate P and Q from S,XN,PR and OMPR
01910                iwhich = 2 : Calculate S from P,Q,XN,PR and OMPR
01911                iwhich = 3 : Calculate XN from P,Q,S,PR and OMPR
01912                iwhich = 4 : Calculate PR and OMPR from P,Q,S and XN
01913 
01914      P <--> The cumulation from 0 to S of the binomial distribution.
01915             (Probablility of S or fewer successes in XN trials each
01916             with probability of success PR.)
01917             Input range: [0,1].
01918 
01919      Q <--> 1-P.
01920             Input range: [0, 1].
01921             P + Q = 1.0.
01922 
01923      S <--> The number of successes observed.
01924             Input range: [0, XN]
01925             Search range: [0, XN]
01926 
01927      XN  <--> The number of binomial trials.
01928               Input range: (0, +infinity).
01929               Search range: [1E-300, 1E300]
01930 
01931      PR  <--> The probability of success in each binomial trial.
01932               Input range: [0,1].
01933               Search range: [0,1]
01934 
01935      OMPR  <--> 1-PR
01936               Input range: [0,1].
01937               Search range: [0,1]
01938               PR + OMPR = 1.0
01939 
01940      STATUS <-- 0 if calculation completed correctly
01941                -I if input parameter number I is out of range
01942                 1 if answer appears to be lower than lowest
01943                   search bound
01944                 2 if answer appears to be higher than greatest
01945                   search bound
01946                 3 if P + Q .ne. 1
01947                 4 if PR + OMPR .ne. 1
01948 
01949      BOUND <-- Undefined if STATUS is 0
01950 
01951                Bound exceeded by parameter number I if STATUS
01952                is negative.
01953 
01954                Lower search bound if STATUS is 1.
01955 
01956                Upper search bound if STATUS is 2.
01957 
01958 
01959                               Method
01960 
01961 
01962      Formula  26.5.24    of   Abramowitz  and    Stegun,  Handbook   of
01963      Mathematical   Functions (1966) is   used  to reduce the  binomial
01964      distribution  to  the  cumulative incomplete    beta distribution.
01965 
01966      Computation of other parameters involve a seach for a value that
01967      produces  the desired  value  of P.   The search relies  on  the
01968      monotinicity of P with the other parameter.
01969 
01970 
01971 **********************************************************************/
01972 {
01973 #define atol (1.0e-50)
01974 #define tol (1.0e-8)
01975 #define zero (1.0e-300)
01976 #define inf 1.0e300
01977 #define one 1.0e0
01978 static int K1 = 1;
01979 static double K2 = 0.0e0;
01980 static double K3 = 0.5e0;
01981 static double K4 = 5.0e0;
01982 static double K11 = 1.0e0;
01983 static double fx,xhi,xlo,cum,ccum,pq,prompr;
01984 static unsigned long qhi,qleft,qporq;
01985 static double T5,T6,T7,T8,T9,T10,T12,T13;
01986 /*
01987      ..
01988      .. Executable Statements ..
01989 */
01990 /*
01991      Check arguments
01992 */
01993     if(!(*which < 1 && *which > 4)) goto S30;
01994     if(!(*which < 1)) goto S10;
01995     *bound = 1.0e0;
01996     goto S20;
01997 S10:
01998     *bound = 4.0e0;
01999 S20:
02000     *status = -1;
02001     return;
02002 S30:
02003     if(*which == 1) goto S70;
02004 /*
02005      P
02006 */
02007     if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
02008     if(!(*p < 0.0e0)) goto S40;
02009     *bound = 0.0e0;
02010     goto S50;
02011 S40:
02012     *bound = 1.0e0;
02013 S50:
02014     *status = -2;
02015     return;
02016 S70:
02017 S60:
02018     if(*which == 1) goto S110;
02019 /*
02020      Q
02021 */
02022     if(!(*q < 0.0e0 || *q > 1.0e0)) goto S100;
02023     if(!(*q < 0.0e0)) goto S80;
02024     *bound = 0.0e0;
02025     goto S90;
02026 S80:
02027     *bound = 1.0e0;
02028 S90:
02029     *status = -3;
02030     return;
02031 S110:
02032 S100:
02033     if(*which == 3) goto S130;
02034 /*
02035      XN
02036 */
02037     if(!(*xn <= 0.0e0)) goto S120;
02038     *bound = 0.0e0;
02039     *status = -5;
02040     return;
02041 S130:
02042 S120:
02043     if(*which == 2) goto S170;
02044 /*
02045      S
02046 */
02047     if(!(*s < 0.0e0 || *which != 3 && *s > *xn)) goto S160;
02048     if(!(*s < 0.0e0)) goto S140;
02049     *bound = 0.0e0;
02050     goto S150;
02051 S140:
02052     *bound = *xn;
02053 S150:
02054     *status = -4;
02055     return;
02056 S170:
02057 S160:
02058     if(*which == 4) goto S210;
02059 /*
02060      PR
02061 */
02062     if(!(*pr < 0.0e0 || *pr > 1.0e0)) goto S200;
02063     if(!(*pr < 0.0e0)) goto S180;
02064     *bound = 0.0e0;
02065     goto S190;
02066 S180:
02067     *bound = 1.0e0;
02068 S190:
02069     *status = -6;
02070     return;
02071 S210:
02072 S200:
02073     if(*which == 4) goto S250;
02074 /*
02075      OMPR
02076 */
02077     if(!(*ompr < 0.0e0 || *ompr > 1.0e0)) goto S240;
02078     if(!(*ompr < 0.0e0)) goto S220;
02079     *bound = 0.0e0;
02080     goto S230;
02081 S220:
02082     *bound = 1.0e0;
02083 S230:
02084     *status = -7;
02085     return;
02086 S250:
02087 S240:
02088     if(*which == 1) goto S290;
02089 /*
02090      P + Q
02091 */
02092     pq = *p+*q;
02093     if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S280;
02094     if(!(pq < 0.0e0)) goto S260;
02095     *bound = 0.0e0;
02096     goto S270;
02097 S260:
02098     *bound = 1.0e0;
02099 S270:
02100     *status = 3;
02101     return;
02102 S290:
02103 S280:
02104     if(*which == 4) goto S330;
02105 /*
02106      PR + OMPR
02107 */
02108     prompr = *pr+*ompr;
02109     if(!(fabs(prompr-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S320;
02110     if(!(prompr < 0.0e0)) goto S300;
02111     *bound = 0.0e0;
02112     goto S310;
02113 S300:
02114     *bound = 1.0e0;
02115 S310:
02116     *status = 4;
02117     return;
02118 S330:
02119 S320:
02120     if(!(*which == 1)) qporq = *p <= *q;
02121 /*
02122      Select the minimum of P or Q
02123      Calculate ANSWERS
02124 */
02125     if(1 == *which) {
02126 /*
02127      Calculating P
02128 */
02129         cumbin(s,xn,pr,ompr,p,q);
02130         *status = 0;
02131     }
02132     else if(2 == *which) {
02133 /*
02134      Calculating S
02135 */
02136         *s = 5.0e0;
02137         T5 = atol;
02138         T6 = tol;
02139         dstinv(&K2,xn,&K3,&K3,&K4,&T5,&T6);
02140         *status = 0;
02141         dinvr(status,s,&fx,&qleft,&qhi);
02142 S340:
02143         if(!(*status == 1)) goto S370;
02144         cumbin(s,xn,pr,ompr,&cum,&ccum);
02145         if(!qporq) goto S350;
02146         fx = cum-*p;
02147         goto S360;
02148 S350:
02149         fx = ccum-*q;
02150 S360:
02151         dinvr(status,s,&fx,&qleft,&qhi);
02152         goto S340;
02153 S370:
02154         if(!(*status == -1)) goto S400;
02155         if(!qleft) goto S380;
02156         *status = 1;
02157         *bound = 0.0e0;
02158         goto S390;
02159 S380:
02160         *status = 2;
02161         *bound = *xn;
02162 S400:
02163 S390:
02164         ;
02165     }
02166     else if(3 == *which) {
02167 /*
02168      Calculating XN
02169 */
02170         *xn = 5.0e0;
02171         T7 = zero;
02172         T8 = inf;
02173         T9 = atol;
02174         T10 = tol;
02175         dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10);
02176         *status = 0;
02177         dinvr(status,xn,&fx,&qleft,&qhi);
02178 S410:
02179         if(!(*status == 1)) goto S440;
02180         cumbin(s,xn,pr,ompr,&cum,&ccum);
02181         if(!qporq) goto S420;
02182         fx = cum-*p;
02183         goto S430;
02184 S420:
02185         fx = ccum-*q;
02186 S430:
02187         dinvr(status,xn,&fx,&qleft,&qhi);
02188         goto S410;
02189 S440:
02190         if(!(*status == -1)) goto S470;
02191         if(!qleft) goto S450;
02192         *status = 1;
02193         *bound = zero;
02194         goto S460;
02195 S450:
02196         *status = 2;
02197         *bound = inf;
02198 S470:
02199 S460:
02200         ;
02201     }
02202     else if(4 == *which) {
02203 /*
02204      Calculating PR and OMPR
02205 */
02206         T12 = atol;
02207         T13 = tol;
02208         dstzr(&K2,&K11,&T12,&T13);
02209         if(!qporq) goto S500;
02210         *status = 0;
02211         dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi);
02212         *ompr = one-*pr;
02213 S480:
02214         if(!(*status == 1)) goto S490;
02215         cumbin(s,xn,pr,ompr,&cum,&ccum);
02216         fx = cum-*p;
02217         dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi);
02218         *ompr = one-*pr;
02219         goto S480;
02220 S490:
02221         goto S530;
02222 S500:
02223         *status = 0;
02224         dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi);
02225         *pr = one-*ompr;
02226 S510:
02227         if(!(*status == 1)) goto S520;
02228         cumbin(s,xn,pr,ompr,&cum,&ccum);
02229         fx = ccum-*q;
02230         dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi);
02231         *pr = one-*ompr;
02232         goto S510;
02233 S530:
02234 S520:
02235         if(!(*status == -1)) goto S560;
02236         if(!qleft) goto S540;
02237         *status = 1;
02238         *bound = 0.0e0;
02239         goto S550;
02240 S540:
02241         *status = 2;
02242         *bound = 1.0e0;
02243 S550:
02244         ;
02245     }
02246 S560:
02247     return;
02248 #undef atol
02249 #undef tol
02250 #undef zero
02251 #undef inf
02252 #undef one
02253 } /* END */

void cdfchi	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 2256 of file nifti_stats.c.

References cumchi(), dinvr(), dstinv(), p, and spmpar().

Referenced by chisq_p2t(), chisq_pq2s(), chisq_s2pq(), and chisq_t2p().

02279                           : 1..3
02280                iwhich = 1 : Calculate P and Q from X and DF
02281                iwhich = 2 : Calculate X from P,Q and DF
02282                iwhich = 3 : Calculate DF from P,Q and X
02283 
02284      P <--> The integral from 0 to X of the chi-square
02285             distribution.
02286             Input range: [0, 1].
02287 
02288      Q <--> 1-P.
02289             Input range: (0, 1].
02290             P + Q = 1.0.
02291 
02292      X <--> Upper limit of integration of the non-central
02293             chi-square distribution.
02294             Input range: [0, +infinity).
02295             Search range: [0,1E300]
02296 
02297      DF <--> Degrees of freedom of the
02298              chi-square distribution.
02299              Input range: (0, +infinity).
02300              Search range: [ 1E-300, 1E300]
02301 
02302      STATUS <-- 0 if calculation completed correctly
02303                -I if input parameter number I is out of range
02304                 1 if answer appears to be lower than lowest
02305                   search bound
02306                 2 if answer appears to be higher than greatest
02307                   search bound
02308                 3 if P + Q .ne. 1
02309                10 indicates error returned from cumgam.  See
02310                   references in cdfgam
02311 
02312      BOUND <-- Undefined if STATUS is 0
02313 
02314                Bound exceeded by parameter number I if STATUS
02315                is negative.
02316 
02317                Lower search bound if STATUS is 1.
02318 
02319                Upper search bound if STATUS is 2.
02320 
02321 
02322                               Method
02323 
02324 
02325      Formula    26.4.19   of Abramowitz  and     Stegun, Handbook  of
02326      Mathematical Functions   (1966) is used   to reduce the chisqure
02327      distribution to the incomplete distribution.
02328 
02329      Computation of other parameters involve a seach for a value that
02330      produces  the desired  value  of P.   The search relies  on  the
02331      monotinicity of P with the other parameter.
02332 
02333 **********************************************************************/
02334 {
02335 #define tol (1.0e-8)
02336 #define atol (1.0e-50)
02337 #define zero (1.0e-300)
02338 #define inf 1.0e300
02339 static int K1 = 1;
02340 static double K2 = 0.0e0;
02341 static double K4 = 0.5e0;
02342 static double K5 = 5.0e0;
02343 static double fx,cum,ccum,pq,porq;
02344 static unsigned long qhi,qleft,qporq;
02345 static double T3,T6,T7,T8,T9,T10,T11;
02346 /*
02347      ..
02348      .. Executable Statements ..
02349 */
02350 /*
02351      Check arguments
02352 */
02353     if(!(*which < 1 || *which > 3)) goto S30;
02354     if(!(*which < 1)) goto S10;
02355     *bound = 1.0e0;
02356     goto S20;
02357 S10:
02358     *bound = 3.0e0;
02359 S20:
02360     *status = -1;
02361     return;
02362 S30:
02363     if(*which == 1) goto S70;
02364 /*
02365      P
02366 */
02367     if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
02368     if(!(*p < 0.0e0)) goto S40;
02369     *bound = 0.0e0;
02370     goto S50;
02371 S40:
02372     *bound = 1.0e0;
02373 S50:
02374     *status = -2;
02375     return;
02376 S70:
02377 S60:
02378     if(*which == 1) goto S110;
02379 /*
02380      Q
02381 */
02382     if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
02383     if(!(*q <= 0.0e0)) goto S80;
02384     *bound = 0.0e0;
02385     goto S90;
02386 S80:
02387     *bound = 1.0e0;
02388 S90:
02389     *status = -3;
02390     return;
02391 S110:
02392 S100:
02393     if(*which == 2) goto S130;
02394 /*
02395      X
02396 */
02397     if(!(*x < 0.0e0)) goto S120;
02398     *bound = 0.0e0;
02399     *status = -4;
02400     return;
02401 S130:
02402 S120:
02403     if(*which == 3) goto S150;
02404 /*
02405      DF
02406 */
02407     if(!(*df <= 0.0e0)) goto S140;
02408     *bound = 0.0e0;
02409     *status = -5;
02410     return;
02411 S150:
02412 S140:
02413     if(*which == 1) goto S190;
02414 /*
02415      P + Q
02416 */
02417     pq = *p+*q;
02418     if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S180;
02419     if(!(pq < 0.0e0)) goto S160;
02420     *bound = 0.0e0;
02421     goto S170;
02422 S160:
02423     *bound = 1.0e0;
02424 S170:
02425     *status = 3;
02426     return;
02427 S190:
02428 S180:
02429     if(*which == 1) goto S220;
02430 /*
02431      Select the minimum of P or Q
02432 */
02433     qporq = *p <= *q;
02434     if(!qporq) goto S200;
02435     porq = *p;
02436     goto S210;
02437 S200:
02438     porq = *q;
02439 S220:
02440 S210:
02441 /*
02442      Calculate ANSWERS
02443 */
02444     if(1 == *which) {
02445 /*
02446      Calculating P and Q
02447 */
02448         *status = 0;
02449         cumchi(x,df,p,q);
02450         if(porq > 1.5e0) {
02451             *status = 10;
02452             return;
02453         }
02454     }
02455     else if(2 == *which) {
02456 /*
02457      Calculating X
02458 */
02459         *x = 5.0e0;
02460         T3 = inf;
02461         T6 = atol;
02462         T7 = tol;
02463         dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7);
02464         *status = 0;
02465         dinvr(status,x,&fx,&qleft,&qhi);
02466 S230:
02467         if(!(*status == 1)) goto S270;
02468         cumchi(x,df,&cum,&ccum);
02469         if(!qporq) goto S240;
02470         fx = cum-*p;
02471         goto S250;
02472 S240:
02473         fx = ccum-*q;
02474 S250:
02475         if(!(fx+porq > 1.5e0)) goto S260;
02476         *status = 10;
02477         return;
02478 S260:
02479         dinvr(status,x,&fx,&qleft,&qhi);
02480         goto S230;
02481 S270:
02482         if(!(*status == -1)) goto S300;
02483         if(!qleft) goto S280;
02484         *status = 1;
02485         *bound = 0.0e0;
02486         goto S290;
02487 S280:
02488         *status = 2;
02489         *bound = inf;
02490 S300:
02491 S290:
02492         ;
02493     }
02494     else if(3 == *which) {
02495 /*
02496      Calculating DF
02497 */
02498         *df = 5.0e0;
02499         T8 = zero;
02500         T9 = inf;
02501         T10 = atol;
02502         T11 = tol;
02503         dstinv(&T8,&T9,&K4,&K4,&K5,&T10,&T11);
02504         *status = 0;
02505         dinvr(status,df,&fx,&qleft,&qhi);
02506 S310:
02507         if(!(*status == 1)) goto S350;
02508         cumchi(x,df,&cum,&ccum);
02509         if(!qporq) goto S320;
02510         fx = cum-*p;
02511         goto S330;
02512 S320:
02513         fx = ccum-*q;
02514 S330:
02515         if(!(fx+porq > 1.5e0)) goto S340;
02516         *status = 10;
02517         return;
02518 S340:
02519         dinvr(status,df,&fx,&qleft,&qhi);
02520         goto S310;
02521 S350:
02522         if(!(*status == -1)) goto S380;
02523         if(!qleft) goto S360;
02524         *status = 1;
02525         *bound = zero;
02526         goto S370;
02527 S360:
02528         *status = 2;
02529         *bound = inf;
02530 S370:
02531         ;
02532     }
02533 S380:
02534     return;
02535 #undef tol
02536 #undef atol
02537 #undef zero
02538 #undef inf
02539 } /* END */

void cdfchn	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 2542 of file nifti_stats.c.

References cumchn(), dinvr(), dstinv(), and p.

Referenced by chsqnonc_pq2s(), and chsqnonc_s2pq().

02565                           : 1..4
02566                iwhich = 1 : Calculate P and Q from X and DF
02567                iwhich = 2 : Calculate X from P,DF and PNONC
02568                iwhich = 3 : Calculate DF from P,X and PNONC
02569                iwhich = 3 : Calculate PNONC from P,X and DF
02570 
02571      P <--> The integral from 0 to X of the non-central chi-square
02572             distribution.
02573             Input range: [0, 1-1E-16).
02574 
02575      Q <--> 1-P.
02576             Q is not used by this subroutine and is only included
02577             for similarity with other cdf* routines.
02578 
02579      X <--> Upper limit of integration of the non-central
02580             chi-square distribution.
02581             Input range: [0, +infinity).
02582             Search range: [0,1E300]
02583 
02584      DF <--> Degrees of freedom of the non-central
02585              chi-square distribution.
02586              Input range: (0, +infinity).
02587              Search range: [ 1E-300, 1E300]
02588 
02589      PNONC <--> Non-centrality parameter of the non-central
02590                 chi-square distribution.
02591                 Input range: [0, +infinity).
02592                 Search range: [0,1E4]
02593 
02594      STATUS <-- 0 if calculation completed correctly
02595                -I if input parameter number I is out of range
02596                 1 if answer appears to be lower than lowest
02597                   search bound
02598                 2 if answer appears to be higher than greatest
02599                   search bound
02600 
02601      BOUND <-- Undefined if STATUS is 0
02602 
02603                Bound exceeded by parameter number I if STATUS
02604                is negative.
02605 
02606                Lower search bound if STATUS is 1.
02607 
02608                Upper search bound if STATUS is 2.
02609 
02610 
02611                               Method
02612 
02613 
02614      Formula  26.4.25   of   Abramowitz   and   Stegun,  Handbook  of
02615      Mathematical  Functions (1966) is used to compute the cumulative
02616      distribution function.
02617 
02618      Computation of other parameters involve a seach for a value that
02619      produces  the desired  value  of P.   The search relies  on  the
02620      monotinicity of P with the other parameter.
02621 
02622 
02623                             WARNING
02624 
02625      The computation time  required for this  routine is proportional
02626      to the noncentrality  parameter  (PNONC).  Very large  values of
02627      this parameter can consume immense  computer resources.  This is
02628      why the search range is bounded by 10,000.
02629 
02630 **********************************************************************/
02631 {
02632 #define tent4 1.0e4
02633 #define tol (1.0e-8)
02634 #define atol (1.0e-50)
02635 #define zero (1.0e-300)
02636 #define one (1.0e0-1.0e-16)
02637 #define inf 1.0e300
02638 static double K1 = 0.0e0;
02639 static double K3 = 0.5e0;
02640 static double K4 = 5.0e0;
02641 static double fx,cum,ccum;
02642 static unsigned long qhi,qleft;
02643 static double T2,T5,T6,T7,T8,T9,T10,T11,T12,T13;
02644 /*
02645      ..
02646      .. Executable Statements ..
02647 */
02648 /*
02649      Check arguments
02650 */
02651     if(!(*which < 1 || *which > 4)) goto S30;
02652     if(!(*which < 1)) goto S10;
02653     *bound = 1.0e0;
02654     goto S20;
02655 S10:
02656     *bound = 4.0e0;
02657 S20:
02658     *status = -1;
02659     return;
02660 S30:
02661     if(*which == 1) goto S70;
02662 /*
02663      P
02664 */
02665     if(!(*p < 0.0e0 || *p > one)) goto S60;
02666     if(!(*p < 0.0e0)) goto S40;
02667     *bound = 0.0e0;
02668     goto S50;
02669 S40:
02670     *bound = one;
02671 S50:
02672     *status = -2;
02673     return;
02674 S70:
02675 S60:
02676     if(*which == 2) goto S90;
02677 /*
02678      X
02679 */
02680     if(!(*x < 0.0e0)) goto S80;
02681     *bound = 0.0e0;
02682     *status = -4;
02683     return;
02684 S90:
02685 S80:
02686     if(*which == 3) goto S110;
02687 /*
02688      DF
02689 */
02690     if(!(*df <= 0.0e0)) goto S100;
02691     *bound = 0.0e0;
02692     *status = -5;
02693     return;
02694 S110:
02695 S100:
02696     if(*which == 4) goto S130;
02697 /*
02698      PNONC
02699 */
02700     if(!(*pnonc < 0.0e0)) goto S120;
02701     *bound = 0.0e0;
02702     *status = -6;
02703     return;
02704 S130:
02705 S120:
02706 /*
02707      Calculate ANSWERS
02708 */
02709     if(1 == *which) {
02710 /*
02711      Calculating P and Q
02712 */
02713         cumchn(x,df,pnonc,p,q);
02714         *status = 0;
02715     }
02716     else if(2 == *which) {
02717 /*
02718      Calculating X
02719 */
02720         *x = 5.0e0;
02721         T2 = inf;
02722         T5 = atol;
02723         T6 = tol;
02724         dstinv(&K1,&T2,&K3,&K3,&K4,&T5,&T6);
02725         *status = 0;
02726         dinvr(status,x,&fx,&qleft,&qhi);
02727 S140:
02728         if(!(*status == 1)) goto S150;
02729         cumchn(x,df,pnonc,&cum,&ccum);
02730         fx = cum-*p;
02731         dinvr(status,x,&fx,&qleft,&qhi);
02732         goto S140;
02733 S150:
02734         if(!(*status == -1)) goto S180;
02735         if(!qleft) goto S160;
02736         *status = 1;
02737         *bound = 0.0e0;
02738         goto S170;
02739 S160:
02740         *status = 2;
02741         *bound = inf;
02742 S180:
02743 S170:
02744         ;
02745     }
02746     else if(3 == *which) {
02747 /*
02748      Calculating DF
02749 */
02750         *df = 5.0e0;
02751         T7 = zero;
02752         T8 = inf;
02753         T9 = atol;
02754         T10 = tol;
02755         dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10);
02756         *status = 0;
02757         dinvr(status,df,&fx,&qleft,&qhi);
02758 S190:
02759         if(!(*status == 1)) goto S200;
02760         cumchn(x,df,pnonc,&cum,&ccum);
02761         fx = cum-*p;
02762         dinvr(status,df,&fx,&qleft,&qhi);
02763         goto S190;
02764 S200:
02765         if(!(*status == -1)) goto S230;
02766         if(!qleft) goto S210;
02767         *status = 1;
02768         *bound = zero;
02769         goto S220;
02770 S210:
02771         *status = 2;
02772         *bound = inf;
02773 S230:
02774 S220:
02775         ;
02776     }
02777     else if(4 == *which) {
02778 /*
02779      Calculating PNONC
02780 */
02781         *pnonc = 5.0e0;
02782         T11 = tent4;
02783         T12 = atol;
02784         T13 = tol;
02785         dstinv(&K1,&T11,&K3,&K3,&K4,&T12,&T13);
02786         *status = 0;
02787         dinvr(status,pnonc,&fx,&qleft,&qhi);
02788 S240:
02789         if(!(*status == 1)) goto S250;
02790         cumchn(x,df,pnonc,&cum,&ccum);
02791         fx = cum-*p;
02792         dinvr(status,pnonc,&fx,&qleft,&qhi);
02793         goto S240;
02794 S250:
02795         if(!(*status == -1)) goto S280;
02796         if(!qleft) goto S260;
02797         *status = 1;
02798         *bound = zero;
02799         goto S270;
02800 S260:
02801         *status = 2;
02802         *bound = tent4;
02803 S270:
02804         ;
02805     }
02806 S280:
02807     return;
02808 #undef tent4
02809 #undef tol
02810 #undef atol
02811 #undef zero
02812 #undef one
02813 #undef inf
02814 } /* END */

void cdff	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 2817 of file nifti_stats.c.

References cumf(), dinvr(), dstinv(), p, and spmpar().

Referenced by fstat_p2t(), fstat_pq2s(), fstat_s2pq(), fstat_t2p(), and identify_repeats().

02840                           : 1..4
02841                iwhich = 1 : Calculate P and Q from F,DFN and DFD
02842                iwhich = 2 : Calculate F from P,Q,DFN and DFD
02843                iwhich = 3 : Calculate DFN from P,Q,F and DFD
02844                iwhich = 4 : Calculate DFD from P,Q,F and DFN
02845 
02846        P <--> The integral from 0 to F of the f-density.
02847               Input range: [0,1].
02848 
02849        Q <--> 1-P.
02850               Input range: (0, 1].
02851               P + Q = 1.0.
02852 
02853        F <--> Upper limit of integration of the f-density.
02854               Input range: [0, +infinity).
02855               Search range: [0,1E300]
02856 
02857      DFN < --> Degrees of freedom of the numerator sum of squares.
02858                Input range: (0, +infinity).
02859                Search range: [ 1E-300, 1E300]
02860 
02861      DFD < --> Degrees of freedom of the denominator sum of squares.
02862                Input range: (0, +infinity).
02863                Search range: [ 1E-300, 1E300]
02864 
02865      STATUS <-- 0 if calculation completed correctly
02866                -I if input parameter number I is out of range
02867                 1 if answer appears to be lower than lowest
02868                   search bound
02869                 2 if answer appears to be higher than greatest
02870                   search bound
02871                 3 if P + Q .ne. 1
02872 
02873      BOUND <-- Undefined if STATUS is 0
02874 
02875                Bound exceeded by parameter number I if STATUS
02876                is negative.
02877 
02878                Lower search bound if STATUS is 1.
02879 
02880                Upper search bound if STATUS is 2.
02881 
02882 
02883                               Method
02884 
02885 
02886      Formula   26.6.2   of   Abramowitz   and   Stegun,  Handbook  of
02887      Mathematical  Functions (1966) is used to reduce the computation
02888      of the  cumulative  distribution function for the  F  variate to
02889      that of an incomplete beta.
02890 
02891      Computation of other parameters involve a seach for a value that
02892      produces  the desired  value  of P.   The search relies  on  the
02893      monotinicity of P with the other parameter.
02894 
02895                               WARNING
02896 
02897      The value of the  cumulative  F distribution is  not necessarily
02898      monotone in  either degrees of freedom.  There  thus may  be two
02899      values  that  provide a given CDF  value.   This routine assumes
02900      monotonicity and will find an arbitrary one of the two values.
02901 
02902 **********************************************************************/
02903 {
02904 #define tol (1.0e-8)
02905 #define atol (1.0e-50)
02906 #define zero (1.0e-300)
02907 #define inf 1.0e300
02908 static int K1 = 1;
02909 static double K2 = 0.0e0;
02910 static double K4 = 0.5e0;
02911 static double K5 = 5.0e0;
02912 static double pq,fx,cum,ccum;
02913 static unsigned long qhi,qleft,qporq;
02914 static double T3,T6,T7,T8,T9,T10,T11,T12,T13,T14,T15;
02915 /*
02916      ..
02917      .. Executable Statements ..
02918 */
02919 /*
02920      Check arguments
02921 */
02922     if(!(*which < 1 || *which > 4)) goto S30;
02923     if(!(*which < 1)) goto S10;
02924     *bound = 1.0e0;
02925     goto S20;
02926 S10:
02927     *bound = 4.0e0;
02928 S20:
02929     *status = -1;
02930     return;
02931 S30:
02932     if(*which == 1) goto S70;
02933 /*
02934      P
02935 */
02936     if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
02937     if(!(*p < 0.0e0)) goto S40;
02938     *bound = 0.0e0;
02939     goto S50;
02940 S40:
02941     *bound = 1.0e0;
02942 S50:
02943     *status = -2;
02944     return;
02945 S70:
02946 S60:
02947     if(*which == 1) goto S110;
02948 /*
02949      Q
02950 */
02951     if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
02952     if(!(*q <= 0.0e0)) goto S80;
02953     *bound = 0.0e0;
02954     goto S90;
02955 S80:
02956     *bound = 1.0e0;
02957 S90:
02958     *status = -3;
02959     return;
02960 S110:
02961 S100:
02962     if(*which == 2) goto S130;
02963 /*
02964      F
02965 */
02966     if(!(*f < 0.0e0)) goto S120;
02967     *bound = 0.0e0;
02968     *status = -4;
02969     return;
02970 S130:
02971 S120:
02972     if(*which == 3) goto S150;
02973 /*
02974      DFN
02975 */
02976     if(!(*dfn <= 0.0e0)) goto S140;
02977     *bound = 0.0e0;
02978     *status = -5;
02979     return;
02980 S150:
02981 S140:
02982     if(*which == 4) goto S170;
02983 /*
02984      DFD
02985 */
02986     if(!(*dfd <= 0.0e0)) goto S160;
02987     *bound = 0.0e0;
02988     *status = -6;
02989     return;
02990 S170:
02991 S160:
02992     if(*which == 1) goto S210;
02993 /*
02994      P + Q
02995 */
02996     pq = *p+*q;
02997     if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S200;
02998     if(!(pq < 0.0e0)) goto S180;
02999     *bound = 0.0e0;
03000     goto S190;
03001 S180:
03002     *bound = 1.0e0;
03003 S190:
03004     *status = 3;
03005     return;
03006 S210:
03007 S200:
03008     if(!(*which == 1)) qporq = *p <= *q;
03009 /*
03010      Select the minimum of P or Q
03011      Calculate ANSWERS
03012 */
03013     if(1 == *which) {
03014 /*
03015      Calculating P
03016 */
03017         cumf(f,dfn,dfd,p,q);
03018         *status = 0;
03019     }
03020     else if(2 == *which) {
03021 /*
03022      Calculating F
03023 */
03024         *f = 5.0e0;
03025         T3 = inf;
03026         T6 = atol;
03027         T7 = tol;
03028         dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7);
03029         *status = 0;
03030         dinvr(status,f,&fx,&qleft,&qhi);
03031 S220:
03032         if(!(*status == 1)) goto S250;
03033         cumf(f,dfn,dfd,&cum,&ccum);
03034         if(!qporq) goto S230;
03035         fx = cum-*p;
03036         goto S240;
03037 S230:
03038         fx = ccum-*q;
03039 S240:
03040         dinvr(status,f,&fx,&qleft,&qhi);
03041         goto S220;
03042 S250:
03043         if(!(*status == -1)) goto S280;
03044         if(!qleft) goto S260;
03045         *status = 1;
03046         *bound = 0.0e0;
03047         goto S270;
03048 S260:
03049         *status = 2;
03050         *bound = inf;
03051 S280:
03052 S270:
03053         ;
03054     }
03055     else if(3 == *which) {
03056 /*
03057      Calculating DFN
03058 */
03059         *dfn = 5.0e0;
03060         T8 = zero;
03061         T9 = inf;
03062         T10 = atol;
03063         T11 = tol;
03064         dstinv(&T8,&T9,&K4,&K4,&K5,&T10,&T11);
03065         *status = 0;
03066         dinvr(status,dfn,&fx,&qleft,&qhi);
03067 S290:
03068         if(!(*status == 1)) goto S320;
03069         cumf(f,dfn,dfd,&cum,&ccum);
03070         if(!qporq) goto S300;
03071         fx = cum-*p;
03072         goto S310;
03073 S300:
03074         fx = ccum-*q;
03075 S310:
03076         dinvr(status,dfn,&fx,&qleft,&qhi);
03077         goto S290;
03078 S320:
03079         if(!(*status == -1)) goto S350;
03080         if(!qleft) goto S330;
03081         *status = 1;
03082         *bound = zero;
03083         goto S340;
03084 S330:
03085         *status = 2;
03086         *bound = inf;
03087 S350:
03088 S340:
03089         ;
03090     }
03091     else if(4 == *which) {
03092 /*
03093      Calculating DFD
03094 */
03095         *dfd = 5.0e0;
03096         T12 = zero;
03097         T13 = inf;
03098         T14 = atol;
03099         T15 = tol;
03100         dstinv(&T12,&T13,&K4,&K4,&K5,&T14,&T15);
03101         *status = 0;
03102         dinvr(status,dfd,&fx,&qleft,&qhi);
03103 S360:
03104         if(!(*status == 1)) goto S390;
03105         cumf(f,dfn,dfd,&cum,&ccum);
03106         if(!qporq) goto S370;
03107         fx = cum-*p;
03108         goto S380;
03109 S370:
03110         fx = ccum-*q;
03111 S380:
03112         dinvr(status,dfd,&fx,&qleft,&qhi);
03113         goto S360;
03114 S390:
03115         if(!(*status == -1)) goto S420;
03116         if(!qleft) goto S400;
03117         *status = 1;
03118         *bound = zero;
03119         goto S410;
03120 S400:
03121         *status = 2;
03122         *bound = inf;
03123 S410:
03124         ;
03125     }
03126 S420:
03127     return;
03128 #undef tol
03129 #undef atol
03130 #undef zero
03131 #undef inf
03132 } /* END */

void cdffnc	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	s,
		double *
	)	`[static]`

Definition at line 3135 of file nifti_stats.c.

References cumfnc(), dinvr(), dstinv(), and p.

Referenced by fnonc_pq2s(), and fnonc_s2pq().

03158                           : 1..5
03159                iwhich = 1 : Calculate P and Q from F,DFN,DFD and PNONC
03160                iwhich = 2 : Calculate F from P,Q,DFN,DFD and PNONC
03161                iwhich = 3 : Calculate DFN from P,Q,F,DFD and PNONC
03162                iwhich = 4 : Calculate DFD from P,Q,F,DFN and PNONC
03163                iwhich = 5 : Calculate PNONC from P,Q,F,DFN and DFD
03164 
03165        P <--> The integral from 0 to F of the non-central f-density.
03166               Input range: [0,1-1E-16).
03167 
03168        Q <--> 1-P.
03169               Q is not used by this subroutine and is only included
03170               for similarity with other cdf* routines.
03171 
03172        F <--> Upper limit of integration of the non-central f-density.
03173               Input range: [0, +infinity).
03174               Search range: [0,1E300]
03175 
03176      DFN < --> Degrees of freedom of the numerator sum of squares.
03177                Input range: (0, +infinity).
03178                Search range: [ 1E-300, 1E300]
03179 
03180      DFD < --> Degrees of freedom of the denominator sum of squares.
03181                Must be in range: (0, +infinity).
03182                Input range: (0, +infinity).
03183                Search range: [ 1E-300, 1E300]
03184 
03185      PNONC <-> The non-centrality parameter
03186                Input range: [0,infinity)
03187                Search range: [0,1E4]
03188 
03189      STATUS <-- 0 if calculation completed correctly
03190                -I if input parameter number I is out of range
03191                 1 if answer appears to be lower than lowest
03192                   search bound
03193                 2 if answer appears to be higher than greatest
03194                   search bound
03195                 3 if P + Q .ne. 1
03196 
03197      BOUND <-- Undefined if STATUS is 0
03198 
03199                Bound exceeded by parameter number I if STATUS
03200                is negative.
03201 
03202                Lower search bound if STATUS is 1.
03203 
03204                Upper search bound if STATUS is 2.
03205 
03206 
03207                               Method
03208 
03209 
03210      Formula  26.6.20   of   Abramowitz   and   Stegun,  Handbook  of
03211      Mathematical  Functions (1966) is used to compute the cumulative
03212      distribution function.
03213 
03214      Computation of other parameters involve a seach for a value that
03215      produces  the desired  value  of P.   The search relies  on  the
03216      monotinicity of P with the other parameter.
03217 
03218                             WARNING
03219 
03220      The computation time  required for this  routine is proportional
03221      to the noncentrality  parameter  (PNONC).  Very large  values of
03222      this parameter can consume immense  computer resources.  This is
03223      why the search range is bounded by 10,000.
03224 
03225                               WARNING
03226 
03227      The  value  of the  cumulative  noncentral F distribution is not
03228      necessarily monotone in either degrees  of freedom.  There  thus
03229      may be two values that provide a given  CDF value.  This routine
03230      assumes monotonicity  and will find  an arbitrary one of the two
03231      values.
03232 
03233 **********************************************************************/
03234 {
03235 #define tent4 1.0e4
03236 #define tol (1.0e-8)
03237 #define atol (1.0e-50)
03238 #define zero (1.0e-300)
03239 #define one (1.0e0-1.0e-16)
03240 #define inf 1.0e300
03241 static double K1 = 0.0e0;
03242 static double K3 = 0.5e0;
03243 static double K4 = 5.0e0;
03244 static double fx,cum,ccum;
03245 static unsigned long qhi,qleft;
03246 static double T2,T5,T6,T7,T8,T9,T10,T11,T12,T13,T14,T15,T16,T17;
03247 /*
03248      ..
03249      .. Executable Statements ..
03250 */
03251 /*
03252      Check arguments
03253 */
03254     if(!(*which < 1 || *which > 5)) goto S30;
03255     if(!(*which < 1)) goto S10;
03256     *bound = 1.0e0;
03257     goto S20;
03258 S10:
03259     *bound = 5.0e0;
03260 S20:
03261     *status = -1;
03262     return;
03263 S30:
03264     if(*which == 1) goto S70;
03265 /*
03266      P
03267 */
03268     if(!(*p < 0.0e0 || *p > one)) goto S60;
03269     if(!(*p < 0.0e0)) goto S40;
03270     *bound = 0.0e0;
03271     goto S50;
03272 S40:
03273     *bound = one;
03274 S50:
03275     *status = -2;
03276     return;
03277 S70:
03278 S60:
03279     if(*which == 2) goto S90;
03280 /*
03281      F
03282 */
03283     if(!(*f < 0.0e0)) goto S80;
03284     *bound = 0.0e0;
03285     *status = -4;
03286     return;
03287 S90:
03288 S80:
03289     if(*which == 3) goto S110;
03290 /*
03291      DFN
03292 */
03293     if(!(*dfn <= 0.0e0)) goto S100;
03294     *bound = 0.0e0;
03295     *status = -5;
03296     return;
03297 S110:
03298 S100:
03299     if(*which == 4) goto S130;
03300 /*
03301      DFD
03302 */
03303     if(!(*dfd <= 0.0e0)) goto S120;
03304     *bound = 0.0e0;
03305     *status = -6;
03306     return;
03307 S130:
03308 S120:
03309     if(*which == 5) goto S150;
03310 /*
03311      PHONC
03312 */
03313     if(!(*phonc < 0.0e0)) goto S140;
03314     *bound = 0.0e0;
03315     *status = -7;
03316     return;
03317 S150:
03318 S140:
03319 /*
03320      Calculate ANSWERS
03321 */
03322     if(1 == *which) {
03323 /*
03324      Calculating P
03325 */
03326         cumfnc(f,dfn,dfd,phonc,p,q);
03327         *status = 0;
03328     }
03329     else if(2 == *which) {
03330 /*
03331      Calculating F
03332 */
03333         *f = 5.0e0;
03334         T2 = inf;
03335         T5 = atol;
03336         T6 = tol;
03337         dstinv(&K1,&T2,&K3,&K3,&K4,&T5,&T6);
03338         *status = 0;
03339         dinvr(status,f,&fx,&qleft,&qhi);
03340 S160:
03341         if(!(*status == 1)) goto S170;
03342         cumfnc(f,dfn,dfd,phonc,&cum,&ccum);
03343         fx = cum-*p;
03344         dinvr(status,f,&fx,&qleft,&qhi);
03345         goto S160;
03346 S170:
03347         if(!(*status == -1)) goto S200;
03348         if(!qleft) goto S180;
03349         *status = 1;
03350         *bound = 0.0e0;
03351         goto S190;
03352 S180:
03353         *status = 2;
03354         *bound = inf;
03355 S200:
03356 S190:
03357         ;
03358     }
03359     else if(3 == *which) {
03360 /*
03361      Calculating DFN
03362 */
03363         *dfn = 5.0e0;
03364         T7 = zero;
03365         T8 = inf;
03366         T9 = atol;
03367         T10 = tol;
03368         dstinv(&T7,&T8,&K3,&K3,&K4,&T9,&T10);
03369         *status = 0;
03370         dinvr(status,dfn,&fx,&qleft,&qhi);
03371 S210:
03372         if(!(*status == 1)) goto S220;
03373         cumfnc(f,dfn,dfd,phonc,&cum,&ccum);
03374         fx = cum-*p;
03375         dinvr(status,dfn,&fx,&qleft,&qhi);
03376         goto S210;
03377 S220:
03378         if(!(*status == -1)) goto S250;
03379         if(!qleft) goto S230;
03380         *status = 1;
03381         *bound = zero;
03382         goto S240;
03383 S230:
03384         *status = 2;
03385         *bound = inf;
03386 S250:
03387 S240:
03388         ;
03389     }
03390     else if(4 == *which) {
03391 /*
03392      Calculating DFD
03393 */
03394         *dfd = 5.0e0;
03395         T11 = zero;
03396         T12 = inf;
03397         T13 = atol;
03398         T14 = tol;
03399         dstinv(&T11,&T12,&K3,&K3,&K4,&T13,&T14);
03400         *status = 0;
03401         dinvr(status,dfd,&fx,&qleft,&qhi);
03402 S260:
03403         if(!(*status == 1)) goto S270;
03404         cumfnc(f,dfn,dfd,phonc,&cum,&ccum);
03405         fx = cum-*p;
03406         dinvr(status,dfd,&fx,&qleft,&qhi);
03407         goto S260;
03408 S270:
03409         if(!(*status == -1)) goto S300;
03410         if(!qleft) goto S280;
03411         *status = 1;
03412         *bound = zero;
03413         goto S290;
03414 S280:
03415         *status = 2;
03416         *bound = inf;
03417 S300:
03418 S290:
03419         ;
03420     }
03421     else if(5 == *which) {
03422 /*
03423      Calculating PHONC
03424 */
03425         *phonc = 5.0e0;
03426         T15 = tent4;
03427         T16 = atol;
03428         T17 = tol;
03429         dstinv(&K1,&T15,&K3,&K3,&K4,&T16,&T17);
03430         *status = 0;
03431         dinvr(status,phonc,&fx,&qleft,&qhi);
03432 S310:
03433         if(!(*status == 1)) goto S320;
03434         cumfnc(f,dfn,dfd,phonc,&cum,&ccum);
03435         fx = cum-*p;
03436         dinvr(status,phonc,&fx,&qleft,&qhi);
03437         goto S310;
03438 S320:
03439         if(!(*status == -1)) goto S350;
03440         if(!qleft) goto S330;
03441         *status = 1;
03442         *bound = 0.0e0;
03443         goto S340;
03444 S330:
03445         *status = 2;
03446         *bound = tent4;
03447 S340:
03448         ;
03449     }
03450 S350:
03451     return;
03452 #undef tent4
03453 #undef tol
03454 #undef atol
03455 #undef zero
03456 #undef one
03457 #undef inf
03458 } /* END */

void cdfgam	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 3461 of file nifti_stats.c.

References cumgam(), dinvr(), dstinv(), gaminv(), p, scale, shape, and spmpar().

Referenced by gamma_p2t(), gamma_pq2s(), gamma_s2pq(), and gamma_t2p().

03484                           : 1..4
03485                iwhich = 1 : Calculate P and Q from X,SHAPE and SCALE
03486                iwhich = 2 : Calculate X from P,Q,SHAPE and SCALE
03487                iwhich = 3 : Calculate SHAPE from P,Q,X and SCALE
03488                iwhich = 4 : Calculate SCALE from P,Q,X and SHAPE
03489 
03490      P <--> The integral from 0 to X of the gamma density.
03491             Input range: [0,1].
03492 
03493      Q <--> 1-P.
03494             Input range: (0, 1].
03495             P + Q = 1.0.
03496 
03497      X <--> The upper limit of integration of the gamma density.
03498             Input range: [0, +infinity).
03499             Search range: [0,1E300]
03500 
03501      SHAPE <--> The shape parameter of the gamma density.
03502                 Input range: (0, +infinity).
03503                 Search range: [1E-300,1E300]
03504 
03505      SCALE <--> The scale parameter of the gamma density.
03506                 Input range: (0, +infinity).
03507                 Search range: (1E-300,1E300]
03508 
03509      STATUS <-- 0 if calculation completed correctly
03510                -I if input parameter number I is out of range
03511                 1 if answer appears to be lower than lowest
03512                   search bound
03513                 2 if answer appears to be higher than greatest
03514                   search bound
03515                 3 if P + Q .ne. 1
03516                 10 if the gamma or inverse gamma routine cannot
03517                    compute the answer.  Usually happens only for
03518                    X and SHAPE very large (gt 1E10 or more)
03519 
03520      BOUND <-- Undefined if STATUS is 0
03521 
03522                Bound exceeded by parameter number I if STATUS
03523                is negative.
03524 
03525                Lower search bound if STATUS is 1.
03526 
03527                Upper search bound if STATUS is 2.
03528 
03529 
03530                               Method
03531 
03532 
03533      Cumulative distribution function (P) is calculated directly by
03534      the code associated with:
03535 
03536      DiDinato, A. R. and Morris, A. H. Computation of the  incomplete
03537      gamma function  ratios  and their  inverse.   ACM  Trans.  Math.
03538      Softw. 12 (1986), 377-393.
03539 
03540      Computation of other parameters involve a seach for a value that
03541      produces  the desired  value  of P.   The search relies  on  the
03542      monotinicity of P with the other parameter.
03543 
03544 
03545                               Note
03546 
03547 
03548 
03549      The gamma density is proportional to
03550        T**(SHAPE - 1) * EXP(- SCALE * T)
03551 
03552 **********************************************************************/
03553 {
03554 #define tol (1.0e-8)
03555 #define atol (1.0e-50)
03556 #define zero (1.0e-300)
03557 #define inf 1.0e300
03558 static int K1 = 1;
03559 static double K5 = 0.5e0;
03560 static double K6 = 5.0e0;
03561 static double xx,fx,xscale,cum,ccum,pq,porq;
03562 static int ierr;
03563 static unsigned long qhi,qleft,qporq;
03564 static double T2,T3,T4,T7,T8,T9;
03565 /*
03566      ..
03567      .. Executable Statements ..
03568 */
03569 /*
03570      Check arguments
03571 */
03572     if(!(*which < 1 || *which > 4)) goto S30;
03573     if(!(*which < 1)) goto S10;
03574     *bound = 1.0e0;
03575     goto S20;
03576 S10:
03577     *bound = 4.0e0;
03578 S20:
03579     *status = -1;
03580     return;
03581 S30:
03582     if(*which == 1) goto S70;
03583 /*
03584      P
03585 */
03586     if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
03587     if(!(*p < 0.0e0)) goto S40;
03588     *bound = 0.0e0;
03589     goto S50;
03590 S40:
03591     *bound = 1.0e0;
03592 S50:
03593     *status = -2;
03594     return;
03595 S70:
03596 S60:
03597     if(*which == 1) goto S110;
03598 /*
03599      Q
03600 */
03601     if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
03602     if(!(*q <= 0.0e0)) goto S80;
03603     *bound = 0.0e0;
03604     goto S90;
03605 S80:
03606     *bound = 1.0e0;
03607 S90:
03608     *status = -3;
03609     return;
03610 S110:
03611 S100:
03612     if(*which == 2) goto S130;
03613 /*
03614      X
03615 */
03616     if(!(*x < 0.0e0)) goto S120;
03617     *bound = 0.0e0;
03618     *status = -4;
03619     return;
03620 S130:
03621 S120:
03622     if(*which == 3) goto S150;
03623 /*
03624      SHAPE
03625 */
03626     if(!(*shape <= 0.0e0)) goto S140;
03627     *bound = 0.0e0;
03628     *status = -5;
03629     return;
03630 S150:
03631 S140:
03632     if(*which == 4) goto S170;
03633 /*
03634      SCALE
03635 */
03636     if(!(*scale <= 0.0e0)) goto S160;
03637     *bound = 0.0e0;
03638     *status = -6;
03639     return;
03640 S170:
03641 S160:
03642     if(*which == 1) goto S210;
03643 /*
03644      P + Q
03645 */
03646     pq = *p+*q;
03647     if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S200;
03648     if(!(pq < 0.0e0)) goto S180;
03649     *bound = 0.0e0;
03650     goto S190;
03651 S180:
03652     *bound = 1.0e0;
03653 S190:
03654     *status = 3;
03655     return;
03656 S210:
03657 S200:
03658     if(*which == 1) goto S240;
03659 /*
03660      Select the minimum of P or Q
03661 */
03662     qporq = *p <= *q;
03663     if(!qporq) goto S220;
03664     porq = *p;
03665     goto S230;
03666 S220:
03667     porq = *q;
03668 S240:
03669 S230:
03670 /*
03671      Calculate ANSWERS
03672 */
03673     if(1 == *which) {
03674 /*
03675      Calculating P
03676 */
03677         *status = 0;
03678         xscale = *x**scale;
03679         cumgam(&xscale,shape,p,q);
03680         if(porq > 1.5e0) *status = 10;
03681     }
03682     else if(2 == *which) {
03683 /*
03684      Computing X
03685 */
03686         T2 = -1.0e0;
03687         gaminv(shape,&xx,&T2,p,q,&ierr);
03688         if(ierr < 0.0e0) {
03689             *status = 10;
03690             return;
03691         }
03692         else  {
03693             *x = xx/ *scale;
03694             *status = 0;
03695         }
03696     }
03697     else if(3 == *which) {
03698 /*
03699      Computing SHAPE
03700 */
03701         *shape = 5.0e0;
03702         xscale = *x**scale;
03703         T3 = zero;
03704         T4 = inf;
03705         T7 = atol;
03706         T8 = tol;
03707         dstinv(&T3,&T4,&K5,&K5,&K6,&T7,&T8);
03708         *status = 0;
03709         dinvr(status,shape,&fx,&qleft,&qhi);
03710 S250:
03711         if(!(*status == 1)) goto S290;
03712         cumgam(&xscale,shape,&cum,&ccum);
03713         if(!qporq) goto S260;
03714         fx = cum-*p;
03715         goto S270;
03716 S260:
03717         fx = ccum-*q;
03718 S270:
03719         if(!(qporq && cum > 1.5e0 || !qporq && ccum > 1.5e0)) goto S280;
03720         *status = 10;
03721         return;
03722 S280:
03723         dinvr(status,shape,&fx,&qleft,&qhi);
03724         goto S250;
03725 S290:
03726         if(!(*status == -1)) goto S320;
03727         if(!qleft) goto S300;
03728         *status = 1;
03729         *bound = zero;
03730         goto S310;
03731 S300:
03732         *status = 2;
03733         *bound = inf;
03734 S320:
03735 S310:
03736         ;
03737     }
03738     else if(4 == *which) {
03739 /*
03740      Computing SCALE
03741 */
03742         T9 = -1.0e0;
03743         gaminv(shape,&xx,&T9,p,q,&ierr);
03744         if(ierr < 0.0e0) {
03745             *status = 10;
03746             return;
03747         }
03748         else  {
03749             *scale = xx/ *x;
03750             *status = 0;
03751         }
03752     }
03753     return;
03754 #undef tol
03755 #undef atol
03756 #undef zero
03757 #undef inf
03758 } /* END */

void cdfnbn	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 3761 of file nifti_stats.c.

References cumnbn(), dinvr(), dstinv(), dstzr(), dzror(), p, spmpar(), and xn.

03793                           : 1..4
03794                iwhich = 1 : Calculate P and Q from S,XN,PR and OMPR
03795                iwhich = 2 : Calculate S from P,Q,XN,PR and OMPR
03796                iwhich = 3 : Calculate XN from P,Q,S,PR and OMPR
03797                iwhich = 4 : Calculate PR and OMPR from P,Q,S and XN
03798 
03799      P <--> The cumulation from 0 to S of the  negative
03800             binomial distribution.
03801             Input range: [0,1].
03802 
03803      Q <--> 1-P.
03804             Input range: (0, 1].
03805             P + Q = 1.0.
03806 
03807      S <--> The upper limit of cumulation of the binomial distribution.
03808             There are F or fewer failures before the XNth success.
03809             Input range: [0, +infinity).
03810             Search range: [0, 1E300]
03811 
03812      XN  <--> The number of successes.
03813               Input range: [0, +infinity).
03814               Search range: [0, 1E300]
03815 
03816      PR  <--> The probability of success in each binomial trial.
03817               Input range: [0,1].
03818               Search range: [0,1].
03819 
03820      OMPR  <--> 1-PR
03821               Input range: [0,1].
03822               Search range: [0,1]
03823               PR + OMPR = 1.0
03824 
03825      STATUS <-- 0 if calculation completed correctly
03826                -I if input parameter number I is out of range
03827                 1 if answer appears to be lower than lowest
03828                   search bound
03829                 2 if answer appears to be higher than greatest
03830                   search bound
03831                 3 if P + Q .ne. 1
03832                 4 if PR + OMPR .ne. 1
03833 
03834      BOUND <-- Undefined if STATUS is 0
03835 
03836                Bound exceeded by parameter number I if STATUS
03837                is negative.
03838 
03839                Lower search bound if STATUS is 1.
03840 
03841                Upper search bound if STATUS is 2.
03842 
03843 
03844                               Method
03845 
03846 
03847      Formula   26.5.26   of   Abramowitz  and  Stegun,  Handbook   of
03848      Mathematical Functions (1966) is used  to  reduce calculation of
03849      the cumulative distribution  function to that of  an  incomplete
03850      beta.
03851 
03852      Computation of other parameters involve a seach for a value that
03853      produces  the desired  value  of P.   The search relies  on  the
03854      monotinicity of P with the other parameter.
03855 
03856 **********************************************************************/
03857 {
03858 #define tol (1.0e-8)
03859 #define atol (1.0e-50)
03860 #define inf 1.0e300
03861 #define one 1.0e0
03862 static int K1 = 1;
03863 static double K2 = 0.0e0;
03864 static double K4 = 0.5e0;
03865 static double K5 = 5.0e0;
03866 static double K11 = 1.0e0;
03867 static double fx,xhi,xlo,pq,prompr,cum,ccum;
03868 static unsigned long qhi,qleft,qporq;
03869 static double T3,T6,T7,T8,T9,T10,T12,T13;
03870 /*
03871      ..
03872      .. Executable Statements ..
03873 */
03874 /*
03875      Check arguments
03876 */
03877     if(!(*which < 1 || *which > 4)) goto S30;
03878     if(!(*which < 1)) goto S10;
03879     *bound = 1.0e0;
03880     goto S20;
03881 S10:
03882     *bound = 4.0e0;
03883 S20:
03884     *status = -1;
03885     return;
03886 S30:
03887     if(*which == 1) goto S70;
03888 /*
03889      P
03890 */
03891     if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
03892     if(!(*p < 0.0e0)) goto S40;
03893     *bound = 0.0e0;
03894     goto S50;
03895 S40:
03896     *bound = 1.0e0;
03897 S50:
03898     *status = -2;
03899     return;
03900 S70:
03901 S60:
03902     if(*which == 1) goto S110;
03903 /*
03904      Q
03905 */
03906     if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
03907     if(!(*q <= 0.0e0)) goto S80;
03908     *bound = 0.0e0;
03909     goto S90;
03910 S80:
03911     *bound = 1.0e0;
03912 S90:
03913     *status = -3;
03914     return;
03915 S110:
03916 S100:
03917     if(*which == 2) goto S130;
03918 /*
03919      S
03920 */
03921     if(!(*s < 0.0e0)) goto S120;
03922     *bound = 0.0e0;
03923     *status = -4;
03924     return;
03925 S130:
03926 S120:
03927     if(*which == 3) goto S150;
03928 /*
03929      XN
03930 */
03931     if(!(*xn < 0.0e0)) goto S140;
03932     *bound = 0.0e0;
03933     *status = -5;
03934     return;
03935 S150:
03936 S140:
03937     if(*which == 4) goto S190;
03938 /*
03939      PR
03940 */
03941     if(!(*pr < 0.0e0 || *pr > 1.0e0)) goto S180;
03942     if(!(*pr < 0.0e0)) goto S160;
03943     *bound = 0.0e0;
03944     goto S170;
03945 S160:
03946     *bound = 1.0e0;
03947 S170:
03948     *status = -6;
03949     return;
03950 S190:
03951 S180:
03952     if(*which == 4) goto S230;
03953 /*
03954      OMPR
03955 */
03956     if(!(*ompr < 0.0e0 || *ompr > 1.0e0)) goto S220;
03957     if(!(*ompr < 0.0e0)) goto S200;
03958     *bound = 0.0e0;
03959     goto S210;
03960 S200:
03961     *bound = 1.0e0;
03962 S210:
03963     *status = -7;
03964     return;
03965 S230:
03966 S220:
03967     if(*which == 1) goto S270;
03968 /*
03969      P + Q
03970 */
03971     pq = *p+*q;
03972     if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S260;
03973     if(!(pq < 0.0e0)) goto S240;
03974     *bound = 0.0e0;
03975     goto S250;
03976 S240:
03977     *bound = 1.0e0;
03978 S250:
03979     *status = 3;
03980     return;
03981 S270:
03982 S260:
03983     if(*which == 4) goto S310;
03984 /*
03985      PR + OMPR
03986 */
03987     prompr = *pr+*ompr;
03988     if(!(fabs(prompr-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S300;
03989     if(!(prompr < 0.0e0)) goto S280;
03990     *bound = 0.0e0;
03991     goto S290;
03992 S280:
03993     *bound = 1.0e0;
03994 S290:
03995     *status = 4;
03996     return;
03997 S310:
03998 S300:
03999     if(!(*which == 1)) qporq = *p <= *q;
04000 /*
04001      Select the minimum of P or Q
04002      Calculate ANSWERS
04003 */
04004     if(1 == *which) {
04005 /*
04006      Calculating P
04007 */
04008         cumnbn(s,xn,pr,ompr,p,q);
04009         *status = 0;
04010     }
04011     else if(2 == *which) {
04012 /*
04013      Calculating S
04014 */
04015         *s = 5.0e0;
04016         T3 = inf;
04017         T6 = atol;
04018         T7 = tol;
04019         dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7);
04020         *status = 0;
04021         dinvr(status,s,&fx,&qleft,&qhi);
04022 S320:
04023         if(!(*status == 1)) goto S350;
04024         cumnbn(s,xn,pr,ompr,&cum,&ccum);
04025         if(!qporq) goto S330;
04026         fx = cum-*p;
04027         goto S340;
04028 S330:
04029         fx = ccum-*q;
04030 S340:
04031         dinvr(status,s,&fx,&qleft,&qhi);
04032         goto S320;
04033 S350:
04034         if(!(*status == -1)) goto S380;
04035         if(!qleft) goto S360;
04036         *status = 1;
04037         *bound = 0.0e0;
04038         goto S370;
04039 S360:
04040         *status = 2;
04041         *bound = inf;
04042 S380:
04043 S370:
04044         ;
04045     }
04046     else if(3 == *which) {
04047 /*
04048      Calculating XN
04049 */
04050         *xn = 5.0e0;
04051         T8 = inf;
04052         T9 = atol;
04053         T10 = tol;
04054         dstinv(&K2,&T8,&K4,&K4,&K5,&T9,&T10);
04055         *status = 0;
04056         dinvr(status,xn,&fx,&qleft,&qhi);
04057 S390:
04058         if(!(*status == 1)) goto S420;
04059         cumnbn(s,xn,pr,ompr,&cum,&ccum);
04060         if(!qporq) goto S400;
04061         fx = cum-*p;
04062         goto S410;
04063 S400:
04064         fx = ccum-*q;
04065 S410:
04066         dinvr(status,xn,&fx,&qleft,&qhi);
04067         goto S390;
04068 S420:
04069         if(!(*status == -1)) goto S450;
04070         if(!qleft) goto S430;
04071         *status = 1;
04072         *bound = 0.0e0;
04073         goto S440;
04074 S430:
04075         *status = 2;
04076         *bound = inf;
04077 S450:
04078 S440:
04079         ;
04080     }
04081     else if(4 == *which) {
04082 /*
04083      Calculating PR and OMPR
04084 */
04085         T12 = atol;
04086         T13 = tol;
04087         dstzr(&K2,&K11,&T12,&T13);
04088         if(!qporq) goto S480;
04089         *status = 0;
04090         dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi);
04091         *ompr = one-*pr;
04092 S460:
04093         if(!(*status == 1)) goto S470;
04094         cumnbn(s,xn,pr,ompr,&cum,&ccum);
04095         fx = cum-*p;
04096         dzror(status,pr,&fx,&xlo,&xhi,&qleft,&qhi);
04097         *ompr = one-*pr;
04098         goto S460;
04099 S470:
04100         goto S510;
04101 S480:
04102         *status = 0;
04103         dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi);
04104         *pr = one-*ompr;
04105 S490:
04106         if(!(*status == 1)) goto S500;
04107         cumnbn(s,xn,pr,ompr,&cum,&ccum);
04108         fx = ccum-*q;
04109         dzror(status,ompr,&fx,&xlo,&xhi,&qleft,&qhi);
04110         *pr = one-*ompr;
04111         goto S490;
04112 S510:
04113 S500:
04114         if(!(*status == -1)) goto S540;
04115         if(!qleft) goto S520;
04116         *status = 1;
04117         *bound = 0.0e0;
04118         goto S530;
04119 S520:
04120         *status = 2;
04121         *bound = 1.0e0;
04122 S530:
04123         ;
04124     }
04125 S540:
04126     return;
04127 #undef tol
04128 #undef atol
04129 #undef inf
04130 #undef one
04131 } /* END */

void cdfnor	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 4134 of file nifti_stats.c.

References cumnor(), dinvnr(), p, and spmpar().

Referenced by initialize(), normal_p2t(), normal_t2p(), and threshold_data().

04157                 : 1..4
04158                iwhich = 1 : Calculate P and Q from X,MEAN and SD
04159                iwhich = 2 : Calculate X from P,Q,MEAN and SD
04160                iwhich = 3 : Calculate MEAN from P,Q,X and SD
04161                iwhich = 4 : Calculate SD from P,Q,X and MEAN
04162 
04163      P <--> The integral from -infinity to X of the normal density.
04164             Input range: (0,1].
04165 
04166      Q <--> 1-P.
04167             Input range: (0, 1].
04168             P + Q = 1.0.
04169 
04170      X < --> Upper limit of integration of the normal-density.
04171              Input range: ( -infinity, +infinity)
04172 
04173      MEAN <--> The mean of the normal density.
04174                Input range: (-infinity, +infinity)
04175 
04176      SD <--> Standard Deviation of the normal density.
04177              Input range: (0, +infinity).
04178 
04179      STATUS <-- 0 if calculation completed correctly
04180                -I if input parameter number I is out of range
04181                 1 if answer appears to be lower than lowest
04182                   search bound
04183                 2 if answer appears to be higher than greatest
04184                   search bound
04185                 3 if P + Q .ne. 1
04186 
04187      BOUND <-- Undefined if STATUS is 0
04188 
04189                Bound exceeded by parameter number I if STATUS
04190                is negative.
04191 
04192                Lower search bound if STATUS is 1.
04193 
04194                Upper search bound if STATUS is 2.
04195 
04196 
04197                               Method
04198 
04199 
04200 
04201 
04202      A slightly modified version of ANORM from
04203 
04204      Cody, W.D. (1993). "ALGORITHM 715: SPECFUN - A Portabel FORTRAN
04205      Package of Special Function Routines and Test Drivers"
04206      acm Transactions on Mathematical Software. 19, 22-32.
04207 
04208      is used to calulate the  cumulative standard normal distribution.
04209 
04210      The rational functions from pages  90-95  of Kennedy and Gentle,
04211      Statistical  Computing,  Marcel  Dekker, NY,  1980 are  used  as
04212      starting values to Newton's Iterations which compute the inverse
04213      standard normal.  Therefore no  searches  are necessary for  any
04214      parameter.
04215 
04216      For X < -15, the asymptotic expansion for the normal is used  as
04217      the starting value in finding the inverse standard normal.
04218      This is formula 26.2.12 of Abramowitz and Stegun.
04219 
04220 
04221                               Note
04222 
04223 
04224       The normal density is proportional to
04225       exp( - 0.5 * (( X - MEAN)/SD)**2)
04226 
04227 **********************************************************************/
04228 {
04229 static int K1 = 1;
04230 static double z,pq;
04231 /*
04232      ..
04233      .. Executable Statements ..
04234 */
04235 /*
04236      Check arguments
04237 */
04238     *status = 0;
04239     if(!(*which < 1 || *which > 4)) goto S30;
04240     if(!(*which < 1)) goto S10;
04241     *bound = 1.0e0;
04242     goto S20;
04243 S10:
04244     *bound = 4.0e0;
04245 S20:
04246     *status = -1;
04247     return;
04248 S30:
04249     if(*which == 1) goto S70;
04250 /*
04251      P
04252 */
04253     if(!(*p <= 0.0e0 || *p > 1.0e0)) goto S60;
04254     if(!(*p <= 0.0e0)) goto S40;
04255     *bound = 0.0e0;
04256     goto S50;
04257 S40:
04258     *bound = 1.0e0;
04259 S50:
04260     *status = -2;
04261     return;
04262 S70:
04263 S60:
04264     if(*which == 1) goto S110;
04265 /*
04266      Q
04267 */
04268     if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
04269     if(!(*q <= 0.0e0)) goto S80;
04270     *bound = 0.0e0;
04271     goto S90;
04272 S80:
04273     *bound = 1.0e0;
04274 S90:
04275     *status = -3;
04276     return;
04277 S110:
04278 S100:
04279     if(*which == 1) goto S150;
04280 /*
04281      P + Q
04282 */
04283     pq = *p+*q;
04284     if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S140;
04285     if(!(pq < 0.0e0)) goto S120;
04286     *bound = 0.0e0;
04287     goto S130;
04288 S120:
04289     *bound = 1.0e0;
04290 S130:
04291     *status = 3;
04292     return;
04293 S150:
04294 S140:
04295     if(*which == 4) goto S170;
04296 /*
04297      SD
04298 */
04299     if(!(*sd <= 0.0e0)) goto S160;
04300     *bound = 0.0e0;
04301     *status = -6;
04302     return;
04303 S170:
04304 S160:
04305 /*
04306      Calculate ANSWERS
04307 */
04308     if(1 == *which) {
04309 /*
04310      Computing P
04311 */
04312         z = (*x-*mean)/ *sd;
04313         cumnor(&z,p,q);
04314     }
04315     else if(2 == *which) {
04316 /*
04317      Computing X
04318 */
04319         z = dinvnr(p,q);
04320         *x = *sd*z+*mean;
04321     }
04322     else if(3 == *which) {
04323 /*
04324      Computing the MEAN
04325 */
04326         z = dinvnr(p,q);
04327         *mean = *x-*sd*z;
04328     }
04329     else if(4 == *which) {
04330 /*
04331      Computing SD
04332 */
04333         z = dinvnr(p,q);
04334         *sd = (*x-*mean)/z;
04335     }
04336     return;
04337 } /* END */

void cdfpoi	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 4340 of file nifti_stats.c.

References cumpoi(), dinvr(), dstinv(), p, and spmpar().

Referenced by poisson_p2t(), poisson_pq2s(), poisson_s2pq(), and poisson_t2p().

04363                           : 1..3
04364                iwhich = 1 : Calculate P and Q from S and XLAM
04365                iwhich = 2 : Calculate A from P,Q and XLAM
04366                iwhich = 3 : Calculate XLAM from P,Q and S
04367 
04368         P <--> The cumulation from 0 to S of the poisson density.
04369                Input range: [0,1].
04370 
04371         Q <--> 1-P.
04372                Input range: (0, 1].
04373                P + Q = 1.0.
04374 
04375         S <--> Upper limit of cumulation of the Poisson.
04376                Input range: [0, +infinity).
04377                Search range: [0,1E300]
04378 
04379      XLAM <--> Mean of the Poisson distribution.
04380                Input range: [0, +infinity).
04381                Search range: [0,1E300]
04382 
04383      STATUS <-- 0 if calculation completed correctly
04384                -I if input parameter number I is out of range
04385                 1 if answer appears to be lower than lowest
04386                   search bound
04387                 2 if answer appears to be higher than greatest
04388                   search bound
04389                 3 if P + Q .ne. 1
04390 
04391      BOUND <-- Undefined if STATUS is 0
04392 
04393                Bound exceeded by parameter number I if STATUS
04394                is negative.
04395 
04396                Lower search bound if STATUS is 1.
04397 
04398                Upper search bound if STATUS is 2.
04399 
04400 
04401                               Method
04402 
04403 
04404      Formula   26.4.21  of   Abramowitz  and   Stegun,   Handbook  of
04405      Mathematical Functions (1966) is used  to reduce the computation
04406      of  the cumulative distribution function to that  of computing a
04407      chi-square, hence an incomplete gamma function.
04408 
04409      Cumulative  distribution function  (P) is  calculated  directly.
04410      Computation of other parameters involve a seach for a value that
04411      produces  the desired value of  P.   The  search relies  on  the
04412      monotinicity of P with the other parameter.
04413 
04414 **********************************************************************/
04415 {
04416 #define tol (1.0e-8)
04417 #define atol (1.0e-50)
04418 #define inf 1.0e300
04419 static int K1 = 1;
04420 static double K2 = 0.0e0;
04421 static double K4 = 0.5e0;
04422 static double K5 = 5.0e0;
04423 static double fx,cum,ccum,pq;
04424 static unsigned long qhi,qleft,qporq;
04425 static double T3,T6,T7,T8,T9,T10;
04426 /*
04427      ..
04428      .. Executable Statements ..
04429 */
04430 /*
04431      Check arguments
04432 */
04433     if(!(*which < 1 || *which > 3)) goto S30;
04434     if(!(*which < 1)) goto S10;
04435     *bound = 1.0e0;
04436     goto S20;
04437 S10:
04438     *bound = 3.0e0;
04439 S20:
04440     *status = -1;
04441     return;
04442 S30:
04443     if(*which == 1) goto S70;
04444 /*
04445      P
04446 */
04447     if(!(*p < 0.0e0 || *p > 1.0e0)) goto S60;
04448     if(!(*p < 0.0e0)) goto S40;
04449     *bound = 0.0e0;
04450     goto S50;
04451 S40:
04452     *bound = 1.0e0;
04453 S50:
04454     *status = -2;
04455     return;
04456 S70:
04457 S60:
04458     if(*which == 1) goto S110;
04459 /*
04460      Q
04461 */
04462     if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
04463     if(!(*q <= 0.0e0)) goto S80;
04464     *bound = 0.0e0;
04465     goto S90;
04466 S80:
04467     *bound = 1.0e0;
04468 S90:
04469     *status = -3;
04470     return;
04471 S110:
04472 S100:
04473     if(*which == 2) goto S130;
04474 /*
04475      S
04476 */
04477     if(!(*s < 0.0e0)) goto S120;
04478     *bound = 0.0e0;
04479     *status = -4;
04480     return;
04481 S130:
04482 S120:
04483     if(*which == 3) goto S150;
04484 /*
04485      XLAM
04486 */
04487     if(!(*xlam < 0.0e0)) goto S140;
04488     *bound = 0.0e0;
04489     *status = -5;
04490     return;
04491 S150:
04492 S140:
04493     if(*which == 1) goto S190;
04494 /*
04495      P + Q
04496 */
04497     pq = *p+*q;
04498     if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S180;
04499     if(!(pq < 0.0e0)) goto S160;
04500     *bound = 0.0e0;
04501     goto S170;
04502 S160:
04503     *bound = 1.0e0;
04504 S170:
04505     *status = 3;
04506     return;
04507 S190:
04508 S180:
04509     if(!(*which == 1)) qporq = *p <= *q;
04510 /*
04511      Select the minimum of P or Q
04512      Calculate ANSWERS
04513 */
04514     if(1 == *which) {
04515 /*
04516      Calculating P
04517 */
04518         cumpoi(s,xlam,p,q);
04519         *status = 0;
04520     }
04521     else if(2 == *which) {
04522 /*
04523      Calculating S
04524 */
04525         *s = 5.0e0;
04526         T3 = inf;
04527         T6 = atol;
04528         T7 = tol;
04529         dstinv(&K2,&T3,&K4,&K4,&K5,&T6,&T7);
04530         *status = 0;
04531         dinvr(status,s,&fx,&qleft,&qhi);
04532 S200:
04533         if(!(*status == 1)) goto S230;
04534         cumpoi(s,xlam,&cum,&ccum);
04535         if(!qporq) goto S210;
04536         fx = cum-*p;
04537         goto S220;
04538 S210:
04539         fx = ccum-*q;
04540 S220:
04541         dinvr(status,s,&fx,&qleft,&qhi);
04542         goto S200;
04543 S230:
04544         if(!(*status == -1)) goto S260;
04545         if(!qleft) goto S240;
04546         *status = 1;
04547         *bound = 0.0e0;
04548         goto S250;
04549 S240:
04550         *status = 2;
04551         *bound = inf;
04552 S260:
04553 S250:
04554         ;
04555     }
04556     else if(3 == *which) {
04557 /*
04558      Calculating XLAM
04559 */
04560         *xlam = 5.0e0;
04561         T8 = inf;
04562         T9 = atol;
04563         T10 = tol;
04564         dstinv(&K2,&T8,&K4,&K4,&K5,&T9,&T10);
04565         *status = 0;
04566         dinvr(status,xlam,&fx,&qleft,&qhi);
04567 S270:
04568         if(!(*status == 1)) goto S300;
04569         cumpoi(s,xlam,&cum,&ccum);
04570         if(!qporq) goto S280;
04571         fx = cum-*p;
04572         goto S290;
04573 S280:
04574         fx = ccum-*q;
04575 S290:
04576         dinvr(status,xlam,&fx,&qleft,&qhi);
04577         goto S270;
04578 S300:
04579         if(!(*status == -1)) goto S330;
04580         if(!qleft) goto S310;
04581         *status = 1;
04582         *bound = 0.0e0;
04583         goto S320;
04584 S310:
04585         *status = 2;
04586         *bound = inf;
04587 S320:
04588         ;
04589     }
04590 S330:
04591     return;
04592 #undef tol
04593 #undef atol
04594 #undef inf
04595 } /* END */

void cdft	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *	,
		double *
	)	`[static]`

Definition at line 4598 of file nifti_stats.c.

References cumt(), dinvr(), dstinv(), dt1(), p, and spmpar().

Referenced by student_pq2s(), and student_s2pq().

04621                           : 1..3
04622                iwhich = 1 : Calculate P and Q from T and DF
04623                iwhich = 2 : Calculate T from P,Q and DF
04624                iwhich = 3 : Calculate DF from P,Q and T
04625 
04626         P <--> The integral from -infinity to t of the t-density.
04627                Input range: (0,1].
04628 
04629         Q <--> 1-P.
04630                Input range: (0, 1].
04631                P + Q = 1.0.
04632 
04633         T <--> Upper limit of integration of the t-density.
04634                Input range: ( -infinity, +infinity).
04635                Search range: [ -1E300, 1E300 ]
04636 
04637         DF <--> Degrees of freedom of the t-distribution.
04638                 Input range: (0 , +infinity).
04639                 Search range: [1e-300, 1E10]
04640 
04641      STATUS <-- 0 if calculation completed correctly
04642                -I if input parameter number I is out of range
04643                 1 if answer appears to be lower than lowest
04644                   search bound
04645                 2 if answer appears to be higher than greatest
04646                   search bound
04647                 3 if P + Q .ne. 1
04648 
04649      BOUND <-- Undefined if STATUS is 0
04650 
04651                Bound exceeded by parameter number I if STATUS
04652                is negative.
04653 
04654                Lower search bound if STATUS is 1.
04655 
04656                Upper search bound if STATUS is 2.
04657 
04658 
04659                               Method
04660 
04661 
04662      Formula  26.5.27  of   Abramowitz   and  Stegun,   Handbook   of
04663      Mathematical Functions  (1966) is used to reduce the computation
04664      of the cumulative distribution function to that of an incomplete
04665      beta.
04666 
04667      Computation of other parameters involve a seach for a value that
04668      produces  the desired  value  of P.   The search relies  on  the
04669      monotinicity of P with the other parameter.
04670 
04671 **********************************************************************/
04672 {
04673 #define tol (1.0e-8)
04674 #define atol (1.0e-50)
04675 #define zero (1.0e-300)
04676 #define inf 1.0e300
04677 #define maxdf 1.0e10
04678 static int K1 = 1;
04679 static double K4 = 0.5e0;
04680 static double K5 = 5.0e0;
04681 static double fx,cum,ccum,pq;
04682 static unsigned long qhi,qleft,qporq;
04683 static double T2,T3,T6,T7,T8,T9,T10,T11;
04684 /*
04685      ..
04686      .. Executable Statements ..
04687 */
04688 /*
04689      Check arguments
04690 */
04691     if(!(*which < 1 || *which > 3)) goto S30;
04692     if(!(*which < 1)) goto S10;
04693     *bound = 1.0e0;
04694     goto S20;
04695 S10:
04696     *bound = 3.0e0;
04697 S20:
04698     *status = -1;
04699     return;
04700 S30:
04701     if(*which == 1) goto S70;
04702 /*
04703      P
04704 */
04705     if(!(*p <= 0.0e0 || *p > 1.0e0)) goto S60;
04706     if(!(*p <= 0.0e0)) goto S40;
04707     *bound = 0.0e0;
04708     goto S50;
04709 S40:
04710     *bound = 1.0e0;
04711 S50:
04712     *status = -2;
04713     return;
04714 S70:
04715 S60:
04716     if(*which == 1) goto S110;
04717 /*
04718      Q
04719 */
04720     if(!(*q <= 0.0e0 || *q > 1.0e0)) goto S100;
04721     if(!(*q <= 0.0e0)) goto S80;
04722     *bound = 0.0e0;
04723     goto S90;
04724 S80:
04725     *bound = 1.0e0;
04726 S90:
04727     *status = -3;
04728     return;
04729 S110:
04730 S100:
04731     if(*which == 3) goto S130;
04732 /*
04733      DF
04734 */
04735     if(!(*df <= 0.0e0)) goto S120;
04736     *bound = 0.0e0;
04737     *status = -5;
04738     return;
04739 S130:
04740 S120:
04741     if(*which == 1) goto S170;
04742 /*
04743      P + Q
04744 */
04745     pq = *p+*q;
04746     if(!(fabs(pq-0.5e0-0.5e0) > 3.0e0*spmpar(&K1))) goto S160;
04747     if(!(pq < 0.0e0)) goto S140;
04748     *bound = 0.0e0;
04749     goto S150;
04750 S140:
04751     *bound = 1.0e0;
04752 S150:
04753     *status = 3;
04754     return;
04755 S170:
04756 S160:
04757     if(!(*which == 1)) qporq = *p <= *q;
04758 /*
04759      Select the minimum of P or Q
04760      Calculate ANSWERS
04761 */
04762     if(1 == *which) {
04763 /*
04764      Computing P and Q
04765 */
04766         cumt(t,df,p,q);
04767         *status = 0;
04768     }
04769     else if(2 == *which) {
04770 /*
04771      Computing T
04772      .. Get initial approximation for T
04773 */
04774         *t = dt1(p,q,df);
04775         T2 = -inf;
04776         T3 = inf;
04777         T6 = atol;
04778         T7 = tol;
04779         dstinv(&T2,&T3,&K4,&K4,&K5,&T6,&T7);
04780         *status = 0;
04781         dinvr(status,t,&fx,&qleft,&qhi);
04782 S180:
04783         if(!(*status == 1)) goto S210;
04784         cumt(t,df,&cum,&ccum);
04785         if(!qporq) goto S190;
04786         fx = cum-*p;
04787         goto S200;
04788 S190:
04789         fx = ccum-*q;
04790 S200:
04791         dinvr(status,t,&fx,&qleft,&qhi);
04792         goto S180;
04793 S210:
04794         if(!(*status == -1)) goto S240;
04795         if(!qleft) goto S220;
04796         *status = 1;
04797         *bound = -inf;
04798         goto S230;
04799 S220:
04800         *status = 2;
04801         *bound = inf;
04802 S240:
04803 S230:
04804         ;
04805     }
04806     else if(3 == *which) {
04807 /*
04808      Computing DF
04809 */
04810         *df = 5.0e0;
04811         T8 = zero;
04812         T9 = maxdf;
04813         T10 = atol;
04814         T11 = tol;
04815         dstinv(&T8,&T9,&K4,&K4,&K5,&T10,&T11);
04816         *status = 0;
04817         dinvr(status,df,&fx,&qleft,&qhi);
04818 S250:
04819         if(!(*status == 1)) goto S280;
04820         cumt(t,df,&cum,&ccum);
04821         if(!qporq) goto S260;
04822         fx = cum-*p;
04823         goto S270;
04824 S260:
04825         fx = ccum-*q;
04826 S270:
04827         dinvr(status,df,&fx,&qleft,&qhi);
04828         goto S250;
04829 S280:
04830         if(!(*status == -1)) goto S310;
04831         if(!qleft) goto S290;
04832         *status = 1;
04833         *bound = zero;
04834         goto S300;
04835 S290:
04836         *status = 2;
04837         *bound = maxdf;
04838 S300:
04839         ;
04840     }
04841 S310:
04842     return;
04843 #undef tol
04844 #undef atol
04845 #undef zero
04846 #undef inf
04847 #undef maxdf
04848 } /* END */

double chi_pq2s	(	pqpair	pq,
		double	dof
	)	`[static]`

Definition at line 10754 of file nifti_stats.c.

References BIGG, chisq_pq2s(), pqpair::p, and pqpair::q.

Referenced by pq2stat().

10755 {
10756    if( pq.p <= 0.0 ) return  0.0 ;
10757    if( pq.q <= 0.0 ) return BIGG ;
10758    return sqrt(chisq_pq2s(pq,dof)) ;
10759 }

pqpair chi_s2pq	(	double	xx,
		double	dof
	)	`[static]`

Definition at line 10744 of file nifti_stats.c.

References chisq_s2pq().

Referenced by stat2pq().

10745 {
10746    pqpair pq={0.0,1.0} ;
10747 
10748    if( xx <= 0.0 || dof <= 0.0 ) return pq ;
10749    return chisq_s2pq( xx*xx , dof ) ;
10750 }

double chisq_pq2s	(	pqpair	pq,
		double	dof
	)	`[static]`

Definition at line 10068 of file nifti_stats.c.

References BIGG, cdfchi(), pqpair::p, p, and pqpair::q.

Referenced by chi_pq2s(), and pq2stat().

10069 {
10070    int which , status ;
10071    double p,q,x,df,bound ;
10072 
10073    which  = 2 ;
10074    p      = pq.p ; if( p <= 0.0 ) return  0.0 ;
10075    q      = pq.q ; if( q <= 0.0 ) return BIGG ;
10076    x      = 0.0 ;
10077    df     = dof ;
10078 
10079    cdfchi( &which , &p , &q , &x , &df , &status , &bound ) ;
10080    return x ;
10081 }

pqpair chisq_s2pq	(	double	xx,
		double	dof
	)	`[static]`

Definition at line 10050 of file nifti_stats.c.

References cdfchi(), pqpair::p, p, and pqpair::q.

Referenced by chi_s2pq(), and stat2pq().

10051 {
10052    int which , status ;
10053    double p,q,x,df,bound ;
10054    pqpair pq={0.0,1.0} ;
10055 
10056    which  = 1 ;
10057    p      = 0.0 ;
10058    q      = 1.0 ;
10059    x      = xx ;  if(   x <= 0.0 ) return pq ;
10060    df     = dof ; if( dof <= 0.0 ) return pq ;
10061 
10062    cdfchi( &which , &p , &q , &x , &df , &status , &bound ) ;
10063    pq.p = p ; pq.q = q ; return pq ;
10064 }

double chsqnonc_pq2s	(	pqpair	pq,
		double	dof,
		double	nonc
	)	`[static]`

Definition at line 10106 of file nifti_stats.c.

References BIGG, cdfchn(), pqpair::p, p, and pqpair::q.

Referenced by pq2stat().

10107 {
10108    int which , status ;
10109    double p,q,x,df,bound , pnonc ;
10110 
10111    which  = 2 ;
10112    p      = pq.p ; if( p <= 0.0 ) return  0.0 ;
10113    q      = pq.q ; if( q <= 0.0 ) return BIGG ;
10114    x      = 0.0 ;
10115    df     = dof ;
10116    pnonc  = nonc ;
10117 
10118    cdfchn( &which , &p , &q , &x , &df , &pnonc , &status , &bound ) ;
10119    return x ;
10120 }

pqpair chsqnonc_s2pq	(	double	xx,
		double	dof,
		double	nonc
	)	`[static]`

Definition at line 10087 of file nifti_stats.c.

References cdfchn(), pqpair::p, p, and pqpair::q.

Referenced by stat2pq().

10088 {
10089    int which , status ;
10090    double p,q,x,df,bound , pnonc ;
10091    pqpair pq={0.0,1.0} ;
10092 
10093    which  = 1 ;
10094    p      = 0.0 ;
10095    q      = 1.0 ;
10096    x      = xx ;   if( x     <= 0.0 ) return pq ;
10097    df     = dof ;  if( df    <= 0.0 ) return pq ;
10098    pnonc  = nonc ; if( pnonc <  0.0 ) return pq ;
10099 
10100    cdfchn( &which , &p , &q , &x , &df , &pnonc , &status , &bound ) ;
10101    pq.p = p ; pq.q = q ; return pq ;
10102 }

double correl_pq2s	(	pqpair	pq,
		double	dof
	)	`[static]`

Definition at line 10335 of file nifti_stats.c.

References beta_pq2s().

Referenced by pq2stat().

10336 {
10337    double xx = beta_pq2s( pq , 0.5*dof , 0.5*dof ) ;
10338    return (2.0*xx-1.0) ;
10339 }

pqpair correl_s2pq	(	double	rr,
		double	dof
	)	`[static]`

Definition at line 10328 of file nifti_stats.c.

References beta_s2pq().

Referenced by stat2pq().

10329 {
10330    return beta_s2pq( 0.5*(rr+1.0) , 0.5*dof , 0.5*dof ) ;
10331 }

void cumbet	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 4851 of file nifti_stats.c.

References a, and bratio().

Referenced by betadf(), cdfbet(), cumbin(), cumnbn(), and cumt().

04905 {
04906 static int ierr;
04907 /*
04908      ..
04909      .. Executable Statements ..
04910 */
04911     if(!(*x <= 0.0e0)) goto S10;
04912     *cum = 0.0e0;
04913     *ccum = 1.0e0;
04914     return;
04915 S10:
04916     if(!(*y <= 0.0e0)) goto S20;
04917     *cum = 1.0e0;
04918     *ccum = 0.0e0;
04919     return;
04920 S20:
04921     bratio(a,b,x,y,cum,ccum,&ierr);
04922 /*
04923      Call bratio routine
04924 */
04925     return;
04926 } /* END */

void cumbin	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 4929 of file nifti_stats.c.

References cumbet(), and xn.

Referenced by cdfbin().

04978 {
04979 static double T1,T2;
04980 /*
04981      ..
04982      .. Executable Statements ..
04983 */
04984     if(!(*s < *xn)) goto S10;
04985     T1 = *s+1.0e0;
04986     T2 = *xn-*s;
04987     cumbet(pr,ompr,&T1,&T2,ccum,cum);
04988     goto S20;
04989 S10:
04990     *cum = 1.0e0;
04991     *ccum = 0.0e0;
04992 S20:
04993     return;
04994 } /* END */

void cumchi	(	double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 4997 of file nifti_stats.c.

References a, and cumgam().

Referenced by cdfchi(), cumchn(), and cumpoi().

05036 {
05037 static double a,xx;
05038 /*
05039      ..
05040      .. Executable Statements ..
05041 */
05042     a = *df*0.5e0;
05043     xx = *x*0.5e0;
05044     cumgam(&xx,&a,cum,ccum);
05045     return;
05046 } /* END */

void cumchn	(	double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 5049 of file nifti_stats.c.

References alngam(), cumchi(), fifidint(), and i.

Referenced by cdfchn().

05121 {
05122 #define dg(i) (*df+2.0e0*(double)(i))
05123 #define qsmall(xx) (int)(sum < 1.0e-20 || (xx) < eps*sum)
05124 #define qtired(i) (int)((i) > ntired)
05125 static double eps = 1.0e-5;
05126 static int ntired = 1000;
05127 static double adj,centaj,centwt,chid2,dfd2,lcntaj,lcntwt,lfact,pcent,pterm,sum,
05128     sumadj,term,wt,xnonc;
05129 static int i,icent,iterb,iterf;
05130 static double T1,T2,T3;
05131 /*
05132      ..
05133      .. Executable Statements ..
05134 */
05135     if(!(*x <= 0.0e0)) goto S10;
05136     *cum = 0.0e0;
05137     *ccum = 1.0e0;
05138     return;
05139 S10:
05140     if(!(*pnonc <= 1.0e-10)) goto S20;
05141 /*
05142      When non-centrality parameter is (essentially) zero,
05143      use cumulative chi-square distribution
05144 */
05145     cumchi(x,df,cum,ccum);
05146     return;
05147 S20:
05148     xnonc = *pnonc/2.0e0;
05149 /*
05150 **********************************************************************
05151      The following code calcualtes the weight, chi-square, and
05152      adjustment term for the central term in the infinite series.
05153      The central term is the one in which the poisson weight is
05154      greatest.  The adjustment term is the amount that must
05155      be subtracted from the chi-square to move up two degrees
05156      of freedom.
05157 **********************************************************************
05158 */
05159     icent = fifidint(xnonc);
05160     if(icent == 0) icent = 1;
05161     chid2 = *x/2.0e0;
05162 /*
05163      Calculate central weight term
05164 */
05165     T1 = (double)(icent+1);
05166     lfact = alngam(&T1);
05167     lcntwt = -xnonc+(double)icent*log(xnonc)-lfact;
05168     centwt = exp(lcntwt);
05169 /*
05170      Calculate central chi-square
05171 */
05172     T2 = dg(icent);
05173     cumchi(x,&T2,&pcent,ccum);
05174 /*
05175      Calculate central adjustment term
05176 */
05177     dfd2 = dg(icent)/2.0e0;
05178     T3 = 1.0e0+dfd2;
05179     lfact = alngam(&T3);
05180     lcntaj = dfd2*log(chid2)-chid2-lfact;
05181     centaj = exp(lcntaj);
05182     sum = centwt*pcent;
05183 /*
05184 **********************************************************************
05185      Sum backwards from the central term towards zero.
05186      Quit whenever either
05187      (1) the zero term is reached, or
05188      (2) the term gets small relative to the sum, or
05189      (3) More than NTIRED terms are totaled.
05190 **********************************************************************
05191 */
05192     iterb = 0;
05193     sumadj = 0.0e0;
05194     adj = centaj;
05195     wt = centwt;
05196     i = icent;
05197     goto S40;
05198 S30:
05199     if(qtired(iterb) || qsmall(term) || i == 0) goto S50;
05200 S40:
05201     dfd2 = dg(i)/2.0e0;
05202 /*
05203      Adjust chi-square for two fewer degrees of freedom.
05204      The adjusted value ends up in PTERM.
05205 */
05206     adj = adj*dfd2/chid2;
05207     sumadj += adj;
05208     pterm = pcent+sumadj;
05209 /*
05210      Adjust poisson weight for J decreased by one
05211 */
05212     wt *= ((double)i/xnonc);
05213     term = wt*pterm;
05214     sum += term;
05215     i -= 1;
05216     iterb += 1;
05217     goto S30;
05218 S50:
05219     iterf = 0;
05220 /*
05221 **********************************************************************
05222      Now sum forward from the central term towards infinity.
05223      Quit when either
05224      (1) the term gets small relative to the sum, or
05225      (2) More than NTIRED terms are totaled.
05226 **********************************************************************
05227 */
05228     sumadj = adj = centaj;
05229     wt = centwt;
05230     i = icent;
05231     goto S70;
05232 S60:
05233     if(qtired(iterf) || qsmall(term)) goto S80;
05234 S70:
05235 /*
05236      Update weights for next higher J
05237 */
05238     wt *= (xnonc/(double)(i+1));
05239 /*
05240      Calculate PTERM and add term to sum
05241 */
05242     pterm = pcent-sumadj;
05243     term = wt*pterm;
05244     sum += term;
05245 /*
05246      Update adjustment term for DF for next iteration
05247 */
05248     i += 1;
05249     dfd2 = dg(i)/2.0e0;
05250     adj = adj*chid2/dfd2;
05251     sumadj += adj;
05252     iterf += 1;
05253     goto S60;
05254 S80:
05255     *cum = sum;
05256     *ccum = 0.5e0+(0.5e0-*cum);
05257     return;
05258 #undef dg
05259 #undef qsmall
05260 #undef qtired
05261 } /* END */

void cumf	(	double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 5264 of file nifti_stats.c.

References bratio().

Referenced by cdff(), and cumfnc().

05312 {
05313 #define half 0.5e0
05314 #define done 1.0e0
05315 static double dsum,prod,xx,yy;
05316 static int ierr;
05317 static double T1,T2;
05318 /*
05319      ..
05320      .. Executable Statements ..
05321 */
05322     if(!(*f <= 0.0e0)) goto S10;
05323     *cum = 0.0e0;
05324     *ccum = 1.0e0;
05325     return;
05326 S10:
05327     prod = *dfn**f;
05328 /*
05329      XX is such that the incomplete beta with parameters
05330      DFD/2 and DFN/2 evaluated at XX is 1 - CUM or CCUM
05331      YY is 1 - XX
05332      Calculate the smaller of XX and YY accurately
05333 */
05334     dsum = *dfd+prod;
05335     xx = *dfd/dsum;
05336     if(xx > half) {
05337         yy = prod/dsum;
05338         xx = done-yy;
05339     }
05340     else  yy = done-xx;
05341     T1 = *dfd*half;
05342     T2 = *dfn*half;
05343     bratio(&T1,&T2,&xx,&yy,ccum,cum,&ierr);
05344     return;
05345 #undef half
05346 #undef done
05347 } /* END */

void cumfnc	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 5350 of file nifti_stats.c.

References alngam(), bratio(), cumf(), dummy, and i.

Referenced by cdffnc().

05413 {
05414 #define qsmall(x) (int)(sum < 1.0e-20 || (x) < eps*sum)
05415 #define half 0.5e0
05416 #define done 1.0e0
05417 static double eps = 1.0e-4;
05418 static double dsum,dummy,prod,xx,yy,adn,aup,b,betdn,betup,centwt,dnterm,sum,
05419     upterm,xmult,xnonc;
05420 static int i,icent,ierr;
05421 static double T1,T2,T3,T4,T5,T6;
05422 /*
05423      ..
05424      .. Executable Statements ..
05425 */
05426     if(!(*f <= 0.0e0)) goto S10;
05427     *cum = 0.0e0;
05428     *ccum = 1.0e0;
05429     return;
05430 S10:
05431     if(!(*pnonc < 1.0e-10)) goto S20;
05432 /*
05433      Handle case in which the non-centrality parameter is
05434      (essentially) zero.
05435 */
05436     cumf(f,dfn,dfd,cum,ccum);
05437     return;
05438 S20:
05439     xnonc = *pnonc/2.0e0;
05440 /*
05441      Calculate the central term of the poisson weighting factor.
05442 */
05443     icent = xnonc;
05444     if(icent == 0) icent = 1;
05445 /*
05446      Compute central weight term
05447 */
05448     T1 = (double)(icent+1);
05449     centwt = exp(-xnonc+(double)icent*log(xnonc)-alngam(&T1));
05450 /*
05451      Compute central incomplete beta term
05452      Assure that minimum of arg to beta and 1 - arg is computed
05453           accurately.
05454 */
05455     prod = *dfn**f;
05456     dsum = *dfd+prod;
05457     yy = *dfd/dsum;
05458     if(yy > half) {
05459         xx = prod/dsum;
05460         yy = done-xx;
05461     }
05462     else  xx = done-yy;
05463     T2 = *dfn*half+(double)icent;
05464     T3 = *dfd*half;
05465     bratio(&T2,&T3,&xx,&yy,&betdn,&dummy,&ierr);
05466     adn = *dfn/2.0e0+(double)icent;
05467     aup = adn;
05468     b = *dfd/2.0e0;
05469     betup = betdn;
05470     sum = centwt*betdn;
05471 /*
05472      Now sum terms backward from icent until convergence or all done
05473 */
05474     xmult = centwt;
05475     i = icent;
05476     T4 = adn+b;
05477     T5 = adn+1.0e0;
05478     dnterm = exp(alngam(&T4)-alngam(&T5)-alngam(&b)+adn*log(xx)+b*log(yy));
05479 S30:
05480     if(qsmall(xmult*betdn) || i <= 0) goto S40;
05481     xmult *= ((double)i/xnonc);
05482     i -= 1;
05483     adn -= 1.0;
05484     dnterm = (adn+1.0)/((adn+b)*xx)*dnterm;
05485     betdn += dnterm;
05486     sum += (xmult*betdn);
05487     goto S30;
05488 S40:
05489     i = icent+1;
05490 /*
05491      Now sum forwards until convergence
05492 */
05493     xmult = centwt;
05494     if(aup-1.0+b == 0) upterm = exp(-alngam(&aup)-alngam(&b)+(aup-1.0)*log(xx)+
05495       b*log(yy));
05496     else  {
05497         T6 = aup-1.0+b;
05498         upterm = exp(alngam(&T6)-alngam(&aup)-alngam(&b)+(aup-1.0)*log(xx)+b*
05499           log(yy));
05500     }
05501     goto S60;
05502 S50:
05503     if(qsmall(xmult*betup)) goto S70;
05504 S60:
05505     xmult *= (xnonc/(double)i);
05506     i += 1;
05507     aup += 1.0;
05508     upterm = (aup+b-2.0e0)*xx/(aup-1.0)*upterm;
05509     betup -= upterm;
05510     sum += (xmult*betup);
05511     goto S50;
05512 S70:
05513     *cum = sum;
05514     *ccum = 0.5e0+(0.5e0-*cum);
05515     return;
05516 #undef qsmall
05517 #undef half
05518 #undef done
05519 } /* END */

void cumgam	(	double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 5522 of file nifti_stats.c.

References a, and gratio().

Referenced by cdfgam(), and cumchi().

05564 {
05565 static int K1 = 0;
05566 /*
05567      ..
05568      .. Executable Statements ..
05569 */
05570     if(!(*x <= 0.0e0)) goto S10;
05571     *cum = 0.0e0;
05572     *ccum = 1.0e0;
05573     return;
05574 S10:
05575     gratio(a,x,cum,ccum,&K1);
05576 /*
05577      Call gratio routine
05578 */
05579     return;
05580 } /* END */

void cumnbn	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 5583 of file nifti_stats.c.

References cumbet(), and xn.

Referenced by cdfnbn().

05638 {
05639 static double T1;
05640 /*
05641      ..
05642      .. Executable Statements ..
05643 */
05644     T1 = *s+1.e0;
05645     cumbet(pr,ompr,xn,&T1,cum,ccum);
05646     return;
05647 } /* END */

void cumnor	(	double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 5650 of file nifti_stats.c.

References a, arg, c, fifdint(), i, p, and spmpar().

Referenced by cdfnor(), dinvnr(), gaudf(), invgauss_s2pq(), and normal_s2pq().

05673                                     :
05674 
05675      Cody, W.D. (1993). "ALGORITHM 715: SPECFUN - A Portabel FORTRAN
05676      Package of Special Function Routines and Test Drivers"
05677      acm Transactions on Mathematical Software. 19, 22-32.
05678 
05679      with slight modifications to return ccum and to deal with
05680      machine constants.
05681 
05682 **********************************************************************
05683   Original Comments:
05684 ------------------------------------------------------------------
05685 
05686  This function evaluates the normal distribution function:
05687 
05688                               / x
05689                      1       |       -t*t/2
05690           P(x) = ----------- |      e       dt
05691                  sqrt(2 pi)  |
05692                              /-oo
05693 
05694    The main computation evaluates near-minimax approximations
05695    derived from those in "Rational Chebyshev approximations for
05696    the error function" by W. J. Cody, Math. Comp., 1969, 631-637.
05697    This transportable program uses rational functions that
05698    theoretically approximate the normal distribution function to
05699    at least 18 significant decimal digits.  The accuracy achieved
05700    depends on the arithmetic system, the compiler, the intrinsic
05701    functions, and proper selection of the machine-dependent
05702    constants.
05703 
05704 *******************************************************************
05705 *******************************************************************
05706 
05707  Explanation of machine-dependent constants.
05708 
05709    MIN   = smallest machine representable number.
05710 
05711    EPS   = argument below which anorm(x) may be represented by
05712            0.5  and above which  x*x  will not underflow.
05713            A conservative value is the largest machine number X
05714            such that   1.0 + X = 1.0   to machine precision.
05715 *******************************************************************
05716 *******************************************************************
05717 
05718  Error returns
05719 
05720   The program returns  ANORM = 0     for  ARG .LE. XLOW.
05721 
05722 
05723  Intrinsic functions required are:
05724 
05725      ABS, AINT, EXP
05726 
05727 
05728   Author: W. J. Cody
05729           Mathematics and Computer Science Division
05730           Argonne National Laboratory
05731           Argonne, IL 60439
05732 
05733   Latest modification: March 15, 1992
05734 
05735 ------------------------------------------------------------------
05736 */
05737 {
05738 static double a[5] = {
05739     2.2352520354606839287e00,1.6102823106855587881e02,1.0676894854603709582e03,
05740     1.8154981253343561249e04,6.5682337918207449113e-2
05741 };
05742 static double b[4] = {
05743     4.7202581904688241870e01,9.7609855173777669322e02,1.0260932208618978205e04,
05744     4.5507789335026729956e04
05745 };
05746 static double c[9] = {
05747     3.9894151208813466764e-1,8.8831497943883759412e00,9.3506656132177855979e01,
05748     5.9727027639480026226e02,2.4945375852903726711e03,6.8481904505362823326e03,
05749     1.1602651437647350124e04,9.8427148383839780218e03,1.0765576773720192317e-8
05750 };
05751 static double d[8] = {
05752     2.2266688044328115691e01,2.3538790178262499861e02,1.5193775994075548050e03,
05753     6.4855582982667607550e03,1.8615571640885098091e04,3.4900952721145977266e04,
05754     3.8912003286093271411e04,1.9685429676859990727e04
05755 };
05756 static double half = 0.5e0;
05757 static double p[6] = {
05758     2.1589853405795699e-1,1.274011611602473639e-1,2.2235277870649807e-2,
05759     1.421619193227893466e-3,2.9112874951168792e-5,2.307344176494017303e-2
05760 };
05761 static double one = 1.0e0;
05762 static double q[5] = {
05763     1.28426009614491121e00,4.68238212480865118e-1,6.59881378689285515e-2,
05764     3.78239633202758244e-3,7.29751555083966205e-5
05765 };
05766 static double sixten = 1.60e0;
05767 static double sqrpi = 3.9894228040143267794e-1;
05768 static double thrsh = 0.66291e0;
05769 static double root32 = 5.656854248e0;
05770 static double zero = 0.0e0;
05771 static int K1 = 1;
05772 static int K2 = 2;
05773 static int i;
05774 static double del,eps,temp,x,xden,xnum,y,xsq,min;
05775 /*
05776 ------------------------------------------------------------------
05777   Machine dependent constants
05778 ------------------------------------------------------------------
05779 */
05780     eps = spmpar(&K1)*0.5e0;
05781     min = spmpar(&K2);
05782     x = *arg;
05783     y = fabs(x);
05784     if(y <= thrsh) {
05785 /*
05786 ------------------------------------------------------------------
05787   Evaluate  anorm  for  |X| <= 0.66291
05788 ------------------------------------------------------------------
05789 */
05790         xsq = zero;
05791         if(y > eps) xsq = x*x;
05792         xnum = a[4]*xsq;
05793         xden = xsq;
05794         for(i=0; i<3; i++) {
05795             xnum = (xnum+a[i])*xsq;
05796             xden = (xden+b[i])*xsq;
05797         }
05798         *result = x*(xnum+a[3])/(xden+b[3]);
05799         temp = *result;
05800         *result = half+temp;
05801         *ccum = half-temp;
05802     }
05803 /*
05804 ------------------------------------------------------------------
05805   Evaluate  anorm  for 0.66291 <= |X| <= sqrt(32)
05806 ------------------------------------------------------------------
05807 */
05808     else if(y <= root32) {
05809         xnum = c[8]*y;
05810         xden = y;
05811         for(i=0; i<7; i++) {
05812             xnum = (xnum+c[i])*y;
05813             xden = (xden+d[i])*y;
05814         }
05815         *result = (xnum+c[7])/(xden+d[7]);
05816         xsq = fifdint(y*sixten)/sixten;
05817         del = (y-xsq)*(y+xsq);
05818         *result = exp(-(xsq*xsq*half))*exp(-(del*half))**result;
05819         *ccum = one-*result;
05820         if(x > zero) {
05821             temp = *result;
05822             *result = *ccum;
05823             *ccum = temp;
05824         }
05825     }
05826 /*
05827 ------------------------------------------------------------------
05828   Evaluate  anorm  for |X| > sqrt(32)
05829 ------------------------------------------------------------------
05830 */
05831     else  {
05832         *result = zero;
05833         xsq = one/(x*x);
05834         xnum = p[5]*xsq;
05835         xden = xsq;
05836         for(i=0; i<4; i++) {
05837             xnum = (xnum+p[i])*xsq;
05838             xden = (xden+q[i])*xsq;
05839         }
05840         *result = xsq*(xnum+p[4])/(xden+q[4]);
05841         *result = (sqrpi-*result)/y;
05842         xsq = fifdint(x*sixten)/sixten;
05843         del = (x-xsq)*(x+xsq);
05844         *result = exp(-(xsq*xsq*half))*exp(-(del*half))**result;
05845         *ccum = one-*result;
05846         if(x > zero) {
05847             temp = *result;
05848             *result = *ccum;
05849             *ccum = temp;
05850         }
05851     }
05852     if(*result < min) *result = 0.0e0;
05853 /*
05854 ------------------------------------------------------------------
05855   Fix up for negative argument, erf, etc.
05856 ------------------------------------------------------------------
05857 ----------Last card of ANORM ----------
05858 */
05859     if(*ccum < min) *ccum = 0.0e0;
05860 } /* END */

void cumpoi	(	double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 5863 of file nifti_stats.c.

References cumchi().

Referenced by cdfpoi().

05903 {
05904 static double chi,df;
05905 /*
05906      ..
05907      .. Executable Statements ..
05908 */
05909     df = 2.0e0*(*s+1.0e0);
05910     chi = 2.0e0**xlam;
05911     cumchi(&chi,&df,ccum,cum);
05912     return;
05913 } /* END */

void cumt	(	double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 5916 of file nifti_stats.c.

References a, cumbet(), and tt.

Referenced by cdft().

05955 {
05956 static double K2 = 0.5e0;
05957 static double xx,a,oma,tt,yy,dfptt,T1;
05958 /*
05959      ..
05960      .. Executable Statements ..
05961 */
05962     tt = *t**t;
05963     dfptt = *df+tt;
05964     xx = *df/dfptt;
05965     yy = tt/dfptt;
05966     T1 = 0.5e0**df;
05967     cumbet(&xx,&yy,&T1,&K2,&a,&oma);
05968     if(!(*t <= 0.0e0)) goto S10;
05969     *cum = 0.5e0*a;
05970     *ccum = oma+*cum;
05971     goto S20;
05972 S10:
05973     *ccum = 0.5e0*a;
05974     *cum = oma+*ccum;
05975 S20:
05976     return;
05977 } /* END */

double dbetrm	(	double *	,
		double *
	)	`[static]`

Definition at line 5980 of file nifti_stats.c.

References a, dbetrm(), dstrem(), fifdmax1(), and fifdmin1().

Referenced by dbetrm().

06013 {
06014 static double dbetrm,T1,T2,T3;
06015 /*
06016      ..
06017      .. Executable Statements ..
06018 */
06019 /*
06020      Try to sum from smallest to largest
06021 */
06022     T1 = *a+*b;
06023     dbetrm = -dstrem(&T1);
06024     T2 = fifdmax1(*a,*b);
06025     dbetrm += dstrem(&T2);
06026     T3 = fifdmin1(*a,*b);
06027     dbetrm += dstrem(&T3);
06028     return dbetrm;
06029 } /* END */

double devlpl	(	double	[],
		int *	,
		double *
	)	`[static]`

Definition at line 6032 of file nifti_stats.c.

References a, devlpl(), and i.

Referenced by alngam(), devlpl(), dlanor(), dstrem(), dt1(), and stvaln().

06061 {
06062 static double devlpl,term;
06063 static int i;
06064 /*
06065      ..
06066      .. Executable Statements ..
06067 */
06068     term = a[*n-1];
06069     for(i= *n-1-1; i>=0; i--) term = a[i]+term**x;
06070     devlpl = term;
06071     return devlpl;
06072 } /* END */

double dexpm1 ( double * ) [static]

Definition at line 6075 of file nifti_stats.c.

References dexpm1().

Referenced by dexpm1().

06093                                            :
06094 
06095      DiDinato, A. R. and Morris,  A.   H.  Algorithm 708: Significant
06096      Digit Computation of the Incomplete  Beta  Function Ratios.  ACM
06097      Trans. Math.  Softw. 18 (1993), 360-373.
06098 
06099 **********************************************************************
06100 */
06101 {
06102 static double p1 = .914041914819518e-09;
06103 static double p2 = .238082361044469e-01;
06104 static double q1 = -.499999999085958e+00;
06105 static double q2 = .107141568980644e+00;
06106 static double q3 = -.119041179760821e-01;
06107 static double q4 = .595130811860248e-03;
06108 static double dexpm1,w;
06109 /*
06110      ..
06111      .. Executable Statements ..
06112 */
06113     if(fabs(*x) > 0.15e0) goto S10;
06114     dexpm1 = *x*(((p2**x+p1)**x+1.0e0)/((((q4**x+q3)**x+q2)**x+q1)**x+1.0e0));
06115     return dexpm1;
06116 S10:
06117     w = exp(*x);
06118     if(*x > 0.0e0) goto S20;
06119     dexpm1 = w-0.5e0-0.5e0;
06120     return dexpm1;
06121 S20:
06122     dexpm1 = w*(0.5e0+(0.5e0-1.0e0/w));
06123     return dexpm1;
06124 } /* END */

double dinvnr	(	double *	p,
		double *	q
	)	`[static]`

Definition at line 6127 of file nifti_stats.c.

References cumnor(), dinvnr(), i, p, and stvaln().

Referenced by cdfnor(), dinvnr(), dt1(), and normal_pq2s().

06167 {
06168 #define maxit 100
06169 #define eps (1.0e-13)
06170 #define r2pi 0.3989422804014326e0
06171 #define nhalf (-0.5e0)
06172 #define dennor(x) (r2pi*exp(nhalf*(x)*(x)))
06173 static double dinvnr,strtx,xcur,cum,ccum,pp,dx;
06174 static int i;
06175 static unsigned long qporq;
06176 /*
06177      ..
06178      .. Executable Statements ..
06179 */
06180 /*
06181      FIND MINIMUM OF P AND Q
06182 */
06183     qporq = *p <= *q;
06184     if(!qporq) goto S10;
06185     pp = *p;
06186     goto S20;
06187 S10:
06188     pp = *q;
06189 S20:
06190 /*
06191      INITIALIZATION STEP
06192 */
06193     strtx = stvaln(&pp);
06194     xcur = strtx;
06195 /*
06196      NEWTON INTERATIONS
06197 */
06198     for(i=1; i<=maxit; i++) {
06199         cumnor(&xcur,&cum,&ccum);
06200         dx = (cum-pp)/dennor(xcur);
06201         xcur -= dx;
06202         if(fabs(dx/xcur) < eps) goto S40;
06203     }
06204     dinvnr = strtx;
06205 /*
06206      IF WE GET HERE, NEWTON HAS FAILED
06207 */
06208     if(!qporq) dinvnr = -dinvnr;
06209     return dinvnr;
06210 S40:
06211 /*
06212      IF WE GET HERE, NEWTON HAS SUCCEDED
06213 */
06214     dinvnr = xcur;
06215     if(!qporq) dinvnr = -dinvnr;
06216     return dinvnr;
06217 #undef maxit
06218 #undef eps
06219 #undef r2pi
06220 #undef nhalf
06221 #undef dennor
06222 } /* END */

void dinvr	(	int *	,
		double *	,
		double *	,
		unsigned long *	,
		unsigned long *
	)	`[static]`

Definition at line 6432 of file nifti_stats.c.

References E0000().

Referenced by cdfbet(), cdfbin(), cdfchi(), cdfchn(), cdff(), cdffnc(), cdfgam(), cdfnbn(), cdfpoi(), cdft(), invgauss_pq2s(), and tnonc_pq2s().

06494 {
06495     E0000(0,status,x,fx,qleft,qhi,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
06496 } /* END */

double dlanor ( double * ) [static]

Definition at line 6572 of file nifti_stats.c.

References devlpl(), dlanor(), dln1px(), and ftnstop().

Referenced by dlanor().

06608 {
06609 #define dlsqpi 0.91893853320467274177e0
06610 static double coef[12] = {
06611     -1.0e0,3.0e0,-15.0e0,105.0e0,-945.0e0,10395.0e0,-135135.0e0,2027025.0e0,
06612     -34459425.0e0,654729075.0e0,-13749310575.e0,316234143225.0e0
06613 };
06614 static int K1 = 12;
06615 static double dlanor,approx,correc,xx,xx2,T2;
06616 /*
06617      ..
06618      .. Executable Statements ..
06619 */
06620     xx = fabs(*x);
06621     if(xx < 5.0e0){ ftnstop("Argument too small in DLANOR"); return 66.6; }
06622     approx = -dlsqpi-0.5e0*xx*xx-log(xx);
06623     xx2 = xx*xx;
06624     T2 = 1.0e0/xx2;
06625     correc = devlpl(coef,&K1,&T2)/xx2;
06626     correc = dln1px(&correc);
06627     dlanor = approx+correc;
06628     return dlanor;
06629 #undef dlsqpi
06630 } /* END */

double dln1mx ( double * ) [static]

Definition at line 6633 of file nifti_stats.c.

References dln1mx(), and dln1px().

Referenced by dln1mx().

06665 {
06666 static double dln1mx,T1;
06667 /*
06668      ..
06669      .. Executable Statements ..
06670 */
06671     T1 = -*x;
06672     dln1mx = dln1px(&T1);
06673     return dln1mx;
06674 } /* END */

double dln1px ( double * ) [static]

Definition at line 6677 of file nifti_stats.c.

References a, and dln1px().

Referenced by dlanor(), dln1mx(), and dln1px().

06704                         :
06705      DiDinato, A. R. and Morris,  A.   H.  Algorithm 708: Significant
06706      Digit Computation of the Incomplete  Beta  Function Ratios.  ACM
06707      Trans. Math.  Softw. 18 (1993), 360-373.
06708 
06709 **********************************************************************
06710 -----------------------------------------------------------------------
06711             EVALUATION OF THE FUNCTION LN(1 + A)
06712 -----------------------------------------------------------------------
06713 */
06714 {
06715 static double p1 = -.129418923021993e+01;
06716 static double p2 = .405303492862024e+00;
06717 static double p3 = -.178874546012214e-01;
06718 static double q1 = -.162752256355323e+01;
06719 static double q2 = .747811014037616e+00;
06720 static double q3 = -.845104217945565e-01;
06721 static double dln1px,t,t2,w,x;
06722 /*
06723      ..
06724      .. Executable Statements ..
06725 */
06726     if(fabs(*a) > 0.375e0) goto S10;
06727     t = *a/(*a+2.0e0);
06728     t2 = t*t;
06729     w = (((p3*t2+p2)*t2+p1)*t2+1.0e0)/(((q3*t2+q2)*t2+q1)*t2+1.0e0);
06730     dln1px = 2.0e0*t*w;
06731     return dln1px;
06732 S10:
06733     x = 1.e0+*a;
06734     dln1px = log(x);
06735     return dln1px;
06736 } /* END */

double dlnbet	(	double *	,
		double *
	)	`[static]`

Definition at line 6739 of file nifti_stats.c.

References a, algdiv(), alnrel(), bcorr(), c, dlnbet(), fifdmax1(), fifdmin1(), gamln(), gsumln(), i, and v.

Referenced by dlnbet().

06766                         :
06767      DiDinato, A. R. and Morris,  A.   H.  Algorithm 708: Significant
06768      Digit Computation of the Incomplete  Beta  Function Ratios.  ACM
06769      Trans. Math.  Softw. 18 (1993), 360-373.
06770 
06771 **********************************************************************
06772 -----------------------------------------------------------------------
06773      EVALUATION OF THE LOGARITHM OF THE BETA FUNCTION
06774 -----------------------------------------------------------------------
06775      E = 0.5*LN(2*PI)
06776 --------------------------
06777 */
06778 {
06779 static double e = .918938533204673e0;
06780 static double dlnbet,a,b,c,h,u,v,w,z;
06781 static int i,n;
06782 static double T1;
06783 /*
06784      ..
06785      .. Executable Statements ..
06786 */
06787     a = fifdmin1(*a0,*b0);
06788     b = fifdmax1(*a0,*b0);
06789     if(a >= 8.0e0) goto S100;
06790     if(a >= 1.0e0) goto S20;
06791 /*
06792 -----------------------------------------------------------------------
06793                    PROCEDURE WHEN A .LT. 1
06794 -----------------------------------------------------------------------
06795 */
06796     if(b >= 8.0e0) goto S10;
06797     T1 = a+b;
06798     dlnbet = gamln(&a)+(gamln(&b)-gamln(&T1));
06799     return dlnbet;
06800 S10:
06801     dlnbet = gamln(&a)+algdiv(&a,&b);
06802     return dlnbet;
06803 S20:
06804 /*
06805 -----------------------------------------------------------------------
06806                 PROCEDURE WHEN 1 .LE. A .LT. 8
06807 -----------------------------------------------------------------------
06808 */
06809     if(a > 2.0e0) goto S40;
06810     if(b > 2.0e0) goto S30;
06811     dlnbet = gamln(&a)+gamln(&b)-gsumln(&a,&b);
06812     return dlnbet;
06813 S30:
06814     w = 0.0e0;
06815     if(b < 8.0e0) goto S60;
06816     dlnbet = gamln(&a)+algdiv(&a,&b);
06817     return dlnbet;
06818 S40:
06819 /*
06820                 REDUCTION OF A WHEN B .LE. 1000
06821 */
06822     if(b > 1000.0e0) goto S80;
06823     n = a-1.0e0;
06824     w = 1.0e0;
06825     for(i=1; i<=n; i++) {
06826         a -= 1.0e0;
06827         h = a/b;
06828         w *= (h/(1.0e0+h));
06829     }
06830     w = log(w);
06831     if(b < 8.0e0) goto S60;
06832     dlnbet = w+gamln(&a)+algdiv(&a,&b);
06833     return dlnbet;
06834 S60:
06835 /*
06836                  REDUCTION OF B WHEN B .LT. 8
06837 */
06838     n = b-1.0e0;
06839     z = 1.0e0;
06840     for(i=1; i<=n; i++) {
06841         b -= 1.0e0;
06842         z *= (b/(a+b));
06843     }
06844     dlnbet = w+log(z)+(gamln(&a)+(gamln(&b)-gsumln(&a,&b)));
06845     return dlnbet;
06846 S80:
06847 /*
06848                 REDUCTION OF A WHEN B .GT. 1000
06849 */
06850     n = a-1.0e0;
06851     w = 1.0e0;
06852     for(i=1; i<=n; i++) {
06853         a -= 1.0e0;
06854         w *= (a/(1.0e0+a/b));
06855     }
06856     dlnbet = log(w)-(double)n*log(b)+(gamln(&a)+algdiv(&a,&b));
06857     return dlnbet;
06858 S100:
06859 /*
06860 -----------------------------------------------------------------------
06861                    PROCEDURE WHEN A .GE. 8
06862 -----------------------------------------------------------------------
06863 */
06864     w = bcorr(&a,&b);
06865     h = a/b;
06866     c = h/(1.0e0+h);
06867     u = -((a-0.5e0)*log(c));
06868     v = b*alnrel(&h);
06869     if(u <= v) goto S110;
06870     dlnbet = -(0.5e0*log(b))+e+w-v-u;
06871     return dlnbet;
06872 S110:
06873     dlnbet = -(0.5e0*log(b))+e+w-u-v;
06874     return dlnbet;
06875 } /* END */

double dlngam ( double * ) [static]

Definition at line 6878 of file nifti_stats.c.

References a, dlngam(), gamln1(), and i.

Referenced by dlngam(), and dstrem().

06902                        :
06903      DiDinato, A. R. and Morris,  A.   H.  Algorithm 708: Significant
06904      Digit Computation of the Incomplete  Beta  Function Ratios.  ACM
06905      Trans. Math.  Softw. 18 (1993), 360-373.
06906 
06907 **********************************************************************
06908 -----------------------------------------------------------------------
06909             EVALUATION OF LN(GAMMA(A)) FOR POSITIVE A
06910 -----------------------------------------------------------------------
06911      WRITTEN BY ALFRED H. MORRIS
06912           NAVAL SURFACE WARFARE CENTER
06913           DAHLGREN, VIRGINIA
06914 --------------------------
06915      D = 0.5*(LN(2*PI) - 1)
06916 --------------------------
06917 */
06918 {
06919 static double c0 = .833333333333333e-01;
06920 static double c1 = -.277777777760991e-02;
06921 static double c2 = .793650666825390e-03;
06922 static double c3 = -.595202931351870e-03;
06923 static double c4 = .837308034031215e-03;
06924 static double c5 = -.165322962780713e-02;
06925 static double d = .418938533204673e0;
06926 static double dlngam,t,w;
06927 static int i,n;
06928 static double T1;
06929 /*
06930      ..
06931      .. Executable Statements ..
06932 */
06933     if(*a > 0.8e0) goto S10;
06934     dlngam = gamln1(a)-log(*a);
06935     return dlngam;
06936 S10:
06937     if(*a > 2.25e0) goto S20;
06938     t = *a-0.5e0-0.5e0;
06939     dlngam = gamln1(&t);
06940     return dlngam;
06941 S20:
06942     if(*a >= 10.0e0) goto S40;
06943     n = *a-1.25e0;
06944     t = *a;
06945     w = 1.0e0;
06946     for(i=1; i<=n; i++) {
06947         t -= 1.0e0;
06948         w = t*w;
06949     }
06950     T1 = t-1.0e0;
06951     dlngam = gamln1(&T1)+log(w);
06952     return dlngam;
06953 S40:
06954     t = pow(1.0e0/ *a,2.0);
06955     w = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/ *a;
06956     dlngam = d+w+(*a-0.5e0)*(log(*a)-1.0e0);
06957     return dlngam;
06958 } /* END */

void dstinv	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 6499 of file nifti_stats.c.

References E0000().

Referenced by cdfbet(), cdfbin(), cdfchi(), cdfchn(), cdff(), cdffnc(), cdfgam(), cdfnbn(), cdfpoi(), cdft(), invgauss_pq2s(), and tnonc_pq2s().

06566 {
06567     E0000(1,NULL,NULL,NULL,NULL,NULL,zabsst,zabsto,zbig,zrelst,zrelto,zsmall,
06568     zstpmu);
06569 } /* END */

double dstrem ( double * ) [static]

Definition at line 6961 of file nifti_stats.c.

References devlpl(), dlngam(), dstrem(), and ftnstop().

Referenced by dbetrm(), and dstrem().

06962 {
06963 /*
06964 **********************************************************************
06965      double dstrem(double *z)
06966              Double precision Sterling Remainder
06967                               Function
06968      Returns   Log(Gamma(Z))  -  Sterling(Z)  where   Sterling(Z)  is
06969      Sterling's Approximation to Log(Gamma(Z))
06970      Sterling(Z) = LOG( SQRT( 2*PI ) ) + ( Z-0.5 ) * LOG( Z ) - Z
06971                               Arguments
06972      Z --> Value at which Sterling remainder calculated
06973            Must be positive.
06974                   DOUBLE PRECISION Z
06975                               Method
06976      If Z >= 6 uses 9 terms of series in Bernoulli numbers
06977      (Values calculated using Maple)
06978      Otherwise computes difference explicitly
06979 **********************************************************************
06980 */
06981 #define hln2pi 0.91893853320467274178e0
06982 #define ncoef 10
06983 static double coef[ncoef] = {
06984     0.0e0,0.0833333333333333333333333333333e0,
06985     -0.00277777777777777777777777777778e0,0.000793650793650793650793650793651e0,
06986     -0.000595238095238095238095238095238e0,
06987     0.000841750841750841750841750841751e0,-0.00191752691752691752691752691753e0,
06988     0.00641025641025641025641025641026e0,-0.0295506535947712418300653594771e0,
06989     0.179644372368830573164938490016e0
06990 };
06991 static int K1 = 10;
06992 static double dstrem,sterl,T2;
06993 /*
06994      ..
06995      .. Executable Statements ..
06996 */
06997 /*
06998     For information, here are the next 11 coefficients of the
06999     remainder term in Sterling's formula
07000             -1.39243221690590111642743221691
07001             13.4028640441683919944789510007
07002             -156.848284626002017306365132452
07003             2193.10333333333333333333333333
07004             -36108.7712537249893571732652192
07005             691472.268851313067108395250776
07006             -0.152382215394074161922833649589D8
07007             0.382900751391414141414141414141D9
07008             -0.108822660357843910890151491655D11
07009             0.347320283765002252252252252252D12
07010             -0.123696021422692744542517103493D14
07011 */
07012     if(*z <= 0.0e0){ ftnstop("nonpositive argument in DSTREM"); return 66.6; }
07013     if(!(*z > 6.0e0)) goto S10;
07014     T2 = 1.0e0/pow(*z,2.0);
07015     dstrem = devlpl(coef,&K1,&T2)**z;
07016     goto S20;
07017 S10:
07018     sterl = hln2pi+(*z-0.5e0)*log(*z)-*z;
07019     dstrem = dlngam(z)-sterl;
07020 S20:
07021     return dstrem;
07022 #undef hln2pi
07023 #undef ncoef
07024 } /* END */

void dstzr	(	double *	zxlo,
		double *	zxhi,
		double *	zabstl,
		double *	zreltl
	)	`[static]`

Definition at line 7326 of file nifti_stats.c.

References E0001().

Referenced by cdfbet(), cdfbin(), cdfnbn(), and E0000().

07370 {
07371     E0001(1,NULL,NULL,NULL,NULL,NULL,NULL,NULL,zabstl,zreltl,zxhi,zxlo);
07372 } /* END */

double dt1	(	double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 7027 of file nifti_stats.c.

References devlpl(), dinvnr(), dt1(), i, and p.

Referenced by cdft(), and dt1().

07059 {
07060 static double coef[4][5] = {
07061     1.0e0,1.0e0,0.0e0,0.0e0,0.0e0,3.0e0,16.0e0,5.0e0,0.0e0,0.0e0,-15.0e0,17.0e0,
07062     19.0e0,3.0e0,0.0e0,-945.0e0,-1920.0e0,1482.0e0,776.0e0,79.0e0
07063 };
07064 static double denom[4] = {
07065     4.0e0,96.0e0,384.0e0,92160.0e0
07066 };
07067 static int ideg[4] = {
07068     2,3,4,5
07069 };
07070 static double dt1,denpow,sum,term,x,xp,xx;
07071 static int i;
07072 /*
07073      ..
07074      .. Executable Statements ..
07075 */
07076     x = fabs(dinvnr(p,q));
07077     xx = x*x;
07078     sum = x;
07079     denpow = 1.0e0;
07080     for(i=0; i<4; i++) {
07081         term = devlpl(&coef[i][0],&ideg[i],&xx)*x;
07082         denpow *= *df;
07083         sum += (term/(denpow*denom[i]));
07084     }
07085     if(!(*p >= 0.5e0)) goto S20;
07086     xp = sum;
07087     goto S30;
07088 S20:
07089     xp = -sum;
07090 S30:
07091     dt1 = xp;
07092     return dt1;
07093 } /* END */

void dzror	(	int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		unsigned long *	,
		unsigned long *
	)	`[static]`

Definition at line 7256 of file nifti_stats.c.

References E0001().

Referenced by cdfbet(), cdfbin(), cdfnbn(), and E0000().

07321 {
07322     E0001(0,status,x,fx,xlo,xhi,qleft,qhi,NULL,NULL,NULL,NULL);
07323 } /* END */

void E0000	(	int	,
		int *	,
		double *	,
		double *	,
		unsigned long *	,
		unsigned long *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 6225 of file nifti_stats.c.

References dstzr(), dzror(), fifdmax1(), fifdmin1(), and ftnstop().

Referenced by dinvr(), and dstinv().

06229 {
06230 #define qxmon(zx,zy,zz) (int)((zx) <= (zy) && (zy) <= (zz))
06231 static double absstp,abstol,big,fbig,fsmall,relstp,reltol,small,step,stpmul,xhi,
06232     xlb,xlo,xsave,xub,yy;
06233 static int i99999;
06234 static unsigned long qbdd,qcond,qdum1,qdum2,qincr,qlim,qok,qup;
06235     switch(IENTRY){case 0: goto DINVR; case 1: goto DSTINV;}
06236 DINVR:
06237     if(*status > 0) goto S310;
06238     qcond = !qxmon(small,*x,big);
06239     if(qcond){ ftnstop("SMALL,X,BIG nonmonotone in E0000"); *status=-1; return;}
06240     xsave = *x;
06241 /*
06242      See that SMALL and BIG bound the zero and set QINCR
06243 */
06244     *x = small;
06245 /*
06246      GET-FUNCTION-VALUE
06247 */
06248     i99999 = 1;
06249     goto S300;
06250 S10:
06251     fsmall = *fx;
06252     *x = big;
06253 /*
06254      GET-FUNCTION-VALUE
06255 */
06256     i99999 = 2;
06257     goto S300;
06258 S20:
06259     fbig = *fx;
06260     qincr = fbig > fsmall;
06261     if(!qincr) goto S50;
06262     if(fsmall <= 0.0e0) goto S30;
06263     *status = -1;
06264     *qleft = *qhi = 1;
06265     return;
06266 S30:
06267     if(fbig >= 0.0e0) goto S40;
06268     *status = -1;
06269     *qleft = *qhi = 0;
06270     return;
06271 S40:
06272     goto S80;
06273 S50:
06274     if(fsmall >= 0.0e0) goto S60;
06275     *status = -1;
06276     *qleft = 1;
06277     *qhi = 0;
06278     return;
06279 S60:
06280     if(fbig <= 0.0e0) goto S70;
06281     *status = -1;
06282     *qleft = 0;
06283     *qhi = 1;
06284     return;
06285 S80:
06286 S70:
06287     *x = xsave;
06288     step = fifdmax1(absstp,relstp*fabs(*x));
06289 /*
06290       YY = F(X) - Y
06291      GET-FUNCTION-VALUE
06292 */
06293     i99999 = 3;
06294     goto S300;
06295 S90:
06296     yy = *fx;
06297     if(!(yy == 0.0e0)) goto S100;
06298     *status = 0;
06299     qok = 1;
06300     return;
06301 S100:
06302     qup = qincr && yy < 0.0e0 || !qincr && yy > 0.0e0;
06303 /*
06304 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
06305      HANDLE CASE IN WHICH WE MUST STEP HIGHER
06306 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
06307 */
06308     if(!qup) goto S170;
06309     xlb = xsave;
06310     xub = fifdmin1(xlb+step,big);
06311     goto S120;
06312 S110:
06313     if(qcond) goto S150;
06314 S120:
06315 /*
06316       YY = F(XUB) - Y
06317 */
06318     *x = xub;
06319 /*
06320      GET-FUNCTION-VALUE
06321 */
06322     i99999 = 4;
06323     goto S300;
06324 S130:
06325     yy = *fx;
06326     qbdd = qincr && yy >= 0.0e0 || !qincr && yy <= 0.0e0;
06327     qlim = xub >= big;
06328     qcond = qbdd || qlim;
06329     if(qcond) goto S140;
06330     step = stpmul*step;
06331     xlb = xub;
06332     xub = fifdmin1(xlb+step,big);
06333 S140:
06334     goto S110;
06335 S150:
06336     if(!(qlim && !qbdd)) goto S160;
06337     *status = -1;
06338     *qleft = 0;
06339     *qhi = !qincr;
06340     *x = big;
06341     return;
06342 S160:
06343     goto S240;
06344 S170:
06345 /*
06346 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
06347      HANDLE CASE IN WHICH WE MUST STEP LOWER
06348 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
06349 */
06350     xub = xsave;
06351     xlb = fifdmax1(xub-step,small);
06352     goto S190;
06353 S180:
06354     if(qcond) goto S220;
06355 S190:
06356 /*
06357       YY = F(XLB) - Y
06358 */
06359     *x = xlb;
06360 /*
06361      GET-FUNCTION-VALUE
06362 */
06363     i99999 = 5;
06364     goto S300;
06365 S200:
06366     yy = *fx;
06367     qbdd = qincr && yy <= 0.0e0 || !qincr && yy >= 0.0e0;
06368     qlim = xlb <= small;
06369     qcond = qbdd || qlim;
06370     if(qcond) goto S210;
06371     step = stpmul*step;
06372     xub = xlb;
06373     xlb = fifdmax1(xub-step,small);
06374 S210:
06375     goto S180;
06376 S220:
06377     if(!(qlim && !qbdd)) goto S230;
06378     *status = -1;
06379     *qleft = 1;
06380     *qhi = qincr;
06381     *x = small;
06382     return;
06383 S240:
06384 S230:
06385     dstzr(&xlb,&xub,&abstol,&reltol);
06386 /*
06387 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
06388      IF WE REACH HERE, XLB AND XUB BOUND THE ZERO OF F.
06389 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
06390 */
06391     *status = 0;
06392     goto S260;
06393 S250:
06394     if(!(*status == 1)) goto S290;
06395 S260:
06396     dzror(status,x,fx,&xlo,&xhi,&qdum1,&qdum2);
06397     if(!(*status == 1)) goto S280;
06398 /*
06399      GET-FUNCTION-VALUE
06400 */
06401     i99999 = 6;
06402     goto S300;
06403 S280:
06404 S270:
06405     goto S250;
06406 S290:
06407     *x = xlo;
06408     *status = 0;
06409     return;
06410 DSTINV:
06411     small = *zsmall;
06412     big = *zbig;
06413     absstp = *zabsst;
06414     relstp = *zrelst;
06415     stpmul = *zstpmu;
06416     abstol = *zabsto;
06417     reltol = *zrelto;
06418     return;
06419 S300:
06420 /*
06421      TO GET-FUNCTION-VALUE
06422 */
06423     *status = 1;
06424     return;
06425 S310:
06426     switch((int)i99999){case 1: goto S10;case 2: goto S20;case 3: goto S90;case
06427       4: goto S130;case 5: goto S200;case 6: goto S270;default: break;}
06428 #undef qxmon
06429 } /* END */

void E0001	(	int	,
		int *	,
		double *	,
		double *	,
		double *	,
		double *	,
		unsigned long *	,
		unsigned long *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 7096 of file nifti_stats.c.

References a, c, fa, fb, fd, fifdsign(), and p.

Referenced by dstzr(), and dzror().

07100 {
07101 #define ftol(zx) (0.5e0*fifdmax1(abstol,reltol*fabs((zx))))
07102 static double a,abstol,b,c,d,fa,fb,fc,fd,fda,fdb,m,mb,p,q,reltol,tol,w,xxhi,xxlo;
07103 static int ext,i99999;
07104 static unsigned long first,qrzero;
07105     switch(IENTRY){case 0: goto DZROR; case 1: goto DSTZR;}
07106 DZROR:
07107     if(*status > 0) goto S280;
07108     *xlo = xxlo;
07109     *xhi = xxhi;
07110     b = *x = *xlo;
07111 /*
07112      GET-FUNCTION-VALUE
07113 */
07114     i99999 = 1;
07115     goto S270;
07116 S10:
07117     fb = *fx;
07118     *xlo = *xhi;
07119     a = *x = *xlo;
07120 /*
07121      GET-FUNCTION-VALUE
07122 */
07123     i99999 = 2;
07124     goto S270;
07125 S20:
07126 /*
07127      Check that F(ZXLO) < 0 < F(ZXHI)  or
07128                 F(ZXLO) > 0 > F(ZXHI)
07129 */
07130     if(!(fb < 0.0e0)) goto S40;
07131     if(!(*fx < 0.0e0)) goto S30;
07132     *status = -1;
07133     *qleft = *fx < fb;
07134     *qhi = 0;
07135     return;
07136 S40:
07137 S30:
07138     if(!(fb > 0.0e0)) goto S60;
07139     if(!(*fx > 0.0e0)) goto S50;
07140     *status = -1;
07141     *qleft = *fx > fb;
07142     *qhi = 1;
07143     return;
07144 S60:
07145 S50:
07146     fa = *fx;
07147     first = 1;
07148 S70:
07149     c = a;
07150     fc = fa;
07151     ext = 0;
07152 S80:
07153     if(!(fabs(fc) < fabs(fb))) goto S100;
07154     if(!(c != a)) goto S90;
07155     d = a;
07156     fd = fa;
07157 S90:
07158     a = b;
07159     fa = fb;
07160     *xlo = c;
07161     b = *xlo;
07162     fb = fc;
07163     c = a;
07164     fc = fa;
07165 S100:
07166     tol = ftol(*xlo);
07167     m = (c+b)*.5e0;
07168     mb = m-b;
07169     if(!(fabs(mb) > tol)) goto S240;
07170     if(!(ext > 3)) goto S110;
07171     w = mb;
07172     goto S190;
07173 S110:
07174     tol = fifdsign(tol,mb);
07175     p = (b-a)*fb;
07176     if(!first) goto S120;
07177     q = fa-fb;
07178     first = 0;
07179     goto S130;
07180 S120:
07181     fdb = (fd-fb)/(d-b);
07182     fda = (fd-fa)/(d-a);
07183     p = fda*p;
07184     q = fdb*fa-fda*fb;
07185 S130:
07186     if(!(p < 0.0e0)) goto S140;
07187     p = -p;
07188     q = -q;
07189 S140:
07190     if(ext == 3) p *= 2.0e0;
07191     if(!(p*1.0e0 == 0.0e0 || p <= q*tol)) goto S150;
07192     w = tol;
07193     goto S180;
07194 S150:
07195     if(!(p < mb*q)) goto S160;
07196     w = p/q;
07197     goto S170;
07198 S160:
07199     w = mb;
07200 S190:
07201 S180:
07202 S170:
07203     d = a;
07204     fd = fa;
07205     a = b;
07206     fa = fb;
07207     b += w;
07208     *xlo = b;
07209     *x = *xlo;
07210 /*
07211      GET-FUNCTION-VALUE
07212 */
07213     i99999 = 3;
07214     goto S270;
07215 S200:
07216     fb = *fx;
07217     if(!(fc*fb >= 0.0e0)) goto S210;
07218     goto S70;
07219 S210:
07220     if(!(w == mb)) goto S220;
07221     ext = 0;
07222     goto S230;
07223 S220:
07224     ext += 1;
07225 S230:
07226     goto S80;
07227 S240:
07228     *xhi = c;
07229     qrzero = fc >= 0.0e0 && fb <= 0.0e0 || fc < 0.0e0 && fb >= 0.0e0;
07230     if(!qrzero) goto S250;
07231     *status = 0;
07232     goto S260;
07233 S250:
07234     *status = -1;
07235 S260:
07236     return;
07237 DSTZR:
07238     xxlo = *zxlo;
07239     xxhi = *zxhi;
07240     abstol = *zabstl;
07241     reltol = *zreltl;
07242     return;
07243 S270:
07244 /*
07245      TO GET-FUNCTION-VALUE
07246 */
07247     *status = 1;
07248     return;
07249 S280:
07250     switch((int)i99999){case 1: goto S10;case 2: goto S20;case 3: goto S200;
07251       default: break;}
07252 #undef ftol
07253 } /* END */

double erf1 ( double * ) [static]

Definition at line 7375 of file nifti_stats.c.

References a, c, erf1(), fifdsign(), p, r, top, and x2.

Referenced by erf1(), grat1(), and gratio().

07381 {
07382 static double c = .564189583547756e0;
07383 static double a[5] = {
07384     .771058495001320e-04,-.133733772997339e-02,.323076579225834e-01,
07385     .479137145607681e-01,.128379167095513e+00
07386 };
07387 static double b[3] = {
07388     .301048631703895e-02,.538971687740286e-01,.375795757275549e+00
07389 };
07390 static double p[8] = {
07391     -1.36864857382717e-07,5.64195517478974e-01,7.21175825088309e+00,
07392     4.31622272220567e+01,1.52989285046940e+02,3.39320816734344e+02,
07393     4.51918953711873e+02,3.00459261020162e+02
07394 };
07395 static double q[8] = {
07396     1.00000000000000e+00,1.27827273196294e+01,7.70001529352295e+01,
07397     2.77585444743988e+02,6.38980264465631e+02,9.31354094850610e+02,
07398     7.90950925327898e+02,3.00459260956983e+02
07399 };
07400 static double r[5] = {
07401     2.10144126479064e+00,2.62370141675169e+01,2.13688200555087e+01,
07402     4.65807828718470e+00,2.82094791773523e-01
07403 };
07404 static double s[4] = {
07405     9.41537750555460e+01,1.87114811799590e+02,9.90191814623914e+01,
07406     1.80124575948747e+01
07407 };
07408 static double erf1,ax,bot,t,top,x2;
07409 /*
07410      ..
07411      .. Executable Statements ..
07412 */
07413     ax = fabs(*x);
07414     if(ax > 0.5e0) goto S10;
07415     t = *x**x;
07416     top = (((a[0]*t+a[1])*t+a[2])*t+a[3])*t+a[4]+1.0e0;
07417     bot = ((b[0]*t+b[1])*t+b[2])*t+1.0e0;
07418     erf1 = *x*(top/bot);
07419     return erf1;
07420 S10:
07421     if(ax > 4.0e0) goto S20;
07422     top = ((((((p[0]*ax+p[1])*ax+p[2])*ax+p[3])*ax+p[4])*ax+p[5])*ax+p[6])*ax+p[
07423       7];
07424     bot = ((((((q[0]*ax+q[1])*ax+q[2])*ax+q[3])*ax+q[4])*ax+q[5])*ax+q[6])*ax+q[
07425       7];
07426     erf1 = 0.5e0+(0.5e0-exp(-(*x**x))*top/bot);
07427     if(*x < 0.0e0) erf1 = -erf1;
07428     return erf1;
07429 S20:
07430     if(ax >= 5.8e0) goto S30;
07431     x2 = *x**x;
07432     t = 1.0e0/x2;
07433     top = (((r[0]*t+r[1])*t+r[2])*t+r[3])*t+r[4];
07434     bot = (((s[0]*t+s[1])*t+s[2])*t+s[3])*t+1.0e0;
07435     erf1 = (c-top/(x2*bot))/ax;
07436     erf1 = 0.5e0+(0.5e0-exp(-x2)*erf1);
07437     if(*x < 0.0e0) erf1 = -erf1;
07438     return erf1;
07439 S30:
07440     erf1 = fifdsign(1.0e0,*x);
07441     return erf1;
07442 } /* END */

double erfc1	(	int *	,
		double *
	)	`[static]`

Definition at line 7445 of file nifti_stats.c.

References a, c, erfc1(), exparg(), ind, p, r, and top.

Referenced by basym(), erfc1(), grat1(), and gratio().

07454 {
07455 static double c = .564189583547756e0;
07456 static double a[5] = {
07457     .771058495001320e-04,-.133733772997339e-02,.323076579225834e-01,
07458     .479137145607681e-01,.128379167095513e+00
07459 };
07460 static double b[3] = {
07461     .301048631703895e-02,.538971687740286e-01,.375795757275549e+00
07462 };
07463 static double p[8] = {
07464     -1.36864857382717e-07,5.64195517478974e-01,7.21175825088309e+00,
07465     4.31622272220567e+01,1.52989285046940e+02,3.39320816734344e+02,
07466     4.51918953711873e+02,3.00459261020162e+02
07467 };
07468 static double q[8] = {
07469     1.00000000000000e+00,1.27827273196294e+01,7.70001529352295e+01,
07470     2.77585444743988e+02,6.38980264465631e+02,9.31354094850610e+02,
07471     7.90950925327898e+02,3.00459260956983e+02
07472 };
07473 static double r[5] = {
07474     2.10144126479064e+00,2.62370141675169e+01,2.13688200555087e+01,
07475     4.65807828718470e+00,2.82094791773523e-01
07476 };
07477 static double s[4] = {
07478     9.41537750555460e+01,1.87114811799590e+02,9.90191814623914e+01,
07479     1.80124575948747e+01
07480 };
07481 static int K1 = 1;
07482 static double erfc1,ax,bot,e,t,top,w;
07483 /*
07484      ..
07485      .. Executable Statements ..
07486 */
07487 /*
07488                      ABS(X) .LE. 0.5
07489 */
07490     ax = fabs(*x);
07491     if(ax > 0.5e0) goto S10;
07492     t = *x**x;
07493     top = (((a[0]*t+a[1])*t+a[2])*t+a[3])*t+a[4]+1.0e0;
07494     bot = ((b[0]*t+b[1])*t+b[2])*t+1.0e0;
07495     erfc1 = 0.5e0+(0.5e0-*x*(top/bot));
07496     if(*ind != 0) erfc1 = exp(t)*erfc1;
07497     return erfc1;
07498 S10:
07499 /*
07500                   0.5 .LT. ABS(X) .LE. 4
07501 */
07502     if(ax > 4.0e0) goto S20;
07503     top = ((((((p[0]*ax+p[1])*ax+p[2])*ax+p[3])*ax+p[4])*ax+p[5])*ax+p[6])*ax+p[
07504       7];
07505     bot = ((((((q[0]*ax+q[1])*ax+q[2])*ax+q[3])*ax+q[4])*ax+q[5])*ax+q[6])*ax+q[
07506       7];
07507     erfc1 = top/bot;
07508     goto S40;
07509 S20:
07510 /*
07511                       ABS(X) .GT. 4
07512 */
07513     if(*x <= -5.6e0) goto S60;
07514     if(*ind != 0) goto S30;
07515     if(*x > 100.0e0) goto S70;
07516     if(*x**x > -exparg(&K1)) goto S70;
07517 S30:
07518     t = pow(1.0e0/ *x,2.0);
07519     top = (((r[0]*t+r[1])*t+r[2])*t+r[3])*t+r[4];
07520     bot = (((s[0]*t+s[1])*t+s[2])*t+s[3])*t+1.0e0;
07521     erfc1 = (c-t*top/bot)/ax;
07522 S40:
07523 /*
07524                       FINAL ASSEMBLY
07525 */
07526     if(*ind == 0) goto S50;
07527     if(*x < 0.0e0) erfc1 = 2.0e0*exp(*x**x)-erfc1;
07528     return erfc1;
07529 S50:
07530     w = *x**x;
07531     t = w;
07532     e = w-t;
07533     erfc1 = (0.5e0+(0.5e0-e))*exp(-t)*erfc1;
07534     if(*x < 0.0e0) erfc1 = 2.0e0-erfc1;
07535     return erfc1;
07536 S60:
07537 /*
07538              LIMIT VALUE FOR LARGE NEGATIVE X
07539 */
07540     erfc1 = 2.0e0;
07541     if(*ind != 0) erfc1 = 2.0e0*exp(*x**x);
07542     return erfc1;
07543 S70:
07544 /*
07545              LIMIT VALUE FOR LARGE POSITIVE X
07546                        WHEN IND = 0
07547 */
07548     erfc1 = 0.0e0;
07549     return erfc1;
07550 } /* END */

double esum	(	int *	,
		double *
	)	`[static]`

Definition at line 7553 of file nifti_stats.c.

References esum().

Referenced by brcmp1(), and esum().

07559 {
07560 static double esum,w;
07561 /*
07562      ..
07563      .. Executable Statements ..
07564 */
07565     if(*x > 0.0e0) goto S10;
07566     if(*mu < 0) goto S20;
07567     w = (double)*mu+*x;
07568     if(w > 0.0e0) goto S20;
07569     esum = exp(w);
07570     return esum;
07571 S10:
07572     if(*mu > 0) goto S20;
07573     w = (double)*mu+*x;
07574     if(w < 0.0e0) goto S20;
07575     esum = exp(w);
07576     return esum;
07577 S20:
07578     w = *mu;
07579     esum = exp(w)*exp(*x);
07580     return esum;
07581 } /* END */

double exparg ( int * ) [static]

Definition at line 7584 of file nifti_stats.c.

References exparg(), ipmpar(), and l.

Referenced by bup(), erfc1(), exparg(), fpser(), and Xgamm().

07596 {
07597 static int K1 = 4;
07598 static int K2 = 9;
07599 static int K3 = 10;
07600 static double exparg,lnb;
07601 static int b,m;
07602 /*
07603      ..
07604      .. Executable Statements ..
07605 */
07606     b = ipmpar(&K1);
07607     if(b != 2) goto S10;
07608     lnb = .69314718055995e0;
07609     goto S40;
07610 S10:
07611     if(b != 8) goto S20;
07612     lnb = 2.0794415416798e0;
07613     goto S40;
07614 S20:
07615     if(b != 16) goto S30;
07616     lnb = 2.7725887222398e0;
07617     goto S40;
07618 S30:
07619     lnb = log((double)b);
07620 S40:
07621     if(*l == 0) goto S50;
07622     m = ipmpar(&K2)-1;
07623     exparg = 0.99999e0*((double)m*lnb);
07624     return exparg;
07625 S50:
07626     m = ipmpar(&K3);
07627     exparg = 0.99999e0*((double)m*lnb);
07628     return exparg;
07629 } /* END */

double extval1_pq2s ( pqpair pq ) [static]

Definition at line 10779 of file nifti_stats.c.

References BIGG, and pqpair::p.

Referenced by pq2stat().

10780 {
10781         if( pq.p <= 0.0 ) return -BIGG ;
10782    else if( pq.p >= 1.0 ) return  BIGG ;
10783    return -log(-log(pq.p)) ;
10784 }

pqpair extval1_s2pq ( double x ) [static]

Definition at line 10765 of file nifti_stats.c.

References pqpair::p, p, and pqpair::q.

Referenced by stat2pq().

10766 {
10767    double p,q,y ; pqpair pq ;
10768 
10769    if( x > -5.0 ){ y = exp(-x) ; p = exp(-y) ; }
10770    else          { y = 1.0     ; p = 0.0     ; }
10771 
10772    if( y >= 1.e-4 ) q = 1.0-p ;
10773    else             q = y*(1.0+y*(-0.5+y*(1.0/6.0-y/24.0))) ;
10774    pq.p = p ; pq.q = q ; return pq ;
10775 }

double fifdint ( double ) [static]

Definition at line 9408 of file nifti_stats.c.

References a.

Referenced by cumnor().

09410        :
09411 Truncates a double precision number to an integer and returns the
09412 value in a double.
09413 ************************************************************************/
09414 /* a     -     number to be truncated */
09415 {
09416   return (double) ((int) a);
09417 } /* END */

double fifdmax1	(	double	,
		double
	)	`[static]`

Definition at line 9420 of file nifti_stats.c.

References a.

Referenced by bcorr(), betaln(), bpser(), bratio(), brcmp1(), brcomp(), dbetrm(), dlnbet(), E0000(), gaminv(), and gratio().

09422         :
09423 returns the maximum of two numbers a and b
09424 ************************************************************************/
09425 /* a     -      first number */
09426 /* b     -      second number */
09427 {
09428   if (a < b) return b;
09429   else return a;
09430 } /* END */

double fifdmin1	(	double	,
		double
	)	`[static]`

Definition at line 9433 of file nifti_stats.c.

References a.

Referenced by bcorr(), betaln(), bpser(), bratio(), brcmp1(), brcomp(), dbetrm(), dlnbet(), E0000(), and psi().

09435         :
09436 returns the minimum of two numbers a and b
09437 ************************************************************************/
09438 /* a     -     first number */
09439 /* b     -     second number */
09440 {
09441   if (a < b) return a;
09442   else return b;
09443 } /* END */

double fifdsign	(	double	,
		double
	)	`[static]`

Definition at line 9446 of file nifti_stats.c.

Referenced by E0001(), and erf1().

09448         :
09449 transfers the sign of the variable "sign" to the variable "mag"
09450 ************************************************************************/
09451 /* mag     -     magnitude */
09452 /* sign    -     sign to be transfered */
09453 {
09454   if (mag < 0) mag = -mag;
09455   if (sign < 0) mag = -mag;
09456   return mag;
09457 
09458 } /* END */

long fifidint ( double ) [static]

Definition at line 9461 of file nifti_stats.c.

References a.

Referenced by alngam(), cumchn(), gratio(), psi(), and Xgamm().

09463         :
09464 Truncates a double precision number to a long integer
09465 ************************************************************************/
09466 /* a - number to be truncated */
09467 {
09468   if (a < 1.0) return (long) 0;
09469   else return (long) a;
09470 } /* END */

long fifmod	(	long	,
		long
	)	`[static]`

Definition at line 9473 of file nifti_stats.c.

References a.

Referenced by Xgamm().

09475       :
09476 returns the modulo of a and b
09477 ************************************************************************/
09478 /* a - numerator */
09479 /* b - denominator */
09480 {
09481   return a % b;
09482 } /* END */

double fnonc_pq2s	(	pqpair	pq,
		double	dofnum,
		double	dofden,
		double	nonc
	)	`[static]`

Definition at line 9985 of file nifti_stats.c.

References BIGG, cdffnc(), pqpair::p, p, and pqpair::q.

Referenced by pq2stat().

09986 {
09987    int which , status ;
09988    double p , q , f , dfn , dfd , bound , pnonc ;
09989 
09990    which  = 2 ;
09991    p      = pq.p ;   if( p <= 0.0 ) return 0.0 ;
09992    q      = pq.q ;   if( q <= 0.0 ) return BIGG ;
09993    f      = 0.0 ;
09994    dfn    = dofnum ;
09995    dfd    = dofden ;
09996    pnonc  = nonc ;
09997 
09998    cdffnc( &which , &p , &q , &f , &dfn , &dfd , &pnonc , &status , &bound ) ;
09999    return f ;
10000 }

pqpair fnonc_s2pq	(	double	ff,
		double	dofnum,
		double	dofden,
		double	nonc
	)	`[static]`

Definition at line 10004 of file nifti_stats.c.

References cdffnc(), pqpair::p, p, and pqpair::q.

Referenced by stat2pq().

10005 {
10006    int which , status ;
10007    double p , q , f , dfn , dfd , bound , pnonc ;
10008    pqpair pq={0.0,1.0} ;
10009 
10010    which  = 1 ;
10011    p      = 0.0 ;
10012    q      = 1.0 ;
10013    f      = ff ;     if(   f   <= 0.0 ) return pq ;
10014    dfn    = dofnum ; if( dfn   <= 0.0 ) return pq ;
10015    dfd    = dofden ; if( dfd   <= 0.0 ) return pq ;
10016    pnonc  = nonc ;   if( pnonc <  0.0 ) return pq ;
10017 
10018    cdffnc( &which , &p , &q , &f , &dfn , &dfd , &pnonc , &status , &bound ) ;
10019    pq.p = p ; pq.q = q ; return pq ;
10020 }

double fpser	(	double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 7632 of file nifti_stats.c.

References a, c, exparg(), and fpser().

Referenced by bratio(), and fpser().

07645 {
07646 static int K1 = 1;
07647 static double fpser,an,c,s,t,tol;
07648 /*
07649      ..
07650      .. Executable Statements ..
07651 */
07652     fpser = 1.0e0;
07653     if(*a <= 1.e-3**eps) goto S10;
07654     fpser = 0.0e0;
07655     t = *a*log(*x);
07656     if(t < exparg(&K1)) return fpser;
07657     fpser = exp(t);
07658 S10:
07659 /*
07660                 NOTE THAT 1/B(A,B) = B
07661 */
07662     fpser = *b/ *a*fpser;
07663     tol = *eps/ *a;
07664     an = *a+1.0e0;
07665     t = *x;
07666     s = t/an;
07667 S20:
07668     an += 1.0e0;
07669     t = *x*t;
07670     c = t/an;
07671     s += c;
07672     if(fabs(c) > tol) goto S20;
07673     fpser *= (1.0e0+*a*s);
07674     return fpser;
07675 } /* END */

double fstat_pq2s	(	pqpair	pq,
		double	dofnum,
		double	dofden
	)	`[static]`

Definition at line 9946 of file nifti_stats.c.

References BIGG, cdff(), pqpair::p, p, and pqpair::q.

Referenced by pq2stat().

09947 {
09948    int which , status ;
09949    double p , q , f , dfn , dfd , bound ;
09950 
09951    which  = 2 ;
09952    p      = pq.p ; if( p <= 0.0 ) return 0.0 ;
09953    q      = pq.q ; if( q <= 0.0 ) return BIGG ;
09954    f      = 0.0 ;
09955    dfn    = dofnum ;
09956    dfd    = dofden ;
09957 
09958    cdff( &which , &p , &q , &f , &dfn , &dfd , &status , &bound ) ;
09959    return f ;
09960 }

pqpair fstat_s2pq	(	double	ff,
		double	dofnum,
		double	dofden
	)	`[static]`

Definition at line 9964 of file nifti_stats.c.

References cdff(), pqpair::p, p, and pqpair::q.

Referenced by stat2pq().

09965 {
09966    int which , status ;
09967    double p , q , f , dfn , dfd , bound ;
09968    pqpair pq={0.0,1.0} ;
09969 
09970    which  = 1 ;
09971    p      = 0.0 ;
09972    q      = 1.0 ;
09973    f      = ff ;     if( f   <= 0.0 ) return pq;
09974    dfn    = dofnum ; if( dfn <= 0.0 ) return pq ;
09975    dfd    = dofden ; if( dfd <= 0.0 ) return pq ;
09976 
09977    cdff( &which , &p , &q , &f , &dfn , &dfd , &status , &bound ) ;
09978    pq.p = p ; pq.q = q ; return pq ;
09979 }

void ftnstop ( char * ) [static]

Definition at line 9485 of file nifti_stats.c.

Referenced by dlanor(), dstrem(), and E0000().

09487        :
09488 Prints msg to standard error and then exits
09489 ************************************************************************/
09490 /* msg - error message */
09491 {
09492   if (msg != NULL) fprintf(stderr,"*** CDFLIB ERROR: %s\n",msg);
09493   /** exit(1); **/  /** RWCox - DON'T EXIT */
09494 } /* END */

double gam1 ( double * ) [static]

Definition at line 7678 of file nifti_stats.c.

References a, gam1(), p, r, s2, and top.

Referenced by bgrat(), bpser(), brcmp1(), brcomp(), gam1(), grat1(), gratio(), and rcomp().

07684 {
07685 static double s1 = .273076135303957e+00;
07686 static double s2 = .559398236957378e-01;
07687 static double p[7] = {
07688     .577215664901533e+00,-.409078193005776e+00,-.230975380857675e+00,
07689     .597275330452234e-01,.766968181649490e-02,-.514889771323592e-02,
07690     .589597428611429e-03
07691 };
07692 static double q[5] = {
07693     .100000000000000e+01,.427569613095214e+00,.158451672430138e+00,
07694     .261132021441447e-01,.423244297896961e-02
07695 };
07696 static double r[9] = {
07697     -.422784335098468e+00,-.771330383816272e+00,-.244757765222226e+00,
07698     .118378989872749e+00,.930357293360349e-03,-.118290993445146e-01,
07699     .223047661158249e-02,.266505979058923e-03,-.132674909766242e-03
07700 };
07701 static double gam1,bot,d,t,top,w,T1;
07702 /*
07703      ..
07704      .. Executable Statements ..
07705 */
07706     t = *a;
07707     d = *a-0.5e0;
07708     if(d > 0.0e0) t = d-0.5e0;
07709     T1 = t;
07710     if(T1 < 0) goto S40;
07711     else if(T1 == 0) goto S10;
07712     else  goto S20;
07713 S10:
07714     gam1 = 0.0e0;
07715     return gam1;
07716 S20:
07717     top = (((((p[6]*t+p[5])*t+p[4])*t+p[3])*t+p[2])*t+p[1])*t+p[0];
07718     bot = (((q[4]*t+q[3])*t+q[2])*t+q[1])*t+1.0e0;
07719     w = top/bot;
07720     if(d > 0.0e0) goto S30;
07721     gam1 = *a*w;
07722     return gam1;
07723 S30:
07724     gam1 = t/ *a*(w-0.5e0-0.5e0);
07725     return gam1;
07726 S40:
07727     top = (((((((r[8]*t+r[7])*t+r[6])*t+r[5])*t+r[4])*t+r[3])*t+r[2])*t+r[1])*t+
07728       r[0];
07729     bot = (s2*t+s1)*t+1.0e0;
07730     w = top/bot;
07731     if(d > 0.0e0) goto S50;
07732     gam1 = *a*(w+0.5e0+0.5e0);
07733     return gam1;
07734 S50:
07735     gam1 = t*w/ *a;
07736     return gam1;
07737 } /* END */

void gaminv	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		int *
	)	`[static]`

Definition at line 7740 of file nifti_stats.c.

References a, a2, alnrel(), amax, c, fifdmax1(), gamln(), gamln1(), gratio(), p, r, rcomp(), s2, spmpar(), x0, Xgamm(), and xn.

Referenced by cdfgam().

07795 {
07796 static double a0 = 3.31125922108741e0;
07797 static double a1 = 11.6616720288968e0;
07798 static double a2 = 4.28342155967104e0;
07799 static double a3 = .213623493715853e0;
07800 static double b1 = 6.61053765625462e0;
07801 static double b2 = 6.40691597760039e0;
07802 static double b3 = 1.27364489782223e0;
07803 static double b4 = .036117081018842e0;
07804 static double c = .577215664901533e0;
07805 static double ln10 = 2.302585e0;
07806 static double tol = 1.e-5;
07807 static double amin[2] = {
07808     500.0e0,100.0e0
07809 };
07810 static double bmin[2] = {
07811     1.e-28,1.e-13
07812 };
07813 static double dmin[2] = {
07814     1.e-06,1.e-04
07815 };
07816 static double emin[2] = {
07817     2.e-03,6.e-03
07818 };
07819 static double eps0[2] = {
07820     1.e-10,1.e-08
07821 };
07822 static int K1 = 1;
07823 static int K2 = 2;
07824 static int K3 = 3;
07825 static int K8 = 0;
07826 static double am1,amax,ap1,ap2,ap3,apn,b,c1,c2,c3,c4,c5,d,e,e2,eps,g,h,pn,qg,qn,
07827     r,rta,s,s2,sum,t,u,w,xmax,xmin,xn,y,z;
07828 static int iop;
07829 static double T4,T5,T6,T7,T9;
07830 /*
07831      ..
07832      .. Executable Statements ..
07833 */
07834 /*
07835      ****** E, XMIN, AND XMAX ARE MACHINE DEPENDENT CONSTANTS.
07836             E IS THE SMALLEST NUMBER FOR WHICH 1.0 + E .GT. 1.0.
07837             XMIN IS THE SMALLEST POSITIVE NUMBER AND XMAX IS THE
07838             LARGEST POSITIVE NUMBER.
07839 */
07840     e = spmpar(&K1);
07841     xmin = spmpar(&K2);
07842     xmax = spmpar(&K3);
07843     *x = 0.0e0;
07844     if(*a <= 0.0e0) goto S300;
07845     t = *p+*q-1.e0;
07846     if(fabs(t) > e) goto S320;
07847     *ierr = 0;
07848     if(*p == 0.0e0) return;
07849     if(*q == 0.0e0) goto S270;
07850     if(*a == 1.0e0) goto S280;
07851     e2 = 2.0e0*e;
07852     amax = 0.4e-10/(e*e);
07853     iop = 1;
07854     if(e > 1.e-10) iop = 2;
07855     eps = eps0[iop-1];
07856     xn = *x0;
07857     if(*x0 > 0.0e0) goto S160;
07858 /*
07859         SELECTION OF THE INITIAL APPROXIMATION XN OF X
07860                        WHEN A .LT. 1
07861 */
07862     if(*a > 1.0e0) goto S80;
07863     T4 = *a+1.0e0;
07864     g = Xgamm(&T4);
07865     qg = *q*g;
07866     if(qg == 0.0e0) goto S360;
07867     b = qg/ *a;
07868     if(qg > 0.6e0**a) goto S40;
07869     if(*a >= 0.30e0 || b < 0.35e0) goto S10;
07870     t = exp(-(b+c));
07871     u = t*exp(t);
07872     xn = t*exp(u);
07873     goto S160;
07874 S10:
07875     if(b >= 0.45e0) goto S40;
07876     if(b == 0.0e0) goto S360;
07877     y = -log(b);
07878     s = 0.5e0+(0.5e0-*a);
07879     z = log(y);
07880     t = y-s*z;
07881     if(b < 0.15e0) goto S20;
07882     xn = y-s*log(t)-log(1.0e0+s/(t+1.0e0));
07883     goto S220;
07884 S20:
07885     if(b <= 0.01e0) goto S30;
07886     u = ((t+2.0e0*(3.0e0-*a))*t+(2.0e0-*a)*(3.0e0-*a))/((t+(5.0e0-*a))*t+2.0e0);
07887     xn = y-s*log(t)-log(u);
07888     goto S220;
07889 S30:
07890     c1 = -(s*z);
07891     c2 = -(s*(1.0e0+c1));
07892     c3 = s*((0.5e0*c1+(2.0e0-*a))*c1+(2.5e0-1.5e0**a));
07893     c4 = -(s*(((c1/3.0e0+(2.5e0-1.5e0**a))*c1+((*a-6.0e0)**a+7.0e0))*c1+(
07894       (11.0e0**a-46.0)**a+47.0e0)/6.0e0));
07895     c5 = -(s*((((-(c1/4.0e0)+(11.0e0**a-17.0e0)/6.0e0)*c1+((-(3.0e0**a)+13.0e0)*
07896       *a-13.0e0))*c1+0.5e0*(((2.0e0**a-25.0e0)**a+72.0e0)**a-61.0e0))*c1+((
07897       (25.0e0**a-195.0e0)**a+477.0e0)**a-379.0e0)/12.0e0));
07898     xn = (((c5/y+c4)/y+c3)/y+c2)/y+c1+y;
07899     if(*a > 1.0e0) goto S220;
07900     if(b > bmin[iop-1]) goto S220;
07901     *x = xn;
07902     return;
07903 S40:
07904     if(b**q > 1.e-8) goto S50;
07905     xn = exp(-(*q/ *a+c));
07906     goto S70;
07907 S50:
07908     if(*p <= 0.9e0) goto S60;
07909     T5 = -*q;
07910     xn = exp((alnrel(&T5)+gamln1(a))/ *a);
07911     goto S70;
07912 S60:
07913     xn = exp(log(*p*g)/ *a);
07914 S70:
07915     if(xn == 0.0e0) goto S310;
07916     t = 0.5e0+(0.5e0-xn/(*a+1.0e0));
07917     xn /= t;
07918     goto S160;
07919 S80:
07920 /*
07921         SELECTION OF THE INITIAL APPROXIMATION XN OF X
07922                        WHEN A .GT. 1
07923 */
07924     if(*q <= 0.5e0) goto S90;
07925     w = log(*p);
07926     goto S100;
07927 S90:
07928     w = log(*q);
07929 S100:
07930     t = sqrt(-(2.0e0*w));
07931     s = t-(((a3*t+a2)*t+a1)*t+a0)/((((b4*t+b3)*t+b2)*t+b1)*t+1.0e0);
07932     if(*q > 0.5e0) s = -s;
07933     rta = sqrt(*a);
07934     s2 = s*s;
07935     xn = *a+s*rta+(s2-1.0e0)/3.0e0+s*(s2-7.0e0)/(36.0e0*rta)-((3.0e0*s2+7.0e0)*
07936       s2-16.0e0)/(810.0e0**a)+s*((9.0e0*s2+256.0e0)*s2-433.0e0)/(38880.0e0**a*
07937       rta);
07938     xn = fifdmax1(xn,0.0e0);
07939     if(*a < amin[iop-1]) goto S110;
07940     *x = xn;
07941     d = 0.5e0+(0.5e0-*x/ *a);
07942     if(fabs(d) <= dmin[iop-1]) return;
07943 S110:
07944     if(*p <= 0.5e0) goto S130;
07945     if(xn < 3.0e0**a) goto S220;
07946     y = -(w+gamln(a));
07947     d = fifdmax1(2.0e0,*a*(*a-1.0e0));
07948     if(y < ln10*d) goto S120;
07949     s = 1.0e0-*a;
07950     z = log(y);
07951     goto S30;
07952 S120:
07953     t = *a-1.0e0;
07954     T6 = -(t/(xn+1.0e0));
07955     xn = y+t*log(xn)-alnrel(&T6);
07956     T7 = -(t/(xn+1.0e0));
07957     xn = y+t*log(xn)-alnrel(&T7);
07958     goto S220;
07959 S130:
07960     ap1 = *a+1.0e0;
07961     if(xn > 0.70e0*ap1) goto S170;
07962     w += gamln(&ap1);
07963     if(xn > 0.15e0*ap1) goto S140;
07964     ap2 = *a+2.0e0;
07965     ap3 = *a+3.0e0;
07966     *x = exp((w+*x)/ *a);
07967     *x = exp((w+*x-log(1.0e0+*x/ap1*(1.0e0+*x/ap2)))/ *a);
07968     *x = exp((w+*x-log(1.0e0+*x/ap1*(1.0e0+*x/ap2)))/ *a);
07969     *x = exp((w+*x-log(1.0e0+*x/ap1*(1.0e0+*x/ap2*(1.0e0+*x/ap3))))/ *a);
07970     xn = *x;
07971     if(xn > 1.e-2*ap1) goto S140;
07972     if(xn <= emin[iop-1]*ap1) return;
07973     goto S170;
07974 S140:
07975     apn = ap1;
07976     t = xn/apn;
07977     sum = 1.0e0+t;
07978 S150:
07979     apn += 1.0e0;
07980     t *= (xn/apn);
07981     sum += t;
07982     if(t > 1.e-4) goto S150;
07983     t = w-log(sum);
07984     xn = exp((xn+t)/ *a);
07985     xn *= (1.0e0-(*a*log(xn)-xn-t)/(*a-xn));
07986     goto S170;
07987 S160:
07988 /*
07989                  SCHRODER ITERATION USING P
07990 */
07991     if(*p > 0.5e0) goto S220;
07992 S170:
07993     if(*p <= 1.e10*xmin) goto S350;
07994     am1 = *a-0.5e0-0.5e0;
07995 S180:
07996     if(*a <= amax) goto S190;
07997     d = 0.5e0+(0.5e0-xn/ *a);
07998     if(fabs(d) <= e2) goto S350;
07999 S190:
08000     if(*ierr >= 20) goto S330;
08001     *ierr += 1;
08002     gratio(a,&xn,&pn,&qn,&K8);
08003     if(pn == 0.0e0 || qn == 0.0e0) goto S350;
08004     r = rcomp(a,&xn);
08005     if(r == 0.0e0) goto S350;
08006     t = (pn-*p)/r;
08007     w = 0.5e0*(am1-xn);
08008     if(fabs(t) <= 0.1e0 && fabs(w*t) <= 0.1e0) goto S200;
08009     *x = xn*(1.0e0-t);
08010     if(*x <= 0.0e0) goto S340;
08011     d = fabs(t);
08012     goto S210;
08013 S200:
08014     h = t*(1.0e0+w*t);
08015     *x = xn*(1.0e0-h);
08016     if(*x <= 0.0e0) goto S340;
08017     if(fabs(w) >= 1.0e0 && fabs(w)*t*t <= eps) return;
08018     d = fabs(h);
08019 S210:
08020     xn = *x;
08021     if(d > tol) goto S180;
08022     if(d <= eps) return;
08023     if(fabs(*p-pn) <= tol**p) return;
08024     goto S180;
08025 S220:
08026 /*
08027                  SCHRODER ITERATION USING Q
08028 */
08029     if(*q <= 1.e10*xmin) goto S350;
08030     am1 = *a-0.5e0-0.5e0;
08031 S230:
08032     if(*a <= amax) goto S240;
08033     d = 0.5e0+(0.5e0-xn/ *a);
08034     if(fabs(d) <= e2) goto S350;
08035 S240:
08036     if(*ierr >= 20) goto S330;
08037     *ierr += 1;
08038     gratio(a,&xn,&pn,&qn,&K8);
08039     if(pn == 0.0e0 || qn == 0.0e0) goto S350;
08040     r = rcomp(a,&xn);
08041     if(r == 0.0e0) goto S350;
08042     t = (*q-qn)/r;
08043     w = 0.5e0*(am1-xn);
08044     if(fabs(t) <= 0.1e0 && fabs(w*t) <= 0.1e0) goto S250;
08045     *x = xn*(1.0e0-t);
08046     if(*x <= 0.0e0) goto S340;
08047     d = fabs(t);
08048     goto S260;
08049 S250:
08050     h = t*(1.0e0+w*t);
08051     *x = xn*(1.0e0-h);
08052     if(*x <= 0.0e0) goto S340;
08053     if(fabs(w) >= 1.0e0 && fabs(w)*t*t <= eps) return;
08054     d = fabs(h);
08055 S260:
08056     xn = *x;
08057     if(d > tol) goto S230;
08058     if(d <= eps) return;
08059     if(fabs(*q-qn) <= tol**q) return;
08060     goto S230;
08061 S270:
08062 /*
08063                        SPECIAL CASES
08064 */
08065     *x = xmax;
08066     return;
08067 S280:
08068     if(*q < 0.9e0) goto S290;
08069     T9 = -*p;
08070     *x = -alnrel(&T9);
08071     return;
08072 S290:
08073     *x = -log(*q);
08074     return;
08075 S300:
08076 /*
08077                        ERROR RETURN
08078 */
08079     *ierr = -2;
08080     return;
08081 S310:
08082     *ierr = -3;
08083     return;
08084 S320:
08085     *ierr = -4;
08086     return;
08087 S330:
08088     *ierr = -6;
08089     return;
08090 S340:
08091     *ierr = -7;
08092     return;
08093 S350:
08094     *x = xn;
08095     *ierr = -8;
08096     return;
08097 S360:
08098     *x = xmax;
08099     *ierr = -8;
08100     return;
08101 } /* END */

double gamln ( double * ) [static]

Definition at line 8104 of file nifti_stats.c.

References a, gamln(), gamln1(), and i.

Referenced by betaln(), dlnbet(), gaminv(), and gamln().

08116 {
08117 static double c0 = .833333333333333e-01;
08118 static double c1 = -.277777777760991e-02;
08119 static double c2 = .793650666825390e-03;
08120 static double c3 = -.595202931351870e-03;
08121 static double c4 = .837308034031215e-03;
08122 static double c5 = -.165322962780713e-02;
08123 static double d = .418938533204673e0;
08124 static double gamln,t,w;
08125 static int i,n;
08126 static double T1;
08127 /*
08128      ..
08129      .. Executable Statements ..
08130 */
08131     if(*a > 0.8e0) goto S10;
08132     gamln = gamln1(a)-log(*a);
08133     return gamln;
08134 S10:
08135     if(*a > 2.25e0) goto S20;
08136     t = *a-0.5e0-0.5e0;
08137     gamln = gamln1(&t);
08138     return gamln;
08139 S20:
08140     if(*a >= 10.0e0) goto S40;
08141     n = *a-1.25e0;
08142     t = *a;
08143     w = 1.0e0;
08144     for(i=1; i<=n; i++) {
08145         t -= 1.0e0;
08146         w = t*w;
08147     }
08148     T1 = t-1.0e0;
08149     gamln = gamln1(&T1)+log(w);
08150     return gamln;
08151 S40:
08152     t = pow(1.0e0/ *a,2.0);
08153     w = (((((c5*t+c4)*t+c3)*t+c2)*t+c1)*t+c0)/ *a;
08154     gamln = d+w+(*a-0.5e0)*(log(*a)-1.0e0);
08155     return gamln;
08156 } /* END */

double gamln1 ( double * ) [static]

Definition at line 8159 of file nifti_stats.c.

References a, gamln1(), and s2.

Referenced by bpser(), brcmp1(), brcomp(), dlngam(), gaminv(), gamln(), gamln1(), and gsumln().

08165 {
08166 static double p0 = .577215664901533e+00;
08167 static double p1 = .844203922187225e+00;
08168 static double p2 = -.168860593646662e+00;
08169 static double p3 = -.780427615533591e+00;
08170 static double p4 = -.402055799310489e+00;
08171 static double p5 = -.673562214325671e-01;
08172 static double p6 = -.271935708322958e-02;
08173 static double q1 = .288743195473681e+01;
08174 static double q2 = .312755088914843e+01;
08175 static double q3 = .156875193295039e+01;
08176 static double q4 = .361951990101499e+00;
08177 static double q5 = .325038868253937e-01;
08178 static double q6 = .667465618796164e-03;
08179 static double r0 = .422784335098467e+00;
08180 static double r1 = .848044614534529e+00;
08181 static double r2 = .565221050691933e+00;
08182 static double r3 = .156513060486551e+00;
08183 static double r4 = .170502484022650e-01;
08184 static double r5 = .497958207639485e-03;
08185 static double s1 = .124313399877507e+01;
08186 static double s2 = .548042109832463e+00;
08187 static double s3 = .101552187439830e+00;
08188 static double s4 = .713309612391000e-02;
08189 static double s5 = .116165475989616e-03;
08190 static double gamln1,w,x;
08191 /*
08192      ..
08193      .. Executable Statements ..
08194 */
08195     if(*a >= 0.6e0) goto S10;
08196     w = ((((((p6**a+p5)**a+p4)**a+p3)**a+p2)**a+p1)**a+p0)/((((((q6**a+q5)**a+
08197       q4)**a+q3)**a+q2)**a+q1)**a+1.0e0);
08198     gamln1 = -(*a*w);
08199     return gamln1;
08200 S10:
08201     x = *a-0.5e0-0.5e0;
08202     w = (((((r5*x+r4)*x+r3)*x+r2)*x+r1)*x+r0)/(((((s5*x+s4)*x+s3)*x+s2)*x+s1)*x
08203       +1.0e0);
08204     gamln1 = x*w;
08205     return gamln1;
08206 } /* END */

double gamma_pq2s	(	pqpair	pq,
		double	sh,
		double	sc
	)	`[static]`

Definition at line 10229 of file nifti_stats.c.

References BIGG, cdfgam(), pqpair::p, p, pqpair::q, scale, sh, and shape.

Referenced by pq2stat().

10230 {
10231    int which , status ;
10232    double p,q, x,shape,scale,bound ;
10233 
10234    which  = 2 ;
10235    p      = pq.p ; if( p <= 0.0 ) return  0.0 ;
10236    q      = pq.q ; if( q <= 0.0 ) return BIGG ;
10237    x      = 0.0 ;
10238    shape  = sh ;
10239    scale  = sc ;
10240 
10241    cdfgam( &which , &p , &q , &x , &shape , &scale , &status , &bound ) ;
10242    return x ;
10243 }

pqpair gamma_s2pq	(	double	xx,
		double	sh,
		double	sc
	)	`[static]`

Definition at line 10210 of file nifti_stats.c.

References cdfgam(), pqpair::p, p, pqpair::q, scale, sh, and shape.

Referenced by stat2pq().

10211 {
10212    int which , status ;
10213    double p,q, x,shape,scale,bound ;
10214    pqpair pq={0.0,1.0} ;
10215 
10216    which  = 1 ;
10217    p      = 0.0 ;
10218    q      = 1.0 ;
10219    x      = xx ;  if(     x <= 0.0 ) return pq ;
10220    shape  = sh ;  if( shape <= 0.0 ) return pq ;
10221    scale  = sc ;  if( scale <= 0.0 ) return pq ;
10222 
10223    cdfgam( &which , &p , &q , &x , &shape , &scale , &status , &bound ) ;
10224    pq.p = p ; pq.q = q ; return pq ;
10225 }

double gaudf ( double x ) [static]

Definition at line 10486 of file nifti_stats.c.

References cumnor(), and p.

Referenced by tnonc_s2p(), and tnonc_s2pq().

10487 {
10488    double xx=x , p,q ;
10489    cumnor( &xx, &p, &q ); return p;
10490 }

void grat1	(	double *	,
		double *	,
		double *	,
		double *	,
		double *	,
		double *
	)	`[static]`

Definition at line 8360 of file nifti_stats.c.

References a, c, erf1(), erfc1(), gam1(), l, p, r, and rexp().

Referenced by bgrat().

08362 {
08363 static int K2 = 0;
08364 static double a2n,a2nm1,am0,an,an0,b2n,b2nm1,c,cma,g,h,j,l,sum,t,tol,w,z,T1,T3;
08365 /*
08366      ..
08367      .. Executable Statements ..
08368 */
08369 /*
08370 -----------------------------------------------------------------------
08371         EVALUATION OF THE INCOMPLETE GAMMA RATIO FUNCTIONS
08372                       P(A,X) AND Q(A,X)
08373      IT IS ASSUMED THAT A .LE. 1.  EPS IS THE TOLERANCE TO BE USED.
08374      THE INPUT ARGUMENT R HAS THE VALUE E**(-X)*X**A/GAMMA(A).
08375 -----------------------------------------------------------------------
08376 */
08377     if(*a**x == 0.0e0) goto S120;
08378     if(*a == 0.5e0) goto S100;
08379     if(*x < 1.1e0) goto S10;
08380     goto S60;
08381 S10:
08382 /*
08383              TAYLOR SERIES FOR P(A,X)/X**A
08384 */
08385     an = 3.0e0;
08386     c = *x;
08387     sum = *x/(*a+3.0e0);
08388     tol = 0.1e0**eps/(*a+1.0e0);
08389 S20:
08390     an += 1.0e0;
08391     c = -(c*(*x/an));
08392     t = c/(*a+an);
08393     sum += t;
08394     if(fabs(t) > tol) goto S20;
08395     j = *a**x*((sum/6.0e0-0.5e0/(*a+2.0e0))**x+1.0e0/(*a+1.0e0));
08396     z = *a*log(*x);
08397     h = gam1(a);
08398     g = 1.0e0+h;
08399     if(*x < 0.25e0) goto S30;
08400     if(*a < *x/2.59e0) goto S50;
08401     goto S40;
08402 S30:
08403     if(z > -.13394e0) goto S50;
08404 S40:
08405     w = exp(z);
08406     *p = w*g*(0.5e0+(0.5e0-j));
08407     *q = 0.5e0+(0.5e0-*p);
08408     return;
08409 S50:
08410     l = rexp(&z);
08411     w = 0.5e0+(0.5e0+l);
08412     *q = (w*j-l)*g-h;
08413     if(*q < 0.0e0) goto S90;
08414     *p = 0.5e0+(0.5e0-*q);
08415     return;
08416 S60:
08417 /*
08418               CONTINUED FRACTION EXPANSION
08419 */
08420     a2nm1 = a2n = 1.0e0;
08421     b2nm1 = *x;
08422     b2n = *x+(1.0e0-*a);
08423     c = 1.0e0;
08424 S70:
08425     a2nm1 = *x*a2n+c*a2nm1;
08426     b2nm1 = *x*b2n+c*b2nm1;
08427     am0 = a2nm1/b2nm1;
08428     c += 1.0e0;
08429     cma = c-*a;
08430     a2n = a2nm1+cma*a2n;
08431     b2n = b2nm1+cma*b2n;
08432     an0 = a2n/b2n;
08433     if(fabs(an0-am0) >= *eps*an0) goto S70;
08434     *q = *r*an0;
08435     *p = 0.5e0+(0.5e0-*q);
08436     return;
08437 S80:
08438 /*
08439                 SPECIAL CASES
08440 */
08441     *p = 0.0e0;
08442     *q = 1.0e0;
08443     return;
08444 S90:
08445     *p = 1.0e0;
08446     *q = 0.0e0;
08447     return;
08448 S100:
08449     if(*x >= 0.25e0) goto S110;
08450     T1 = sqrt(*x);
08451     *p = erf1(&T1);
08452     *q = 0.5e0+(0.5e0-*p);
08453     return;
08454 S110:
08455     T3 = sqrt(*x);
08456     *q = erfc1(&K2,&T3);
08457     *p = 0.5e0+(0.5e0-*q);
08458     return;
08459 S120:
08460     if(*x <= *a) goto S80;
08461     goto S90;
08462 } /* END */

void gratio	(	double *	,
		double *	,
		double *	,
		double *	,
		int *
	)	`[static]`

Definition at line 8465 of file nifti_stats.c.

References a, c, erf1(), erfc1(), fifdmax1(), fifidint(), gam1(), i, ind, l, r, rexp(), rlog(), spmpar(), x0, x00, and Xgamm().

Referenced by cumgam(), and gaminv().

08495 {
08496 static double alog10 = 2.30258509299405e0;
08497 static double d10 = -.185185185185185e-02;
08498 static double d20 = .413359788359788e-02;
08499 static double d30 = .649434156378601e-03;
08500 static double d40 = -.861888290916712e-03;
08501 static double d50 = -.336798553366358e-03;
08502 static double d60 = .531307936463992e-03;
08503 static double d70 = .344367606892378e-03;
08504 static double rt2pin = .398942280401433e0;
08505 static double rtpi = 1.77245385090552e0;
08506 static double third = .333333333333333e0;
08507 static double acc0[3] = {
08508     5.e-15,5.e-7,5.e-4
08509 };
08510 static double big[3] = {
08511     20.0e0,14.0e0,10.0e0
08512 };
08513 static double d0[13] = {
08514     .833333333333333e-01,-.148148148148148e-01,.115740740740741e-02,
08515     .352733686067019e-03,-.178755144032922e-03,.391926317852244e-04,
08516     -.218544851067999e-05,-.185406221071516e-05,.829671134095309e-06,
08517     -.176659527368261e-06,.670785354340150e-08,.102618097842403e-07,
08518     -.438203601845335e-08
08519 };
08520 static double d1[12] = {
08521     -.347222222222222e-02,.264550264550265e-02,-.990226337448560e-03,
08522     .205761316872428e-03,-.401877572016461e-06,-.180985503344900e-04,
08523     .764916091608111e-05,-.161209008945634e-05,.464712780280743e-08,
08524     .137863344691572e-06,-.575254560351770e-07,.119516285997781e-07
08525 };
08526 static double d2[10] = {
08527     -.268132716049383e-02,.771604938271605e-03,.200938786008230e-05,
08528     -.107366532263652e-03,.529234488291201e-04,-.127606351886187e-04,
08529     .342357873409614e-07,.137219573090629e-05,-.629899213838006e-06,
08530     .142806142060642e-06
08531 };
08532 static double d3[8] = {
08533     .229472093621399e-03,-.469189494395256e-03,.267720632062839e-03,
08534     -.756180167188398e-04,-.239650511386730e-06,.110826541153473e-04,
08535     -.567495282699160e-05,.142309007324359e-05
08536 };
08537 static double d4[6] = {
08538     .784039221720067e-03,-.299072480303190e-03,-.146384525788434e-05,
08539     .664149821546512e-04,-.396836504717943e-04,.113757269706784e-04
08540 };
08541 static double d5[4] = {
08542     -.697281375836586e-04,.277275324495939e-03,-.199325705161888e-03,
08543     .679778047793721e-04
08544 };
08545 static double d6[2] = {
08546     -.592166437353694e-03,.270878209671804e-03
08547 };
08548 static double e00[3] = {
08549     .25e-3,.25e-1,.14e0
08550 };
08551 static double x00[3] = {
08552     31.0e0,17.0e0,9.7e0
08553 };
08554 static int K1 = 1;
08555 static int K2 = 0;
08556 static double a2n,a2nm1,acc,am0,amn,an,an0,apn,b2n,b2nm1,c,c0,c1,c2,c3,c4,c5,c6,
08557     cma,e,e0,g,h,j,l,r,rta,rtx,s,sum,t,t1,tol,twoa,u,w,x0,y,z;
08558 static int i,iop,m,max,n;
08559 static double wk[20],T3;
08560 static int T4,T5;
08561 static double T6,T7;
08562 /*
08563      ..
08564      .. Executable Statements ..
08565 */
08566 /*
08567      --------------------
08568      ****** E IS A MACHINE DEPENDENT CONSTANT. E IS THE SMALLEST
08569             FLOATING POINT NUMBER FOR WHICH 1.0 + E .GT. 1.0 .
08570 */
08571     e = spmpar(&K1);
08572     if(*a < 0.0e0 || *x < 0.0e0) goto S430;
08573     if(*a == 0.0e0 && *x == 0.0e0) goto S430;
08574     if(*a**x == 0.0e0) goto S420;
08575     iop = *ind+1;
08576     if(iop != 1 && iop != 2) iop = 3;
08577     acc = fifdmax1(acc0[iop-1],e);
08578     e0 = e00[iop-1];
08579     x0 = x00[iop-1];
08580 /*
08581             SELECT THE APPROPRIATE ALGORITHM
08582 */
08583     if(*a >= 1.0e0) goto S10;
08584     if(*a == 0.5e0) goto S390;
08585     if(*x < 1.1e0) goto S160;
08586     t1 = *a*log(*x)-*x;
08587     u = *a*exp(t1);
08588     if(u == 0.0e0) goto S380;
08589     r = u*(1.0e0+gam1(a));
08590     goto S250;
08591 S10:
08592     if(*a >= big[iop-1]) goto S30;
08593     if(*a > *x || *x >= x0) goto S20;
08594     twoa = *a+*a;
08595     m = fifidint(twoa);
08596     if(twoa != (double)m) goto S20;
08597     i = m/2;
08598     if(*a == (double)i) goto S210;
08599     goto S220;
08600 S20:
08601     t1 = *a*log(*x)-*x;
08602     r = exp(t1)/Xgamm(a);
08603     goto S40;
08604 S30:
08605     l = *x/ *a;
08606     if(l == 0.0e0) goto S370;
08607     s = 0.5e0+(0.5e0-l);
08608     z = rlog(&l);
08609     if(z >= 700.0e0/ *a) goto S410;
08610     y = *a*z;
08611     rta = sqrt(*a);
08612     if(fabs(s) <= e0/rta) goto S330;
08613     if(fabs(s) <= 0.4e0) goto S270;
08614     t = pow(1.0e0/ *a,2.0);
08615     t1 = (((0.75e0*t-1.0e0)*t+3.5e0)*t-105.0e0)/(*a*1260.0e0);
08616     t1 -= y;
08617     r = rt2pin*rta*exp(t1);
08618 S40:
08619     if(r == 0.0e0) goto S420;
08620     if(*x <= fifdmax1(*a,alog10)) goto S50;
08621     if(*x < x0) goto S250;
08622     goto S100;
08623 S50:
08624 /*
08625                  TAYLOR SERIES FOR P/R
08626 */
08627     apn = *a+1.0e0;
08628     t = *x/apn;
08629     wk[0] = t;
08630     for(n=2; n<=20; n++) {
08631         apn += 1.0e0;
08632         t *= (*x/apn);
08633         if(t <= 1.e-3) goto S70;
08634         wk[n-1] = t;
08635     }
08636     n = 20;
08637 S70:
08638     sum = t;
08639     tol = 0.5e0*acc;
08640 S80:
08641     apn += 1.0e0;
08642     t *= (*x/apn);
08643     sum += t;
08644     if(t > tol) goto S80;
08645     max = n-1;
08646     for(m=1; m<=max; m++) {
08647         n -= 1;
08648         sum += wk[n-1];
08649     }
08650     *ans = r/ *a*(1.0e0+sum);
08651     *qans = 0.5e0+(0.5e0-*ans);
08652     return;
08653 S100:
08654 /*
08655                  ASYMPTOTIC EXPANSION
08656 */
08657     amn = *a-1.0e0;
08658     t = amn/ *x;
08659     wk[0] = t;
08660     for(n=2; n<=20; n++) {
08661         amn -= 1.0e0;
08662         t *= (amn/ *x);
08663         if(fabs(t) <= 1.e-3) goto S120;
08664         wk[n-1] = t;
08665     }
08666     n = 20;
08667 S120:
08668     sum = t;
08669 S130:
08670     if(fabs(t) <= acc) goto S140;
08671     amn -= 1.0e0;
08672     t *= (amn/ *x);
08673     sum += t;
08674     goto S130;
08675 S140:
08676     max = n-1;
08677     for(m=1; m<=max; m++) {
08678         n -= 1;
08679         sum += wk[n-1];
08680     }
08681     *qans = r/ *x*(1.0e0+sum);
08682     *ans = 0.5e0+(0.5e0-*qans);
08683     return;
08684 S160:
08685 /*
08686              TAYLOR SERIES FOR P(A,X)/X**A
08687 */
08688     an = 3.0e0;
08689     c = *x;
08690     sum = *x/(*a+3.0e0);
08691     tol = 3.0e0*acc/(*a+1.0e0);
08692 S170:
08693     an += 1.0e0;
08694     c = -(c*(*x/an));
08695     t = c/(*a+an);
08696     sum += t;
08697     if(fabs(t) > tol) goto S170;
08698     j = *a**x*((sum/6.0e0-0.5e0/(*a+2.0e0))**x+1.0e0/(*a+1.0e0));
08699     z = *a*log(*x);
08700     h = gam1(a);
08701     g = 1.0e0+h;
08702     if(*x < 0.25e0) goto S180;
08703     if(*a < *x/2.59e0) goto S200;
08704     goto S190;
08705 S180:
08706     if(z > -.13394e0) goto S200;
08707 S190:
08708     w = exp(z);
08709     *ans = w*g*(0.5e0+(0.5e0-j));
08710     *qans = 0.5e0+(0.5e0-*ans);
08711     return;
08712 S200:
08713     l = rexp(&z);
08714     w = 0.5e0+(0.5e0+l);
08715     *qans = (w*j-l)*g-h;
08716     if(*qans < 0.0e0) goto S380;
08717     *ans = 0.5e0+(0.5e0-*qans);
08718     return;
08719 S210:
08720 /*
08721              FINITE SUMS FOR Q WHEN A .GE. 1
08722                  AND 2*A IS AN INTEGER
08723 */
08724     sum = exp(-*x);
08725     t = sum;
08726     n = 1;
08727     c = 0.0e0;
08728     goto S230;
08729 S220:
08730     rtx = sqrt(*x);
08731     sum = erfc1(&K2,&rtx);
08732     t = exp(-*x)/(rtpi*rtx);
08733     n = 0;
08734     c = -0.5e0;
08735 S230:
08736     if(n == i) goto S240;
08737     n += 1;
08738     c += 1.0e0;
08739     t = *x*t/c;
08740     sum += t;
08741     goto S230;
08742 S240:
08743     *qans = sum;
08744     *ans = 0.5e0+(0.5e0-*qans);
08745     return;
08746 S250:
08747 /*
08748               CONTINUED FRACTION EXPANSION
08749 */
08750     tol = fifdmax1(5.0e0*e,acc);
08751     a2nm1 = a2n = 1.0e0;
08752     b2nm1 = *x;
08753     b2n = *x+(1.0e0-*a);
08754     c = 1.0e0;
08755 S260:
08756     a2nm1 = *x*a2n+c*a2nm1;
08757     b2nm1 = *x*b2n+c*b2nm1;
08758     am0 = a2nm1/b2nm1;
08759     c += 1.0e0;
08760     cma = c-*a;
08761     a2n = a2nm1+cma*a2n;
08762     b2n = b2nm1+cma*b2n;
08763     an0 = a2n/b2n;
08764     if(fabs(an0-am0) >= tol*an0) goto S260;
08765     *qans = r*an0;
08766     *ans = 0.5e0+(0.5e0-*qans);
08767     return;
08768 S270:
08769 /*
08770                 GENERAL TEMME EXPANSION
08771 */
08772     if(fabs(s) <= 2.0e0*e && *a*e*e > 3.28e-3) goto S430;
08773     c = exp(-y);
08774     T3 = sqrt(y);
08775     w = 0.5e0*erfc1(&K1,&T3);
08776     u = 1.0e0/ *a;
08777     z = sqrt(z+z);
08778     if(l < 1.0e0) z = -z;
08779     T4 = iop-2;
08780     if(T4 < 0) goto S280;
08781     else if(T4 == 0) goto S290;
08782     else  goto S300;
08783 S280:
08784     if(fabs(s) <= 1.e-3) goto S340;
08785     c0 = ((((((((((((d0[12]*z+d0[11])*z+d0[10])*z+d0[9])*z+d0[8])*z+d0[7])*z+d0[
08786       6])*z+d0[5])*z+d0[4])*z+d0[3])*z+d0[2])*z+d0[1])*z+d0[0])*z-third;
08787     c1 = (((((((((((d1[11]*z+d1[10])*z+d1[9])*z+d1[8])*z+d1[7])*z+d1[6])*z+d1[5]
08788       )*z+d1[4])*z+d1[3])*z+d1[2])*z+d1[1])*z+d1[0])*z+d10;
08789     c2 = (((((((((d2[9]*z+d2[8])*z+d2[7])*z+d2[6])*z+d2[5])*z+d2[4])*z+d2[3])*z+
08790       d2[2])*z+d2[1])*z+d2[0])*z+d20;
08791     c3 = (((((((d3[7]*z+d3[6])*z+d3[5])*z+d3[4])*z+d3[3])*z+d3[2])*z+d3[1])*z+
08792       d3[0])*z+d30;
08793     c4 = (((((d4[5]*z+d4[4])*z+d4[3])*z+d4[2])*z+d4[1])*z+d4[0])*z+d40;
08794     c5 = (((d5[3]*z+d5[2])*z+d5[1])*z+d5[0])*z+d50;
08795     c6 = (d6[1]*z+d6[0])*z+d60;
08796     t = ((((((d70*u+c6)*u+c5)*u+c4)*u+c3)*u+c2)*u+c1)*u+c0;
08797     goto S310;
08798 S290:
08799     c0 = (((((d0[5]*z+d0[4])*z+d0[3])*z+d0[2])*z+d0[1])*z+d0[0])*z-third;
08800     c1 = (((d1[3]*z+d1[2])*z+d1[1])*z+d1[0])*z+d10;
08801     c2 = d2[0]*z+d20;
08802     t = (c2*u+c1)*u+c0;
08803     goto S310;
08804 S300:
08805     t = ((d0[2]*z+d0[1])*z+d0[0])*z-third;
08806 S310:
08807     if(l < 1.0e0) goto S320;
08808     *qans = c*(w+rt2pin*t/rta);
08809     *ans = 0.5e0+(0.5e0-*qans);
08810     return;
08811 S320:
08812     *ans = c*(w-rt2pin*t/rta);
08813     *qans = 0.5e0+(0.5e0-*ans);
08814     return;
08815 S330:
08816 /*
08817                TEMME EXPANSION FOR L = 1
08818 */
08819     if(*a*e*e > 3.28e-3) goto S430;
08820     c = 0.5e0+(0.5e0-y);
08821     w = (0.5e0-sqrt(y)*(0.5e0+(0.5e0-y/3.0e0))/rtpi)/c;
08822     u = 1.0e0/ *a;
08823     z = sqrt(z+z);
08824     if(l < 1.0e0) z = -z;
08825     T5 = iop-2;
08826     if(T5 < 0) goto S340;
08827     else if(T5 == 0) goto S350;
08828     else  goto S360;
08829 S340:
08830     c0 = ((((((d0[6]*z+d0[5])*z+d0[4])*z+d0[3])*z+d0[2])*z+d0[1])*z+d0[0])*z-
08831       third;
08832     c1 = (((((d1[5]*z+d1[4])*z+d1[3])*z+d1[2])*z+d1[1])*z+d1[0])*z+d10;
08833     c2 = ((((d2[4]*z+d2[3])*z+d2[2])*z+d2[1])*z+d2[0])*z+d20;
08834     c3 = (((d3[3]*z+d3[2])*z+d3[1])*z+d3[0])*z+d30;
08835     c4 = (d4[1]*z+d4[0])*z+d40;
08836     c5 = (d5[1]*z+d5[0])*z+d50;
08837     c6 = d6[0]*z+d60;
08838     t = ((((((d70*u+c6)*u+c5)*u+c4)*u+c3)*u+c2)*u+c1)*u+c0;
08839     goto S310;
08840 S350:
08841     c0 = (d0[1]*z+d0[0])*z-third;
08842     c1 = d1[0]*z+d10;
08843     t = (d20*u+c1)*u+c0;
08844     goto S310;
08845 S360:
08846     t = d0[0]*z-third;
08847     goto S310;
08848 S370:
08849 /*
08850                      SPECIAL CASES
08851 */
08852     *ans = 0.0e0;
08853     *qans = 1.0e0;
08854     return;
08855 S380:
08856     *ans = 1.0e0;
08857     *qans = 0.0e0;
08858     return;
08859 S390:
08860     if(*x >= 0.25e0) goto S400;
08861     T6 = sqrt(*x);
08862     *ans = erf1(&T6);
08863     *qans = 0.5e0+(0.5e0-*ans);
08864     return;
08865 S400:
08866     T7 = sqrt(*x);
08867     *qans = erfc1(&K2,&T7);
08868     *ans = 0.5e0+(0.5e0-*qans);
08869     return;
08870 S410:
08871     if(fabs(s) <= 2.0e0*e) goto S430;
08872 S420:
08873     if(*x <= *a) goto S370;
08874     goto S380;
08875 S430:
08876 /*
08877                      ERROR RETURN
08878 */
08879     *ans = 2.0e0;
08880     return;
08881 } /* END */

double gsumln	(	double *	,
		double *
	)	`[static]`

Definition at line 8884 of file nifti_stats.c.

References a, alnrel(), gamln1(), and gsumln().

Referenced by betaln(), dlnbet(), and gsumln().

08891 {
08892 static double gsumln,x,T1,T2;
08893 /*
08894      ..
08895      .. Executable Statements ..
08896 */
08897     x = *a+*b-2.e0;
08898     if(x > 0.25e0) goto S10;
08899     T1 = 1.0e0+x;
08900     gsumln = gamln1(&T1);
08901     return gsumln;
08902 S10:
08903     if(x > 1.25e0) goto S20;
08904     gsumln = gamln1(&x)+alnrel(&x);
08905     return gsumln;
08906 S20:
08907     T2 = x-1.0e0;
08908     gsumln = gamln1(&T2)+log(x*(1.0e0+x));
08909     return gsumln;
08910 } /* END */

double invgauss_pq2s	(	pqpair	pq,
		double	c
	)	`[static]`

Definition at line 10838 of file nifti_stats.c.

References BIGG, c, dinvr(), dstinv(), dt, invgauss_s2pq(), pqpair::p, and pqpair::q.

Referenced by pq2stat().

10839 {
10840    double t ;  /* will be result */
10841    double tbot,ttop , dt ;
10842    double T6=1.e-50,T7=1.e-8 ;
10843    double K4=0.5,K5=5.0 ;
10844    double fx ;
10845    unsigned long qhi,qleft ;
10846    int status , qporq , ite ;
10847    pqpair tpq ;
10848 
10849    if( c    <= 0.0 ) return  BIGG ;  /* bad user */
10850    if( pq.p <= 0.0 ) return   0.0 ;
10851    if( pq.q <= 0.0 ) return  BIGG ;
10852 
10853    /* initial guess is t=1; scan down for lower bound */
10854 
10855    tbot = 1.01 ; dt = 0.9 ;
10856    for( ite=0 ; ite < 1000 ; ite++ ){
10857      tpq = invgauss_s2pq( tbot , c ) ;
10858      if( tpq.p <= pq.p ) break ;
10859      tbot *= dt ;
10860    }
10861    if( ite >= 1000 ) return 0.0 ;
10862 
10863    /* scan up for upper bound */
10864 
10865    dt = 1.1 ; ttop = tbot*dt ;
10866    for( ite=0 ; ite < 1000 ; ite++ ){
10867      tpq = invgauss_s2pq( ttop , c ) ;
10868      if( tpq.p >= pq.p ) break ;
10869      ttop *= dt ;
10870    }
10871    if( ite >= 1000 ) return BIGG ;
10872 
10873    t = sqrt(tbot*ttop) ; /* start at geometric mean */
10874 
10875    /* initialize searching parameters */
10876 
10877    dstinv(&tbot,&ttop,&K4,&K4,&K5,&T6,&T7);
10878 
10879    status = 0 ; qporq = (pq.p <= pq.q) ;
10880 
10881    while(1){
10882 
10883      dinvr(&status,&t,&fx,&qleft,&qhi) ;
10884 
10885      if( status != 1 ) return t ;  /* done! */
10886 
10887      tpq = invgauss_s2pq( t , c ) ;
10888 
10889      /* goal is to drive fx to zero */
10890 
10891      fx = (qporq) ? pq.p-tpq.p : pq.q-tpq.q ;
10892    }
10893 
10894    return BIGG ;  /* unreachable */
10895 }

pqpair invgauss_s2pq	(	double	x,
		double	c
	)	`[static]`

Definition at line 10817 of file nifti_stats.c.

References c, cumnor(), pqpair::p, pqpair::q, and v.

Referenced by invgauss_pq2s(), and stat2pq().

10818 {
10819    double y , p1,q1 , p2,q2 , v ;
10820    pqpair pq={0.0,1.0} ;
10821 
10822    if( x <= 0.0 || c <= 0.0 ) return pq ;
10823 
10824    y = sqrt(c/x) ;
10825    v =  y*(x-1.0) ; cumnor( &v , &p1,&q1 ) ;
10826    v = -y*(x+1.0) ; cumnor( &v , &p2,&q2 ) ;
10827    pq.p = p1 ;
10828    if( p2 > 0.0 ) pq.p += exp(2.0*c+log(p2)) ;
10829    pq.q = 1.0-pq.p ; return pq ;
10830 }

int ipmpar ( int * i ) [static]

RWCox - DON'T EXIT

Definition at line 9497 of file nifti_stats.c.

References i.

Referenced by exparg(), psi(), and spmpar().

09554          : at this time, the IEEE parameters are enabled.
09555 
09556 -----------------------------------------------------------------------
09557 
09558      IPMPAR IS AN ADAPTATION OF THE FUNCTION I1MACH, WRITTEN BY
09559      P.A. FOX, A.D. HALL, AND N.L. SCHRYER (BELL LABORATORIES).
09560      IPMPAR WAS FORMED BY A.H. MORRIS (NSWC). THE CONSTANTS ARE
09561      FROM BELL LABORATORIES, NSWC, AND OTHER SOURCES.
09562 
09563 -----------------------------------------------------------------------
09564      .. Scalar Arguments ..
09565 */
09566 {
09567 static int imach[11];
09568 static int outval ;
09569 /*     MACHINE CONSTANTS FOR AMDAHL MACHINES. */
09570 /*
09571    imach[1] = 2;
09572    imach[2] = 31;
09573    imach[3] = 2147483647;
09574    imach[4] = 16;
09575    imach[5] = 6;
09576    imach[6] = -64;
09577    imach[7] = 63;
09578    imach[8] = 14;
09579    imach[9] = -64;
09580    imach[10] = 63;
09581 */
09582 /*     MACHINE CONSTANTS FOR THE AT&T 3B SERIES, AT&T
09583        PC 7300, AND AT&T 6300. */
09584 /*
09585    imach[1] = 2;
09586    imach[2] = 31;
09587    imach[3] = 2147483647;
09588    imach[4] = 2;
09589    imach[5] = 24;
09590    imach[6] = -125;
09591    imach[7] = 128;
09592    imach[8] = 53;
09593    imach[9] = -1021;
09594    imach[10] = 1024;
09595 */
09596 /*     MACHINE CONSTANTS FOR THE BURROUGHS 1700 SYSTEM. */
09597 /*
09598    imach[1] = 2;
09599    imach[2] = 33;
09600    imach[3] = 8589934591;
09601    imach[4] = 2;
09602    imach[5] = 24;
09603    imach[6] = -256;
09604    imach[7] = 255;
09605    imach[8] = 60;
09606    imach[9] = -256;
09607    imach[10] = 255;
09608 */
09609 /*     MACHINE CONSTANTS FOR THE BURROUGHS 5700 SYSTEM. */
09610 /*
09611    imach[1] = 2;
09612    imach[2] = 39;
09613    imach[3] = 549755813887;
09614    imach[4] = 8;
09615    imach[5] = 13;
09616    imach[6] = -50;
09617    imach[7] = 76;
09618    imach[8] = 26;
09619    imach[9] = -50;
09620    imach[10] = 76;
09621 */
09622 /*     MACHINE CONSTANTS FOR THE BURROUGHS 6700/7700 SYSTEMS. */
09623 /*
09624    imach[1] = 2;
09625    imach[2] = 39;
09626    imach[3] = 549755813887;
09627    imach[4] = 8;
09628    imach[5] = 13;
09629    imach[6] = -50;
09630    imach[7] = 76;
09631    imach[8] = 26;
09632    imach[9] = -32754;
09633    imach[10] = 32780;
09634 */
09635 /*     MACHINE CONSTANTS FOR THE CDC 6000/7000 SERIES
09636        60 BIT ARITHMETIC, AND THE CDC CYBER 995 64 BIT
09637        ARITHMETIC (NOS OPERATING SYSTEM). */
09638 /*
09639    imach[1] = 2;
09640    imach[2] = 48;
09641    imach[3] = 281474976710655;
09642    imach[4] = 2;
09643    imach[5] = 48;
09644    imach[6] = -974;
09645    imach[7] = 1070;
09646    imach[8] = 95;
09647    imach[9] = -926;
09648    imach[10] = 1070;
09649 */
09650 /*     MACHINE CONSTANTS FOR THE CDC CYBER 995 64 BIT
09651        ARITHMETIC (NOS/VE OPERATING SYSTEM). */
09652 /*
09653    imach[1] = 2;
09654    imach[2] = 63;
09655    imach[3] = 9223372036854775807;
09656    imach[4] = 2;
09657    imach[5] = 48;
09658    imach[6] = -4096;
09659    imach[7] = 4095;
09660    imach[8] = 96;
09661    imach[9] = -4096;
09662    imach[10] = 4095;
09663 */
09664 /*     MACHINE CONSTANTS FOR THE CRAY 1, XMP, 2, AND 3. */
09665 /*
09666    imach[1] = 2;
09667    imach[2] = 63;
09668    imach[3] = 9223372036854775807;
09669    imach[4] = 2;
09670    imach[5] = 47;
09671    imach[6] = -8189;
09672    imach[7] = 8190;
09673    imach[8] = 94;
09674    imach[9] = -8099;
09675    imach[10] = 8190;
09676 */
09677 /*     MACHINE CONSTANTS FOR THE DATA GENERAL ECLIPSE S/200. */
09678 /*
09679    imach[1] = 2;
09680    imach[2] = 15;
09681    imach[3] = 32767;
09682    imach[4] = 16;
09683    imach[5] = 6;
09684    imach[6] = -64;
09685    imach[7] = 63;
09686    imach[8] = 14;
09687    imach[9] = -64;
09688    imach[10] = 63;
09689 */
09690 /*     MACHINE CONSTANTS FOR THE HARRIS 220. */
09691 /*
09692    imach[1] = 2;
09693    imach[2] = 23;
09694    imach[3] = 8388607;
09695    imach[4] = 2;
09696    imach[5] = 23;
09697    imach[6] = -127;
09698    imach[7] = 127;
09699    imach[8] = 38;
09700    imach[9] = -127;
09701    imach[10] = 127;
09702 */
09703 /*     MACHINE CONSTANTS FOR THE HONEYWELL 600/6000
09704        AND DPS 8/70 SERIES. */
09705 /*
09706    imach[1] = 2;
09707    imach[2] = 35;
09708    imach[3] = 34359738367;
09709    imach[4] = 2;
09710    imach[5] = 27;
09711    imach[6] = -127;
09712    imach[7] = 127;
09713    imach[8] = 63;
09714    imach[9] = -127;
09715    imach[10] = 127;
09716 */
09717 /*     MACHINE CONSTANTS FOR THE HP 2100
09718        3 WORD DOUBLE PRECISION OPTION WITH FTN4 */
09719 /*
09720    imach[1] = 2;
09721    imach[2] = 15;
09722    imach[3] = 32767;
09723    imach[4] = 2;
09724    imach[5] = 23;
09725    imach[6] = -128;
09726    imach[7] = 127;
09727    imach[8] = 39;
09728    imach[9] = -128;
09729    imach[10] = 127;
09730 */
09731 /*     MACHINE CONSTANTS FOR THE HP 2100
09732        4 WORD DOUBLE PRECISION OPTION WITH FTN4 */
09733 /*
09734    imach[1] = 2;
09735    imach[2] = 15;
09736    imach[3] = 32767;
09737    imach[4] = 2;
09738    imach[5] = 23;
09739    imach[6] = -128;
09740    imach[7] = 127;
09741    imach[8] = 55;
09742    imach[9] = -128;
09743    imach[10] = 127;
09744 */
09745 /*     MACHINE CONSTANTS FOR THE HP 9000. */
09746 /*
09747    imach[1] = 2;
09748    imach[2] = 31;
09749    imach[3] = 2147483647;
09750    imach[4] = 2;
09751    imach[5] = 24;
09752    imach[6] = -126;
09753    imach[7] = 128;
09754    imach[8] = 53;
09755    imach[9] = -1021;
09756    imach[10] = 1024;
09757 */
09758 /*     MACHINE CONSTANTS FOR THE IBM 360/370 SERIES,
09759        THE ICL 2900, THE ITEL AS/6, THE XEROX SIGMA
09760        5/7/9 AND THE SEL SYSTEMS 85/86. */
09761 /*
09762    imach[1] = 2;
09763    imach[2] = 31;
09764    imach[3] = 2147483647;
09765    imach[4] = 16;
09766    imach[5] = 6;
09767    imach[6] = -64;
09768    imach[7] = 63;
09769    imach[8] = 14;
09770    imach[9] = -64;
09771    imach[10] = 63;
09772 */
09773 /*     MACHINE CONSTANTS FOR THE IBM PC. */
09774 /*
09775    imach[1] = 2;
09776    imach[2] = 31;
09777    imach[3] = 2147483647;
09778    imach[4] = 2;
09779    imach[5] = 24;
09780    imach[6] = -125;
09781    imach[7] = 128;
09782    imach[8] = 53;
09783    imach[9] = -1021;
09784    imach[10] = 1024;
09785 */
09786 /*     MACHINE CONSTANTS FOR THE MACINTOSH II - ABSOFT
09787        MACFORTRAN II. */
09788 /*
09789    imach[1] = 2;
09790    imach[2] = 31;
09791    imach[3] = 2147483647;
09792    imach[4] = 2;
09793    imach[5] = 24;
09794    imach[6] = -125;
09795    imach[7] = 128;
09796    imach[8] = 53;
09797    imach[9] = -1021;
09798    imach[10] = 1024;
09799 */
09800 /*     MACHINE CONSTANTS FOR THE MICROVAX - VMS FORTRAN. */
09801 /*
09802    imach[1] = 2;
09803    imach[2] = 31;
09804    imach[3] = 2147483647;
09805    imach[4] = 2;
09806    imach[5] = 24;
09807    imach[6] = -127;
09808    imach[7] = 127;
09809    imach[8] = 56;
09810    imach[9] = -127;
09811    imach[10] = 127;
09812 */
09813 /*     MACHINE CONSTANTS FOR THE PDP-10 (KA PROCESSOR). */
09814 /*
09815    imach[1] = 2;
09816    imach[2] = 35;
09817    imach[3] = 34359738367;
09818    imach[4] = 2;
09819    imach[5] = 27;
09820    imach[6] = -128;
09821    imach[7] = 127;
09822    imach[8] = 54;
09823    imach[9] = -101;
09824    imach[10] = 127;
09825 */
09826 /*     MACHINE CONSTANTS FOR THE PDP-10 (KI PROCESSOR). */
09827 /*
09828    imach[1] = 2;
09829    imach[2] = 35;
09830    imach[3] = 34359738367;
09831    imach[4] = 2;
09832    imach[5] = 27;
09833    imach[6] = -128;
09834    imach[7] = 127;
09835    imach[8] = 62;
09836    imach[9] = -128;
09837    imach[10] = 127;
09838 */
09839 /*     MACHINE CONSTANTS FOR THE PDP-11 FORTRAN SUPPORTING
09840        32-BIT INTEGER ARITHMETIC. */
09841 /*
09842    imach[1] = 2;
09843    imach[2] = 31;
09844    imach[3] = 2147483647;
09845    imach[4] = 2;
09846    imach[5] = 24;
09847    imach[6] = -127;
09848    imach[7] = 127;
09849    imach[8] = 56;
09850    imach[9] = -127;
09851    imach[10] = 127;
09852 */
09853 /*     MACHINE CONSTANTS FOR THE SEQUENT BALANCE 8000. */
09854 /*
09855    imach[1] = 2;
09856    imach[2] = 31;
09857    imach[3] = 2147483647;
09858    imach[4] = 2;
09859    imach[5] = 24;
09860    imach[6] = -125;
09861    imach[7] = 128;
09862    imach[8] = 53;
09863    imach[9] = -1021;
09864    imach[10] = 1024;
09865 */
09866 /*     MACHINE CONSTANTS FOR THE SILICON GRAPHICS IRIS-4D
09867        SERIES (MIPS R3000 PROCESSOR). */
09868 /*
09869    imach[1] = 2;
09870    imach[2] = 31;
09871    imach[3] = 2147483647;
09872    imach[4] = 2;
09873    imach[5] = 24;
09874    imach[6] = -125;
09875    imach[7] = 128;
09876    imach[8] = 53;
09877    imach[9] = -1021;
09878    imach[10] = 1024;
09879 */
09880 /*     MACHINE CONSTANTS FOR IEEE ARITHMETIC MACHINES, SUCH AS THE AT&T
09881        3B SERIES, MOTOROLA 68000 BASED MACHINES (E.G. SUN 3 AND AT&T
09882        PC 7300), AND 8087 BASED MICROS (E.G. IBM PC AND AT&T 6300). */
09883 
09884    imach[1] = 2;
09885    imach[2] = 31;
09886    imach[3] = 2147483647;
09887    imach[4] = 2;
09888    imach[5] = 24;
09889    imach[6] = -125;
09890    imach[7] = 128;
09891    imach[8] = 53;
09892    imach[9] = -1021;
09893    imach[10] = 1024;
09894 
09895 /*     MACHINE CONSTANTS FOR THE UNIVAC 1100 SERIES. */
09896 /*
09897    imach[1] = 2;
09898    imach[2] = 35;
09899    imach[3] = 34359738367;
09900    imach[4] = 2;
09901    imach[5] = 27;
09902    imach[6] = -128;
09903    imach[7] = 127;
09904    imach[8] = 60;
09905    imach[9] = -1024;
09906    imach[10] = 1023;
09907 */
09908 /*     MACHINE CONSTANTS FOR THE VAX 11/780. */
09909 /*
09910    imach[1] = 2;
09911    imach[2] = 31;
09912    imach[3] = 2147483647;
09913    imach[4] = 2;
09914    imach[5] = 24;
09915    imach[6] = -127;
09916    imach[7] = 127;
09917    imach[8] = 56;
09918    imach[9] = -127;
09919    imach[10] = 127;
09920 */
09921     outval  = imach[*i];
09922     return outval ;
09923 }

double laplace_pq2s ( pqpair pq ) [static]

Definition at line 10399 of file nifti_stats.c.

References BIGG, pqpair::p, and pqpair::q.

Referenced by pq2stat().

10400 {
10401         if( pq.p <= 0.0 ) return -BIGG ;
10402    else if( pq.q <= 0.0 ) return  BIGG ;
10403 
10404    if( pq.p < pq.q ) return  log(2.0*pq.p) ;
10405    else              return -log(2.0*pq.q) ;
10406 }

pqpair laplace_s2pq ( double xx ) [static]

Definition at line 10388 of file nifti_stats.c.

References pqpair::p, and pqpair::q.

Referenced by stat2pq().

10389 {
10390    pqpair pq ;
10391 
10392    if( xx >= 0.0 ){ pq.q = 0.5*exp(-xx) ; pq.p = 1.0-pq.q ; }
10393    else           { pq.p = 0.5*exp( xx) ; pq.q = 1.0-pq.p ; }
10394    return pq ;
10395 }

double logistic_pq2s ( pqpair pq ) [static]

Definition at line 10375 of file nifti_stats.c.

References BIGG, pqpair::p, and pqpair::q.

Referenced by pq2stat().

10376 {
10377         if( pq.p <= 0.0 ) return -BIGG ;
10378    else if( pq.q <= 0.0 ) return  BIGG ;
10379 
10380    if( pq.p < pq.q ) return -log(1.0/pq.p-1.0) ;
10381    else              return  log(1.0/pq.q-1.0) ;
10382 }

pqpair logistic_s2pq ( double xx ) [static]

Definition at line 10365 of file nifti_stats.c.

References pqpair::p, and pqpair::q.

Referenced by stat2pq().

10366 {
10367    pqpair pq ;
10368    if( xx >= 0.0 ){ pq.q = 1.0/(1.0+exp( xx)); pq.p = 1.0-pq.q; }
10369    else           { pq.p = 1.0/(1.0+exp(-xx)); pq.q = 1.0-pq.p; }
10370    return pq ;
10371 }

int main	(	int	argc,
		char *	argv[]
	)

\** File : SUMA.c

Author:: : Ziad Saad Date : Thu Dec 27 16:21:01 EST 2001

Purpose :

Input paramters :

Parameters:

param

Usage : SUMA ( )

Returns :

Returns:: Support :

See also:: OpenGL prog. Guide 3rd edition , varray.c from book's sample code

Side effects :

Definition at line 11187 of file nifti_stats.c.

References argc, inam, nifti_cdf2stat(), nifti_intent_code(), nifti_stat2cdf(), nifti_stat2hzscore(), nifti_stat2rcdf(), nifti_stat2zscore(), p, and strtod().

11188 {
11189    double val , p , q , p1=0.0,p2=0.0,p3=0.0 ;
11190    double vbot,vtop,vdel ;
11191    int code , iarg=1 , doq=0 , dod=0 , doi=0 , doz=0 , doh=0 ;
11192 
11193    /*-- print some help for the pitiful user --*/
11194 
11195    if( argc < 3 || strstr(argv[1],"help") != NULL ){
11196     int ii ;
11197     printf("\n") ;
11198     printf("Demo program for computing NIfTI statistical functions.\n") ;
11199     printf("Usage: nifti_stats [-q|-d|-1|-z] val CODE [p1 p2 p3]\n") ;
11200     printf(" val can be a single number or in the form bot:top:step.\n") ;
11201     printf(" default ==> output p = Prob(statistic < val).\n") ;
11202     printf("  -q     ==> output is 1-p.\n") ;
11203     printf("  -d     ==> output is density.\n") ;
11204     printf("  -1     ==> output is x such that Prob(statistic < x) = val.\n") ;
11205     printf("  -z     ==> output is z such that Normal cdf(z) = p(val).\n") ;
11206     printf("  -h     ==> output is z such that 1/2-Normal cdf(z) = p(val).\n");
11207     printf(" Allowable CODEs:\n") ;
11208     for( ii=NIFTI_FIRST_STATCODE ; ii <= NIFTI_LAST_STATCODE ; ii++ ){
11209      printf("  %-10s",inam[ii]); if((ii-NIFTI_FIRST_STATCODE)%6==5)printf("\n");
11210     }
11211     printf("\n") ;
11212     printf(" Following CODE are distributional parameters, as needed.\n");
11213     printf("\n") ;
11214     printf("Results are written to stdout, 1 number per output line.\n") ;
11215     printf("Example (piping output into AFNI program 1dplot):\n") ;
11216     printf(" nifti_stats -d 0:4:.001 INVGAUSS 1 3 | 1dplot -dx 0.001 -stdin\n");
11217     printf("\n") ;
11218     printf("Author - RW Cox - SSCC/NIMH/NIH/DHHS/USA/EARTH - March 2004\n") ;
11219     printf("\n") ;
11220     exit(0) ;
11221    }
11222 
11223    /*-- check first arg to see if it is an output option;
11224         if so, set the appropriate output flag to determine what to compute --*/
11225 
11226         if( strcmp(argv[iarg],"-q") == 0 ){ doq = 1 ; iarg++ ; }
11227    else if( strcmp(argv[iarg],"-d") == 0 ){ dod = 1 ; iarg++ ; }
11228    else if( strcmp(argv[iarg],"-1") == 0 ){ doi = 1 ; iarg++ ; }
11229    else if( strcmp(argv[iarg],"-z") == 0 ){ doz = 1 ; iarg++ ; }
11230    else if( strcmp(argv[iarg],"-h") == 0 ){ doh = 1 ; iarg++ ; }
11231 
11232    /*-- get the value(s) to process --*/
11233 
11234    vbot=vtop=vdel = 0.0 ;
11235    sscanf( argv[iarg++] , "%lf:%lf:%lf" , &vbot,&vtop,&vdel ) ;
11236    if( vbot >= vtop ) vdel = 0.0 ;
11237    if( vdel <= 0.0  ) vtop = vbot ;
11238 
11239    /*-- decode the CODE into the integer signifying the distribution --*/
11240 
11241    code = nifti_intent_code(argv[iarg++]) ;
11242      if( code < 0 ){ fprintf(stderr,"illegal code=%s\n",argv[iarg-1]); exit(1); }
11243 
11244    /*-- get the parameters, if present (defaults are 0) --*/
11245 
11246    if( argc > iarg ) p1 = strtod(argv[iarg++],NULL) ;
11247    if( argc > iarg ) p2 = strtod(argv[iarg++],NULL) ;
11248    if( argc > iarg ) p3 = strtod(argv[iarg++],NULL) ;
11249 
11250    /*-- loop over input value(s), compute output, write to stdout --*/
11251 
11252    for( val=vbot ; val <= vtop ; val += vdel ){
11253      if( doq )                                        /* output = 1-cdf */
11254        p = nifti_stat2rcdf( val , code,p1,p2,p3 ) ;
11255      else if( dod )                                   /* output = density */
11256        p = 1000.0*( nifti_stat2cdf(val+.001,code,p1,p2,p3)
11257                    -nifti_stat2cdf(val     ,code,p1,p2,p3)) ;
11258      else if( doi )                                   /* output = inverse */
11259        p = nifti_cdf2stat( val , code,p1,p2,p3 ) ;
11260      else if( doz )                                   /* output = z score */
11261        p = nifti_stat2zscore( val , code,p1,p2,p3 ) ;
11262      else if( doh )                                   /* output = halfz score */
11263        p = nifti_stat2hzscore( val , code,p1,p2,p3 ) ;
11264      else                                              /* output = cdf */
11265        p = nifti_stat2cdf( val , code,p1,p2,p3 ) ;
11266 
11267      printf("%.9g\n",p) ;
11268      if( vdel <= 0.0 ) break ;  /* the case of just 1 value */
11269    }
11270 
11271    /*-- terminus est --*/
11272 
11273    exit(0) ;
11274 }

double nifti_cdf2stat	(	double	p,
		int	code,
		double	p1,
		double	p2,
		double	p3
	)

Given a cdf probability, find the value that gave rise to it.

p = cdf; 0 < p < 1
code = NIFTI_INTENT_* statistical code
p1,p2,p3 = parameters of the distribution

If an error transpires, you'll probably get back a BIGG number. ----------------------------------------------------------------------------

Definition at line 11123 of file nifti_stats.c.

References pqpair::p, p, pq2stat(), and pqpair::q.

Referenced by main().

11124 {
11125    pqpair pq ;
11126    pq.p = p ; pq.q = 1.0-p ;
11127    return pq2stat(pq,code,p1,p2,p3) ;
11128 }

int nifti_intent_code

(

char *

name

)

Given a string name for a statistic, return its integer code. Returns -1 if not found. ----------------------------------------------------------------------------

Definition at line 11064 of file nifti_stats.c.

References free, inam, and name.

Referenced by main().

11065 {
11066    char *unam , *upt ;
11067    int ii ;
11068 
11069    if( name == NULL || *name == '\0' ) return -1 ;
11070 
11071    unam = strdup(name) ;
11072    for( upt=unam ; *upt != '\0' ; upt++ ) *upt = (char)toupper(*upt) ;
11073 
11074    for( ii=NIFTI_FIRST_STATCODE ; ii <= NIFTI_LAST_STATCODE ; ii++ )
11075      if( strcmp(inam[ii],unam) == 0 ) break ;
11076 
11077    free(unam) ;
11078    return (ii <= NIFTI_LAST_STATCODE) ? ii : -1 ;
11079 }

double nifti_rcdf2stat	(	double	q,
		int	code,
		double	p1,
		double	p2,
		double	p3
	)

Given a reversed cdf probability, find the value that gave rise to it.

q = 1-cdf; 0 < q < 1
code = NIFTI_INTENT_* statistical code
p1,p2,p3 = parameters of the distribution

If an error transpires, you'll probably get back a BIGG number. ----------------------------------------------------------------------------

Definition at line 11139 of file nifti_stats.c.

References pqpair::p, pq2stat(), and pqpair::q.

11140 {
11141    pqpair pq ;
11142    pq.p = 1.0-q ; pq.q = q ;
11143    return pq2stat(pq,code,p1,p2,p3) ;
11144 }

double nifti_stat2cdf	(	double	val,
		int	code,
		double	p1,
		double	p2,
		double	p3
	)

Given a value, return its cumulative distribution function (cdf):

val = statistic
code = NIFTI_INTENT_* statistical code
p1,p2,p3 = parameters of the distribution

If an error occurs, you'll probably get back 0.0. ----------------------------------------------------------------------------

Definition at line 11090 of file nifti_stats.c.

References pqpair::p, and stat2pq().

Referenced by main().

11091 {
11092    pqpair pq ;
11093    pq = stat2pq( val, code, p1,p2,p3 ) ;
11094    return pq.p ;
11095 }

double nifti_stat2hzscore	(	double	val,
		int	code,
		double	p1,
		double	p2,
		double	p3
	)

Given a statistic, compute a half-z-score from it. That is, the output is z such that cdf(z) of a half-N(0,1) variable is the same as the cdf of the given distribution at val. A half-N(0,1) variable has density zero for z < 0 and twice the usual N(0,1) density for z > 0. ----------------------------------------------------------------------------

Definition at line 11170 of file nifti_stats.c.

References normal_pq2s(), pqpair::p, pqpair::q, and stat2pq().

Referenced by main().

11171 {
11172    pqpair pq ;
11173 
11174    pq = stat2pq( val, code, p1,p2,p3 ) ;                    /* find cdf */
11175    pq.q = 0.5*(1.0-pq.p) ; pq.p = 0.5*(1.0+pq.p) ;          /* mangle it */
11176    return normal_pq2s( pq ) ;                               /* find z  */
11177 }

double nifti_stat2rcdf	(	double	val,
		int	code,
		double	p1,
		double	p2,
		double	p3
	)

Given a value, return its reversed cumulative distribution function (1-cdf):

val = statistic
code = NIFTI_INTENT_* statistical code
p1,p2,p3 = parameters of the distribution

If an error transpires, you'll probably get back 1.0. ----------------------------------------------------------------------------

Definition at line 11107 of file nifti_stats.c.

References pqpair::q, and stat2pq().

Referenced by main().

11108 {
11109    pqpair pq ;
11110    pq = stat2pq( val, code, p1,p2,p3 ) ;
11111    return pq.q ;
11112 }

double nifti_stat2zscore	(	double	val,
		int	code,
		double	p1,
		double	p2,
		double	p3
	)

Given a statistic, compute a z-score from it. That is, the output is z such that cdf(z) of a N(0,1) variable is the same as the cdf of the given distribution at val. ----------------------------------------------------------------------------

Definition at line 11152 of file nifti_stats.c.

References normal_pq2s(), and stat2pq().

Referenced by main().

11153 {
11154    pqpair pq ;
11155 
11156    if( code == NIFTI_INTENT_ZSCORE ) return val ;           /* trivial */
11157    if( code == NIFTI_INTENT_NORMAL ) return (val-p1)/p2 ;   /* almost so */
11158 
11159    pq = stat2pq( val, code, p1,p2,p3 ) ;                    /* find cdf */
11160    return normal_pq2s( pq ) ;                               /* find z  */
11161 }

double normal_pq2s ( pqpair pq ) [static]

Definition at line 10037 of file nifti_stats.c.

References BIGG, dinvnr(), pqpair::p, p, and pqpair::q.

Referenced by nifti_stat2hzscore(), nifti_stat2zscore(), and pq2stat().

10038 {
10039    double p=pq.p , q=pq.q ;
10040 
10041    if( p <= 0.0 ) return -BIGG ;
10042    if( q <= 0.0 ) return  BIGG ;
10043    return dinvnr( &p,&q ) ;
10044 }

pqpair normal_s2pq ( double zz ) [static]

Definition at line 10026 of file nifti_stats.c.

References cumnor(), pqpair::p, p, and pqpair::q.

Referenced by stat2pq().

10027 {
10028    double p , q , x=zz ;
10029    pqpair pq ;
10030 
10031    cumnor( &x, &p, &q ) ;
10032    pq.p = p ; pq.q = q ; return pq ;
10033 }

double poisson_pq2s	(	pqpair	pq,
		double	lambda
	)	`[static]`

Definition at line 10267 of file nifti_stats.c.

References cdfpoi(), pqpair::p, p, and pqpair::q.

Referenced by pq2stat().

10268 {
10269    int which , status ;
10270    double p,q, s,xlam,bound ;
10271 
10272    which  = 2 ;
10273    p      = pq.p ;
10274    q      = pq.q ;
10275    s      = 0.0 ;
10276    xlam   = lambda ;
10277 
10278    cdfpoi( &which , &p , &q , &s , &xlam , &status , &bound ) ;
10279    return s ;
10280 }

pqpair poisson_s2pq	(	double	xx,
		double	lambda
	)	`[static]`

Definition at line 10249 of file nifti_stats.c.

References cdfpoi(), pqpair::p, p, and pqpair::q.

Referenced by stat2pq().

10250 {
10251    int which , status ;
10252    double p,q, s,xlam,bound ;
10253    pqpair pq={0.0,1.0} ;
10254 
10255    which  = 1 ;
10256    p      = 0.0 ;
10257    q      = 1.0 ;
10258    s      = xx ;     if(    s < 0.0 ) return pq ;
10259    xlam   = lambda ; if( xlam < 0.0 ) return pq ;
10260 
10261    cdfpoi( &which , &p , &q , &s , &xlam , &status , &bound ) ;
10262    pq.p = p ; pq.q = q ; return pq ;
10263 }

double pq2stat	(	pqpair	pq,
		int	code,
		double	p1,
		double	p2,
		double	p3
	)	`[static]`

Given a pq value (cdf and 1-cdf), compute the value that gives this. If an error occurs, you'll probably get back a BIGG number. All the actual work is done in utility functions for each distribution. ----------------------------------------------------------------------------

Definition at line 10960 of file nifti_stats.c.

References beta_pq2s(), BIGG, binomial_pq2s(), chi_pq2s(), chisq_pq2s(), chsqnonc_pq2s(), correl_pq2s(), extval1_pq2s(), fnonc_pq2s(), fstat_pq2s(), gamma_pq2s(), invgauss_pq2s(), laplace_pq2s(), logistic_pq2s(), normal_pq2s(), pqpair::p, poisson_pq2s(), pqpair::q, student_pq2s(), tnonc_pq2s(), uniform_pq2s(), and weibull_pq2s().

Referenced by nifti_cdf2stat(), and nifti_rcdf2stat().

10961 {
10962    double val=BIGG ;
10963 
10964    if( pq.p < 0.0 || pq.q < 0.0 || pq.p > 1.0 || pq.q > 1.0 ) return val ;
10965 
10966    switch( code ){
10967 
10968      case NIFTI_INTENT_CORREL:     val = correl_pq2s  ( pq , p1 )      ; break;
10969      case NIFTI_INTENT_TTEST:      val = student_pq2s ( pq , p1 )      ; break;
10970      case NIFTI_INTENT_FTEST:      val = fstat_pq2s   ( pq , p1,p2 )   ; break;
10971      case NIFTI_INTENT_ZSCORE:     val = normal_pq2s  ( pq )           ; break;
10972      case NIFTI_INTENT_CHISQ:      val = chisq_pq2s   ( pq , p1 )      ; break;
10973      case NIFTI_INTENT_BETA:       val = beta_pq2s    ( pq , p1,p2 )   ; break;
10974      case NIFTI_INTENT_BINOM:      val = binomial_pq2s( pq , p1,p2 )   ; break;
10975      case NIFTI_INTENT_GAMMA:      val = gamma_pq2s   ( pq , p1,p2 )   ; break;
10976      case NIFTI_INTENT_POISSON:    val = poisson_pq2s ( pq , p1 )      ; break;
10977      case NIFTI_INTENT_FTEST_NONC: val = fnonc_pq2s   ( pq , p1,p2,p3 ); break;
10978      case NIFTI_INTENT_CHISQ_NONC: val = chsqnonc_pq2s( pq , p1,p2    ); break;
10979      case NIFTI_INTENT_TTEST_NONC: val = tnonc_pq2s   ( pq , p1,p2 )   ; break;
10980      case NIFTI_INTENT_CHI:        val = chi_pq2s     ( pq , p1 )      ; break;
10981 
10982      /* these distributions are shifted and scaled copies of a standard case */
10983 
10984      case NIFTI_INTENT_INVGAUSS:
10985         if( p1 > 0.0 && p2 > 0.0 ) val = p1*invgauss_pq2s   ( pq,p2/p1); break;
10986 
10987      case NIFTI_INTENT_WEIBULL:
10988         if( p2 > 0.0 && p3 > 0.0 ) val = p1+p2*weibull_pq2s ( pq, p3 ) ; break;
10989 
10990      case NIFTI_INTENT_EXTVAL:
10991                     if( p2 > 0.0 ) val = p1+p2*extval1_pq2s ( pq )     ; break;
10992 
10993      case NIFTI_INTENT_NORMAL:
10994                     if( p2 > 0.0 ) val = p1+p2*normal_pq2s  ( pq )     ; break;
10995 
10996      case NIFTI_INTENT_LOGISTIC:
10997                     if( p2 > 0.0 ) val = p1+p2*logistic_pq2s( pq )     ; break;
10998 
10999      case NIFTI_INTENT_LAPLACE:
11000                     if( p2 > 0.0 ) val = p1+p2*laplace_pq2s ( pq )     ; break;
11001 
11002      case NIFTI_INTENT_UNIFORM:
11003                     if( p2 > p1  ) val = p1+(p2-p1)*uniform_pq2s(pq)   ; break;
11004 
11005      /* this case is trivial */
11006 
11007      case NIFTI_INTENT_PVAL:       val = pq.q                          ; break;
11008    }
11009 
11010    return val ;
11011 }

double psi ( double * ) [static]

Definition at line 8913 of file nifti_stats.c.

References fifdmin1(), fifidint(), i, ipmpar(), psi(), and spmpar().

Referenced by apser(), and psi().

08934 {
08935 static double dx0 = 1.461632144968362341262659542325721325e0;
08936 static double piov4 = .785398163397448e0;
08937 static double p1[7] = {
08938     .895385022981970e-02,.477762828042627e+01,.142441585084029e+03,
08939     .118645200713425e+04,.363351846806499e+04,.413810161269013e+04,
08940     .130560269827897e+04
08941 };
08942 static double p2[4] = {
08943     -.212940445131011e+01,-.701677227766759e+01,-.448616543918019e+01,
08944     -.648157123766197e+00
08945 };
08946 static double q1[6] = {
08947     .448452573429826e+02,.520752771467162e+03,.221000799247830e+04,
08948     .364127349079381e+04,.190831076596300e+04,.691091682714533e-05
08949 };
08950 static double q2[4] = {
08951     .322703493791143e+02,.892920700481861e+02,.546117738103215e+02,
08952     .777788548522962e+01
08953 };
08954 static int K1 = 3;
08955 static int K2 = 1;
08956 static double psi,aug,den,sgn,upper,w,x,xmax1,xmx0,xsmall,z;
08957 static int i,m,n,nq;
08958 /*
08959      ..
08960      .. Executable Statements ..
08961 */
08962 /*
08963 ---------------------------------------------------------------------
08964      MACHINE DEPENDENT CONSTANTS ...
08965         XMAX1  = THE SMALLEST POSITIVE FLOATING POINT CONSTANT
08966                  WITH ENTIRELY INTEGER REPRESENTATION.  ALSO USED
08967                  AS NEGATIVE OF LOWER BOUND ON ACCEPTABLE NEGATIVE
08968                  ARGUMENTS AND AS THE POSITIVE ARGUMENT BEYOND WHICH
08969                  PSI MAY BE REPRESENTED AS ALOG(X).
08970         XSMALL = ABSOLUTE ARGUMENT BELOW WHICH PI*COTAN(PI*X)
08971                  MAY BE REPRESENTED BY 1/X.
08972 ---------------------------------------------------------------------
08973 */
08974     xmax1 = ipmpar(&K1);
08975     xmax1 = fifdmin1(xmax1,1.0e0/spmpar(&K2));
08976     xsmall = 1.e-9;
08977     x = *xx;
08978     aug = 0.0e0;
08979     if(x >= 0.5e0) goto S50;
08980 /*
08981 ---------------------------------------------------------------------
08982      X .LT. 0.5,  USE REFLECTION FORMULA
08983      PSI(1-X) = PSI(X) + PI * COTAN(PI*X)
08984 ---------------------------------------------------------------------
08985 */
08986     if(fabs(x) > xsmall) goto S10;
08987     if(x == 0.0e0) goto S100;
08988 /*
08989 ---------------------------------------------------------------------
08990      0 .LT. ABS(X) .LE. XSMALL.  USE 1/X AS A SUBSTITUTE
08991      FOR  PI*COTAN(PI*X)
08992 ---------------------------------------------------------------------
08993 */
08994     aug = -(1.0e0/x);
08995     goto S40;
08996 S10:
08997 /*
08998 ---------------------------------------------------------------------
08999      REDUCTION OF ARGUMENT FOR COTAN
09000 ---------------------------------------------------------------------
09001 */
09002     w = -x;
09003     sgn = piov4;
09004     if(w > 0.0e0) goto S20;
09005     w = -w;
09006     sgn = -sgn;
09007 S20:
09008 /*
09009 ---------------------------------------------------------------------
09010      MAKE AN ERROR EXIT IF X .LE. -XMAX1
09011 ---------------------------------------------------------------------
09012 */
09013     if(w >= xmax1) goto S100;
09014     nq = fifidint(w);
09015     w -= (double)nq;
09016     nq = fifidint(w*4.0e0);
09017     w = 4.0e0*(w-(double)nq*.25e0);
09018 /*
09019 ---------------------------------------------------------------------
09020      W IS NOW RELATED TO THE FRACTIONAL PART OF  4.0 * X.
09021      ADJUST ARGUMENT TO CORRESPOND TO VALUES IN FIRST
09022      QUADRANT AND DETERMINE SIGN
09023 ---------------------------------------------------------------------
09024 */
09025     n = nq/2;
09026     if(n+n != nq) w = 1.0e0-w;
09027     z = piov4*w;
09028     m = n/2;
09029     if(m+m != n) sgn = -sgn;
09030 /*
09031 ---------------------------------------------------------------------
09032      DETERMINE FINAL VALUE FOR  -PI*COTAN(PI*X)
09033 ---------------------------------------------------------------------
09034 */
09035     n = (nq+1)/2;
09036     m = n/2;
09037     m += m;
09038     if(m != n) goto S30;
09039 /*
09040 ---------------------------------------------------------------------
09041      CHECK FOR SINGULARITY
09042 ---------------------------------------------------------------------
09043 */
09044     if(z == 0.0e0) goto S100;
09045 /*
09046 ---------------------------------------------------------------------
09047      USE COS/SIN AS A SUBSTITUTE FOR COTAN, AND
09048      SIN/COS AS A SUBSTITUTE FOR TAN
09049 ---------------------------------------------------------------------
09050 */
09051     aug = sgn*(cos(z)/sin(z)*4.0e0);
09052     goto S40;
09053 S30:
09054     aug = sgn*(sin(z)/cos(z)*4.0e0);
09055 S40:
09056     x = 1.0e0-x;
09057 S50:
09058     if(x > 3.0e0) goto S70;
09059 /*
09060 ---------------------------------------------------------------------
09061      0.5 .LE. X .LE. 3.0
09062 ---------------------------------------------------------------------
09063 */
09064     den = x;
09065     upper = p1[0]*x;
09066     for(i=1; i<=5; i++) {
09067         den = (den+q1[i-1])*x;
09068         upper = (upper+p1[i+1-1])*x;
09069     }
09070     den = (upper+p1[6])/(den+q1[5]);
09071     xmx0 = x-dx0;
09072     psi = den*xmx0+aug;
09073     return psi;
09074 S70:
09075 /*
09076 ---------------------------------------------------------------------
09077      IF X .GE. XMAX1, PSI = LN(X)
09078 ---------------------------------------------------------------------
09079 */
09080     if(x >= xmax1) goto S90;
09081 /*
09082 ---------------------------------------------------------------------
09083      3.0 .LT. X .LT. XMAX1
09084 ---------------------------------------------------------------------
09085 */
09086     w = 1.0e0/(x*x);
09087     den = w;
09088     upper = p2[0]*w;
09089     for(i=1; i<=3; i++) {
09090         den = (den+q2[i-1])*w;
09091         upper = (upper+p2[i+1-1])*w;
09092     }
09093     aug = upper/(den+q2[3])-0.5e0/x+aug;
09094 S90:
09095     psi = aug+log(x);
09096     return psi;
09097 S100:
09098 /*
09099 ---------------------------------------------------------------------
09100      ERROR RETURN
09101 ---------------------------------------------------------------------
09102 */
09103     psi = 0.0e0;
09104     return psi;
09105 } /* END */

double rcomp	(	double *	,
		double *
	)	`[static]`

Definition at line 9108 of file nifti_stats.c.

References a, gam1(), rcomp(), rlog(), and Xgamm().

Referenced by gaminv(), and rcomp().

09116 {
09117 static double rt2pin = .398942280401433e0;
09118 static double rcomp,t,t1,u;
09119 /*
09120      ..
09121      .. Executable Statements ..
09122 */
09123     rcomp = 0.0e0;
09124     if(*a >= 20.0e0) goto S20;
09125     t = *a*log(*x)-*x;
09126     if(*a >= 1.0e0) goto S10;
09127     rcomp = *a*exp(t)*(1.0e0+gam1(a));
09128     return rcomp;
09129 S10:
09130     rcomp = exp(t)/Xgamm(a);
09131     return rcomp;
09132 S20:
09133     u = *x/ *a;
09134     if(u == 0.0e0) return rcomp;
09135     t = pow(1.0e0/ *a,2.0);
09136     t1 = (((0.75e0*t-1.0e0)*t+3.5e0)*t-105.0e0)/(*a*1260.0e0);
09137     t1 -= (*a*rlog(&u));
09138     rcomp = rt2pin*sqrt(*a)*exp(t1);
09139     return rcomp;
09140 } /* END */

double rexp ( double * ) [static]

Definition at line 9143 of file nifti_stats.c.

References rexp().

Referenced by grat1(), gratio(), and rexp().

09149 {
09150 static double p1 = .914041914819518e-09;
09151 static double p2 = .238082361044469e-01;
09152 static double q1 = -.499999999085958e+00;
09153 static double q2 = .107141568980644e+00;
09154 static double q3 = -.119041179760821e-01;
09155 static double q4 = .595130811860248e-03;
09156 static double rexp,w;
09157 /*
09158      ..
09159      .. Executable Statements ..
09160 */
09161     if(fabs(*x) > 0.15e0) goto S10;
09162     rexp = *x*(((p2**x+p1)**x+1.0e0)/((((q4**x+q3)**x+q2)**x+q1)**x+1.0e0));
09163     return rexp;
09164 S10:
09165     w = exp(*x);
09166     if(*x > 0.0e0) goto S20;
09167     rexp = w-0.5e0-0.5e0;
09168     return rexp;
09169 S20:
09170     rexp = w*(0.5e0+(0.5e0-1.0e0/w));
09171     return rexp;
09172 } /* END */

double rlog ( double * ) [static]

Definition at line 9175 of file nifti_stats.c.

References a, r, and rlog().

Referenced by gratio(), rcomp(), and rlog().

09181 {
09182 static double a = .566749439387324e-01;
09183 static double b = .456512608815524e-01;
09184 static double p0 = .333333333333333e+00;
09185 static double p1 = -.224696413112536e+00;
09186 static double p2 = .620886815375787e-02;
09187 static double q1 = -.127408923933623e+01;
09188 static double q2 = .354508718369557e+00;
09189 static double rlog,r,t,u,w,w1;
09190 /*
09191      ..
09192      .. Executable Statements ..
09193 */
09194     if(*x < 0.61e0 || *x > 1.57e0) goto S40;
09195     if(*x < 0.82e0) goto S10;
09196     if(*x > 1.18e0) goto S20;
09197 /*
09198               ARGUMENT REDUCTION
09199 */
09200     u = *x-0.5e0-0.5e0;
09201     w1 = 0.0e0;
09202     goto S30;
09203 S10:
09204     u = *x-0.7e0;
09205     u /= 0.7e0;
09206     w1 = a-u*0.3e0;
09207     goto S30;
09208 S20:
09209     u = 0.75e0**x-1.e0;
09210     w1 = b+u/3.0e0;
09211 S30:
09212 /*
09213                SERIES EXPANSION
09214 */
09215     r = u/(u+2.0e0);
09216     t = r*r;
09217     w = ((p2*t+p1)*t+p0)/((q2*t+q1)*t+1.0e0);
09218     rlog = 2.0e0*t*(1.0e0/(1.0e0-r)-r*w)+w1;
09219     return rlog;
09220 S40:
09221     r = *x-0.5e0-0.5e0;
09222     rlog = r-log(*x);
09223     return rlog;
09224 } /* END */

double rlog1 ( double * ) [static]

Definition at line 9227 of file nifti_stats.c.

References a, r, and rlog1().

Referenced by basym(), brcmp1(), brcomp(), and rlog1().

09233 {
09234 static double a = .566749439387324e-01;
09235 static double b = .456512608815524e-01;
09236 static double p0 = .333333333333333e+00;
09237 static double p1 = -.224696413112536e+00;
09238 static double p2 = .620886815375787e-02;
09239 static double q1 = -.127408923933623e+01;
09240 static double q2 = .354508718369557e+00;
09241 static double rlog1,h,r,t,w,w1;
09242 /*
09243      ..
09244      .. Executable Statements ..
09245 */
09246     if(*x < -0.39e0 || *x > 0.57e0) goto S40;
09247     if(*x < -0.18e0) goto S10;
09248     if(*x > 0.18e0) goto S20;
09249 /*
09250               ARGUMENT REDUCTION
09251 */
09252     h = *x;
09253     w1 = 0.0e0;
09254     goto S30;
09255 S10:
09256     h = *x+0.3e0;
09257     h /= 0.7e0;
09258     w1 = a-h*0.3e0;
09259     goto S30;
09260 S20:
09261     h = 0.75e0**x-0.25e0;
09262     w1 = b+h/3.0e0;
09263 S30:
09264 /*
09265                SERIES EXPANSION
09266 */
09267     r = h/(h+2.0e0);
09268     t = r*r;
09269     w = ((p2*t+p1)*t+p0)/((q2*t+q1)*t+1.0e0);
09270     rlog1 = 2.0e0*t*(1.0e0/(1.0e0-r)-r*w)+w1;
09271     return rlog1;
09272 S40:
09273     w = *x+0.5e0+0.5e0;
09274     rlog1 = *x-log(w);
09275     return rlog1;
09276 } /* END */

double spmpar ( int * ) [static]

Definition at line 9279 of file nifti_stats.c.

References i, ibeta(), ipmpar(), and spmpar().

Referenced by bratio(), cdfbet(), cdfbin(), cdfchi(), cdff(), cdfgam(), cdfnbn(), cdfnor(), cdfpoi(), cdft(), cumnor(), gaminv(), gratio(), psi(), spmpar(), and Xgamm().

09307 {
09308 static int K1 = 4;
09309 static int K2 = 8;
09310 static int K3 = 9;
09311 static int K4 = 10;
09312 static double spmpar,b,binv,bm1,one,w,z;
09313 static int emax,emin,ibeta,m;
09314 /*
09315      ..
09316      .. Executable Statements ..
09317 */
09318     if(*i > 1) goto S10;
09319     b = ipmpar(&K1);
09320     m = ipmpar(&K2);
09321     spmpar = pow(b,(double)(1-m));
09322     return spmpar;
09323 S10:
09324     if(*i > 2) goto S20;
09325     b = ipmpar(&K1);
09326     emin = ipmpar(&K3);
09327     one = 1.0;
09328     binv = one/b;
09329     w = pow(b,(double)(emin+2));
09330     spmpar = w*binv*binv*binv;
09331     return spmpar;
09332 S20:
09333     ibeta = ipmpar(&K1);
09334     m = ipmpar(&K2);
09335     emax = ipmpar(&K4);
09336     b = ibeta;
09337     bm1 = ibeta-1;
09338     one = 1.0;
09339     z = pow(b,(double)(m-1));
09340     w = ((z-one)*b+bm1)/(b*z);
09341     z = pow(b,(double)(emax-2));
09342     spmpar = w*z*b*b;
09343     return spmpar;
09344 } /* END */

pqpair stat2pq	(	double	val,
		int	code,
		double	p1,
		double	p2,
		double	p3
	)	`[static]`

Given a value, calculate both its cdf and reversed cdf (1.0-cdf). If an error occurs, you'll probably get back {0.0,1.0}. All the actual work is done in utility functions for each distribution. ----------------------------------------------------------------------------

Definition at line 10903 of file nifti_stats.c.

References beta_s2pq(), binomial_s2pq(), chi_s2pq(), chisq_s2pq(), chsqnonc_s2pq(), correl_s2pq(), extval1_s2pq(), fnonc_s2pq(), fstat_s2pq(), gamma_s2pq(), invgauss_s2pq(), laplace_s2pq(), logistic_s2pq(), normal_s2pq(), pqpair::p, poisson_s2pq(), pqpair::q, student_s2pq(), tnonc_s2pq(), uniform_s2pq(), and weibull_s2pq().

Referenced by nifti_stat2cdf(), nifti_stat2hzscore(), nifti_stat2rcdf(), and nifti_stat2zscore().

10904 {
10905    pqpair pq={0.0,1.0} ;
10906 
10907    switch( code ){
10908 
10909      case NIFTI_INTENT_CORREL:     pq = correl_s2pq  ( val, p1 )      ; break;
10910      case NIFTI_INTENT_TTEST:      pq = student_s2pq ( val, p1 )      ; break;
10911      case NIFTI_INTENT_FTEST:      pq = fstat_s2pq   ( val, p1,p2 )   ; break;
10912      case NIFTI_INTENT_ZSCORE:     pq = normal_s2pq  ( val )          ; break;
10913      case NIFTI_INTENT_CHISQ:      pq = chisq_s2pq   ( val, p1 )      ; break;
10914      case NIFTI_INTENT_BETA:       pq = beta_s2pq    ( val, p1,p2 )   ; break;
10915      case NIFTI_INTENT_BINOM:      pq = binomial_s2pq( val, p1,p2 )   ; break;
10916      case NIFTI_INTENT_GAMMA:      pq = gamma_s2pq   ( val, p1,p2 )   ; break;
10917      case NIFTI_INTENT_POISSON:    pq = poisson_s2pq ( val, p1 )      ; break;
10918      case NIFTI_INTENT_FTEST_NONC: pq = fnonc_s2pq   ( val, p1,p2,p3 ); break;
10919      case NIFTI_INTENT_CHISQ_NONC: pq = chsqnonc_s2pq( val, p1,p2    ); break;
10920      case NIFTI_INTENT_TTEST_NONC: pq = tnonc_s2pq   ( val, p1,p2 )   ; break;
10921      case NIFTI_INTENT_CHI:        pq = chi_s2pq     ( val, p1 )      ; break;
10922 
10923      /* these distributions are shifted and scaled copies of a standard case */
10924 
10925      case NIFTI_INTENT_INVGAUSS:
10926         if( p1 > 0.0 && p2 > 0.0 ) pq = invgauss_s2pq( val/p1,p2/p1 ) ; break;
10927 
10928      case NIFTI_INTENT_WEIBULL:
10929         if( p2 > 0.0 && p3 > 0.0 ) pq = weibull_s2pq ((val-p1)/p2,p3) ; break;
10930 
10931      case NIFTI_INTENT_EXTVAL:
10932                     if( p2 > 0.0 ) pq = extval1_s2pq ( (val-p1)/p2 )  ; break;
10933 
10934      case NIFTI_INTENT_NORMAL:
10935                     if( p2 > 0.0 ) pq = normal_s2pq  ( (val-p1)/p2 )  ; break;
10936 
10937      case NIFTI_INTENT_LOGISTIC:
10938                     if( p2 > 0.0 ) pq = logistic_s2pq( (val-p1)/p2 )  ; break;
10939 
10940      case NIFTI_INTENT_LAPLACE:
10941                     if( p2 > 0.0 ) pq = laplace_s2pq ( (val-p1)/p2 )  ; break;
10942 
10943      case NIFTI_INTENT_UNIFORM:
10944                     if( p2 > p1  ) pq = uniform_s2pq((val-p1)/(p2-p1)); break;
10945 
10946      /* this case is trivial */
10947 
10948      case NIFTI_INTENT_PVAL:       pq.p = 1.0-val ; pq.q = val        ; break;
10949    }
10950 
10951    return pq ;
10952 }

double student_pq2s	(	pqpair	pq,
		double	dof
	)

Definition at line 10304 of file nifti_stats.c.

References cdft(), pqpair::p, p, and pqpair::q.

Referenced by pq2stat(), and tnonc_pq2s().

10305 {
10306    int which , status ;
10307    double p,q, s,xlam,bound ;
10308 
10309    which  = 2 ;
10310    p      = pq.p ;
10311    q      = pq.q ;
10312    s      = 0.0 ;
10313    xlam   = dof ;
10314 
10315    cdft( &which , &p , &q , &s , &xlam , &status , &bound ) ;
10316    return s ;
10317 }

pqpair student_s2pq	(	double	xx,
		double	dof
	)	`[static]`

Definition at line 10286 of file nifti_stats.c.

References cdft(), pqpair::p, p, and pqpair::q.

Referenced by stat2pq(), and tnonc_s2pq().

10287 {
10288    int which , status ;
10289    double p,q, s,xlam,bound ;
10290    pqpair pq={0.0,1.0} ;
10291 
10292    which  = 1 ;
10293    p      = 0.0 ;
10294    q      = 1.0 ;
10295    s      = xx ;
10296    xlam   = dof ;  if( xlam <= 0.0 ) return pq ;
10297 
10298    cdft( &which , &p , &q , &s , &xlam , &status , &bound ) ;
10299    pq.p = p ; pq.q = q ; return pq ;
10300 }

double stvaln ( double * ) [static]

Definition at line 9347 of file nifti_stats.c.

References devlpl(), p, and stvaln().

Referenced by dinvnr(), and stvaln().

09378 {
09379 static double xden[5] = {
09380     0.993484626060e-1,0.588581570495e0,0.531103462366e0,0.103537752850e0,
09381     0.38560700634e-2
09382 };
09383 static double xnum[5] = {
09384     -0.322232431088e0,-1.000000000000e0,-0.342242088547e0,-0.204231210245e-1,
09385     -0.453642210148e-4
09386 };
09387 static int K1 = 5;
09388 static double stvaln,sign,y,z;
09389 /*
09390      ..
09391      .. Executable Statements ..
09392 */
09393     if(!(*p <= 0.5e0)) goto S10;
09394     sign = -1.0e0;
09395     z = *p;
09396     goto S20;
09397 S10:
09398     sign = 1.0e0;
09399     z = 1.0e0-*p;
09400 S20:
09401     y = sqrt(-(2.0e0*log(z)));
09402     stvaln = y+devlpl(xnum,&K1,&y)/devlpl(xden,&K1,&y);
09403     stvaln = sign*stvaln;
09404     return stvaln;
09405 } /* END */

double tnonc_pq2s	(	pqpair	pq,
		double	dof,
		double	nonc
	)	`[static]`

df=1 is BAD *

Definition at line 10673 of file nifti_stats.c.

References BIGG, dinvr(), dstinv(), dt, pqpair::p, pqpair::q, student_pq2s(), and tnonc_s2pq().

Referenced by pq2stat().

10674 {
10675    double t ;  /* will be result */
10676    double tbot,ttop , dt ;
10677    double T6=1.e-50,T7=1.e-8 ;
10678    double K4=0.5,K5=5.0 ;
10679    double fx ;
10680    unsigned long qhi,qleft ;
10681    int status , qporq , ite ;
10682    pqpair tpq ;
10683 
10684    if( dof  <= 0.0 ) return  BIGG ;  /* bad user */
10685    if( pq.p <= 0.0 ) return -BIGG ;
10686    if( pq.q <= 0.0 ) return  BIGG ;
10687 
10688    t = student_pq2s(pq,dof) ;   /* initial guess */
10689 
10690    if( fabs(nonc) < 1.e-8 ) return t ;
10691 
10692    t += 0.5*nonc ;  /* adjust up or down */
10693 
10694    dt = 0.1 * fabs(t) ; if( dt < 1.0 ) dt = 1.0 ;  /* stepsize */
10695 
10696    /* scan down for lower bound, below which cdf is < p */
10697 
10698    tbot = t ;
10699    for( ite=0 ; ite < 1000 ; ite++ ){
10700      tpq = tnonc_s2pq( tbot , dof , nonc ) ;
10701      if( tpq.p <= pq.p ) break ;
10702      tbot -= dt ;
10703    }
10704    if( ite >= 1000 ) return -BIGG ;
10705 
10706    /* scan up for upper bound, above which cdf is > p */
10707 
10708    ttop = tbot+0.5*dt ;
10709    for( ite=0 ; ite < 1000 ; ite++ ){
10710      tpq = tnonc_s2pq( ttop , dof , nonc ) ;
10711      if( tpq.p >= pq.p ) break ;
10712      ttop += dt ;
10713    }
10714    if( ite >= 1000 ) return BIGG ;
10715 
10716    t = 0.5*(tbot+ttop) ;  /* initial guess in middle */
10717 
10718    /* initialize searching parameters */
10719 
10720    dstinv(&tbot,&ttop,&K4,&K4,&K5,&T6,&T7);
10721 
10722    status = 0 ; qporq = (pq.p <= pq.q) ;
10723 
10724    while(1){
10725 
10726      dinvr(&status,&t,&fx,&qleft,&qhi) ;
10727 
10728      if( status != 1 ) return t ;  /* done! */
10729 
10730      tpq = tnonc_s2pq( t , dof , nonc ) ;  /* get cdf */
10731 
10732      /* goal of dinvr is to drive fx to zero */
10733 
10734      fx = (qporq) ? pq.p-tpq.p : pq.q-tpq.q ;
10735    }
10736 
10737    return BIGG ;  /* unreachable */
10738 }

pqpair tnonc_s2pq	(	double	t,
		double	df,
		double	delta
	)	`[static]`

Definition at line 10552 of file nifti_stats.c.

References a, alng, betadf(), c, gaudf(), i, pqpair::p, pqpair::q, and student_s2pq().

Referenced by stat2pq(), and tnonc_pq2s().

10553 {
10554    int indx , k , i ;
10555    double x,del,tnd,ans,y,dels,a,b,c ;
10556    double pkf,pkb,qkf,qkb , pgamf,pgamb,qgamf,qgamb ;
10557    double pbetaf,pbetab,qbetaf,qbetab ;
10558    double ptermf,qtermf,ptermb,qtermb,term ;
10559    double rempois,delosq2,sum,cons,error ;
10560 
10561    pqpair pq={0.0,1.0} ;  /* will be return value */
10562    double ab1 ;
10563 
10564    /*-- stupid user? --*/
10565 
10566    if( df <= 0.0 ) return pq ;
10567 
10568    /*-- non-centrality = 0? --*/
10569 
10570    if( fabs(delta) < 1.e-8 ) return student_s2pq(t,df) ;
10571 
10572    /*-- start K's code here --*/
10573 
10574    if( t < 0.0 ){ x = -t ; del = -delta ; indx = 1 ; }  /* x will be */
10575    else         { x =  t ; del =  delta ; indx = 0 ; }  /* positive */
10576 
10577    ans = gaudf(-del) ;  /* prob that x <= 0 = Normal cdf */
10578 
10579    /*-- the nearly trivial case of x=0 --*/
10580 
10581    if( x == 0.0 ){ pq.p = ans; pq.q = 1.0-ans; return pq; }
10582 
10583    if( df == 1.0 ) df = 1.0000001 ;  /** df=1 is BAD **/
10584 
10585    y = x*x/(df+x*x) ;    /* between 0 and 1 */
10586    dels = 0.5*del*del ;  /* will be positive */
10587    k = (int)dels ;       /* 0, 1, 2, ... */
10588    a = k+0.5 ;           /* might be as small as 0.5 */
10589    c = k+1.0 ;
10590    b = 0.5*df ;          /* might be as small as 0.0 */
10591 
10592    pkf = exp(-dels+k*log(dels)-alng(k+1.0)) ;
10593    pkb = pkf ;
10594    qkf = exp(-dels+k*log(dels)-alng(k+1.0+0.5)) ;
10595    qkb = qkf ;
10596 
10597    pbetaf = betadf(y, a, b) ;
10598    pbetab = pbetaf ;
10599    qbetaf = betadf(y, c, b) ;
10600    qbetab = qbetaf ;
10601 
10602    ab1 = a+b-1.0 ;  /* might be as small as -0.5 */
10603 
10604    /*-- RWCox: if a+b-1 < 0, log(Gamma(a+b-1)) won't work;
10605                instead, use Gamma(a+b-1)=Gamma(a+b)/(a+b-1) --*/
10606 
10607    if( ab1 > 0.0 )
10608      pgamf = exp(alng(ab1)-alng(a)-alng(b)+(a-1.0)*log(y)+b*log(1.0-y)) ;
10609    else
10610      pgamf = exp(alng(a+b)-alng(a)-alng(b)+(a-1.0)*log(y)+b*log(1.0-y))/ab1 ;
10611 
10612    pgamb = pgamf*y*(ab1)/a ;
10613 
10614    /*-- we can't have c+b-1 < 0, so the above patchup isn't needed --*/
10615 
10616    qgamf = exp(alng(c+b-1.0)-alng(c)-alng(b)+(c-1.0)*log(y) + b*log(1.0-y)) ;
10617    qgamb = qgamf*y*(c+b-1.0)/c ;
10618 
10619    rempois = 1.0 - pkf ;
10620    delosq2 = del/1.4142135623731 ;
10621    sum = pkf*pbetaf+delosq2*qkf*qbetaf ;
10622    cons = 0.5*(1.0 + 0.5*fabs(delta)) ;
10623    i = 0 ;
10624 L1:
10625    i = i + 1 ;
10626    pgamf = pgamf*y*(a+b+i-2.0)/(a+i-1.0) ;
10627    pbetaf = pbetaf - pgamf ;
10628    pkf = pkf*dels/(k+i) ;
10629    ptermf = pkf*pbetaf ;
10630    qgamf = qgamf*y*(c+b+i-2.0)/(c+i-1.0) ;
10631    qbetaf = qbetaf - qgamf ;
10632    qkf = qkf*dels/(k+i-1.0+1.5) ;
10633    qtermf = qkf*qbetaf ;
10634    term = ptermf + delosq2*qtermf  ;
10635    sum = sum + term ;
10636    error = rempois*cons*pbetaf ;
10637    rempois = rempois - pkf ;
10638 
10639    if( i > k ){
10640      if( error <= 1.e-12 || i >= 9999 ) goto L2 ;
10641      goto L1 ;
10642    } else {
10643      pgamb = pgamb*(a-i+1.0)/(y*(a+b-i)) ;
10644      pbetab = pbetab + pgamb ;
10645      pkb = (k-i+1.0)*pkb/dels ;
10646      ptermb = pkb*pbetab  ;
10647      qgamb = qgamb*(c-i+1.0)/(y*(c+b-i)) ;
10648      qbetab = qbetab + qgamb ;
10649      qkb = (k-i+1.0+0.5)*qkb/dels ;
10650      qtermb = qkb*qbetab  ;
10651      term =  ptermb + delosq2*qtermb ;
10652      sum = sum + term  ;
10653      rempois = rempois - pkb ;
10654      if (rempois <= 1.e-12 || i >= 9999) goto L2 ;
10655      goto L1 ;
10656    }
10657 L2:
10658    tnd = 0.5*sum + ans ;
10659 
10660    /*-- return a pqpair, not just the cdf --*/
10661 
10662    if( indx ){ pq.p = 1.0-tnd; pq.q = tnd    ; }
10663    else      { pq.p = tnd    ; pq.q = 1.0-tnd; }
10664    return pq ;
10665 }

double uniform_pq2s ( pqpair pq ) [static]

Definition at line 10356 of file nifti_stats.c.

References pqpair::p.

Referenced by pq2stat().

10357 {
10358    return pq.p ;   /* that was easy */
10359 }

pqpair uniform_s2pq ( double xx ) [static]

Definition at line 10345 of file nifti_stats.c.

References pqpair::p, and pqpair::q.

Referenced by stat2pq().

10346 {
10347    pqpair pq ;
10348         if( xx <= 0.0 ) pq.p = 0.0 ;
10349    else if( xx >= 1.0 ) pq.p = 1.0 ;
10350    else                 pq.p = xx  ;
10351    pq.q = 1.0-xx ; return pq ;
10352 }

double weibull_pq2s	(	pqpair	pq,
		double	c
	)	`[static]`

Definition at line 10805 of file nifti_stats.c.

References BIGG, c, pqpair::p, and pqpair::q.

Referenced by pq2stat().

10806 {
10807         if( pq.p <= 0.0 || c <= 0.0 ) return  0.0 ;
10808    else if( pq.q <= 0.0             ) return BIGG ;
10809    return pow( -log(pq.q) , 1.0/c ) ;
10810 }

pqpair weibull_s2pq	(	double	x,
		double	c
	)	`[static]`

Definition at line 10790 of file nifti_stats.c.

References c, pqpair::p, and pqpair::q.

Referenced by stat2pq().

10791 {
10792    double y ;
10793    pqpair pq={0.0,1.0} ;
10794 
10795    if( x <= 0.0 || c <= 0.0 ) return pq ;
10796 
10797    y = pow(x,c) ; pq.q = exp(-y) ;
10798    if( y >= 1.e-4 ) pq.p = 1.0-pq.q ;
10799    else             pq.p = y*(1.0+y*(-0.5+y*(1.0/6.0-y/24.0))) ;
10800    return pq ;
10801 }

double Xgamm ( double * ) [static]

Definition at line 8209 of file nifti_stats.c.

References a, exparg(), fifidint(), fifmod(), i, p, spmpar(), top, and Xgamm().

Referenced by gaminv(), gratio(), rcomp(), and Xgamm().

08226 {
08227 static double d = .41893853320467274178e0;
08228 static double pi = 3.1415926535898e0;
08229 static double r1 = .820756370353826e-03;
08230 static double r2 = -.595156336428591e-03;
08231 static double r3 = .793650663183693e-03;
08232 static double r4 = -.277777777770481e-02;
08233 static double r5 = .833333333333333e-01;
08234 static double p[7] = {
08235     .539637273585445e-03,.261939260042690e-02,.204493667594920e-01,
08236     .730981088720487e-01,.279648642639792e+00,.553413866010467e+00,1.0e0
08237 };
08238 static double q[7] = {
08239     -.832979206704073e-03,.470059485860584e-02,.225211131035340e-01,
08240     -.170458969313360e+00,-.567902761974940e-01,.113062953091122e+01,1.0e0
08241 };
08242 static int K2 = 3;
08243 static int K3 = 0;
08244 static double Xgamm,bot,g,lnx,s,t,top,w,x,z;
08245 static int i,j,m,n,T1;
08246 /*
08247      ..
08248      .. Executable Statements ..
08249 */
08250     Xgamm = 0.0e0;
08251     x = *a;
08252     if(fabs(*a) >= 15.0e0) goto S110;
08253 /*
08254 -----------------------------------------------------------------------
08255             EVALUATION OF GAMMA(A) FOR ABS(A) .LT. 15
08256 -----------------------------------------------------------------------
08257 */
08258     t = 1.0e0;
08259     m = fifidint(*a)-1;
08260 /*
08261      LET T BE THE PRODUCT OF A-J WHEN A .GE. 2
08262 */
08263     T1 = m;
08264     if(T1 < 0) goto S40;
08265     else if(T1 == 0) goto S30;
08266     else  goto S10;
08267 S10:
08268     for(j=1; j<=m; j++) {
08269         x -= 1.0e0;
08270         t = x*t;
08271     }
08272 S30:
08273     x -= 1.0e0;
08274     goto S80;
08275 S40:
08276 /*
08277      LET T BE THE PRODUCT OF A+J WHEN A .LT. 1
08278 */
08279     t = *a;
08280     if(*a > 0.0e0) goto S70;
08281     m = -m-1;
08282     if(m == 0) goto S60;
08283     for(j=1; j<=m; j++) {
08284         x += 1.0e0;
08285         t = x*t;
08286     }
08287 S60:
08288     x += (0.5e0+0.5e0);
08289     t = x*t;
08290     if(t == 0.0e0) return Xgamm;
08291 S70:
08292 /*
08293      THE FOLLOWING CODE CHECKS IF 1/T CAN OVERFLOW. THIS
08294      CODE MAY BE OMITTED IF DESIRED.
08295 */
08296     if(fabs(t) >= 1.e-30) goto S80;
08297     if(fabs(t)*spmpar(&K2) <= 1.0001e0) return Xgamm;
08298     Xgamm = 1.0e0/t;
08299     return Xgamm;
08300 S80:
08301 /*
08302      COMPUTE GAMMA(1 + X) FOR  0 .LE. X .LT. 1
08303 */
08304     top = p[0];
08305     bot = q[0];
08306     for(i=1; i<7; i++) {
08307         top = p[i]+x*top;
08308         bot = q[i]+x*bot;
08309     }
08310     Xgamm = top/bot;
08311 /*
08312      TERMINATION
08313 */
08314     if(*a < 1.0e0) goto S100;
08315     Xgamm *= t;
08316     return Xgamm;
08317 S100:
08318     Xgamm /= t;
08319     return Xgamm;
08320 S110:
08321 /*
08322 -----------------------------------------------------------------------
08323             EVALUATION OF GAMMA(A) FOR ABS(A) .GE. 15
08324 -----------------------------------------------------------------------
08325 */
08326     if(fabs(*a) >= 1.e3) return Xgamm;
08327     if(*a > 0.0e0) goto S120;
08328     x = -*a;
08329     n = x;
08330     t = x-(double)n;
08331     if(t > 0.9e0) t = 1.0e0-t;
08332     s = sin(pi*t)/pi;
08333     if(fifmod(n,2) == 0) s = -s;
08334     if(s == 0.0e0) return Xgamm;
08335 S120:
08336 /*
08337      COMPUTE THE MODIFIED ASYMPTOTIC SUM
08338 */
08339     t = 1.0e0/(x*x);
08340     g = ((((r1*t+r2)*t+r3)*t+r4)*t+r5)/x;
08341 /*
08342      ONE MAY REPLACE THE NEXT STATEMENT WITH  LNX = ALOG(X)
08343      BUT LESS ACCURACY WILL NORMALLY BE OBTAINED.
08344 */
08345     lnx = log(x);
08346 /*
08347      FINAL ASSEMBLY
08348 */
08349     z = x;
08350     g = d+g+(z-0.5e0)*(lnx-1.e0);
08351     w = g;
08352     t = g-w;
08353     if(w > 0.99999e0*exparg(&K3)) return Xgamm;
08354     Xgamm = exp(w)*(1.0e0+t);
08355     if(*a < 0.0e0) Xgamm = 1.0e0/(Xgamm*s)/x;
08356     return Xgamm;
08357 } /* END */

Variable Documentation

char* inam[] [static]

Initial value:

{ NULL , NULL ,
                       "CORREL"   , "TTEST"   , "FTEST"      , "ZSCORE"     ,
                       "CHISQ"    , "BETA"    , "BINOM"      , "GAMMA"      ,
                       "POISSON"  , "NORMAL"  , "FTEST_NONC" , "CHISQ_NONC" ,
                       "LOGISTIC" , "LAPLACE" , "UNIFORM"    , "TTEST_NONC" ,
                       "WEIBULL"  , "CHI"     , "INVGAUSS"   , "EXTVAL"     ,
                       "PVAL"     ,
                     NULL }

Definition at line 11047 of file nifti_stats.c.

Referenced by main(), and nifti_intent_code().

AFNI/NIfTI Server

Sections

Personal tools

nifti_stats.c File Reference

Data Structures

Defines

Functions

Variables

Define Documentation

Function Documentation

Variable Documentation