The R Project SVN R

Rev

Rev 77685 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 77685 Rev 79202
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  R : A Computer Language for Statistical Data Analysis
 2 
 *  R : A Computer Language for Statistical Data Analysis
3 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
 - 
 
4 
 *  Copyright (C) 2000-2008   The R Core Team
 3 
 *  Copyright (C) 2000--2020  The R Core Team
5 
 *  Copyright (C) 2004	      The R Foundation
 4 
 *  Copyright (C) 2004	      The R Foundation
- 
 
 5 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
6 
 *
 6 
 *
7 
 *  This program is free software; you can redistribute it and/or modify
 7 
 *  This program is free software; you can redistribute it and/or modify
8 
 *  it under the terms of the GNU General Public License as published by
 8 
 *  it under the terms of the GNU General Public License as published by
9 
 *  the Free Software Foundation; either version 2 of the License, or
 9 
 *  the Free Software Foundation; either version 2 of the License, or
10 
 *  (at your option) any later version.
 10 
 *  (at your option) any later version.
Line 44... Line 44...
44 
     */
 44 
     */
45 
    if (df < 0 || ncp < 0) ML_WARN_return_NAN;
 45 
    if (df < 0 || ncp < 0) ML_WARN_return_NAN;
46 
 
 46 
 
47 
    R_Q_P01_boundaries(p, 0, ML_POSINF);
 47 
    R_Q_P01_boundaries(p, 0, ML_POSINF);
48 
 
 48 
 
49 
    pp = R_D_qIv(p);
 49 
    pp = R_D_qIv(p); // exp(p) iff log_p
50 
    if(pp > 1 - DBL_EPSILON) return lower_tail ? ML_POSINF : 0.0;
 50 
    if(pp > 1 - DBL_EPSILON)
- 
 
 51 
	return lower_tail ? ML_POSINF : 0.0; // early under/over flow  iff log_p (FIXME)
51 
 
 52 
 
52 
    /* Invert pnchisq(.) :
 53 
    /* Invert pnchisq(.) :
53 
     * 1. finding an upper and lower bound */
 54 
     * 1. finding an upper and lower bound */
54 
    {
 55 
    {
55 
       /* This is Pearson's (1959) approximation,
 56 
       /* This is Pearson's (1959) approximation,
Line 57... Line 58...
57 
	double b, c, ff;
 58 
	double b, c, ff;
58 
	b = (ncp*ncp)/(df + 3*ncp);
 59 
	b = (ncp*ncp)/(df + 3*ncp);
59 
	c = (df + 3*ncp)/(df + 2*ncp);
 60 
	c = (df + 3*ncp)/(df + 2*ncp);
60 
	ff = (df + 2 * ncp)/(c*c);
 61 
	ff = (df + 2 * ncp)/(c*c);
61 
	ux = b + c * qchisq(p, ff, lower_tail, log_p);
 62 
	ux = b + c * qchisq(p, ff, lower_tail, log_p);
62 
	if(ux < 0) ux = 1;
 63 
	if(ux <= 0.) ux = 1;
63 
	ux0 = ux;
 64 
	ux0 = ux;
64 
    }
 65 
    }
65 
 
 66 
 
66 
    if(!lower_tail && ncp >= 80) {
 67 
    if(!lower_tail && ncp >= 80) {
67 
	/* in this case, pnchisq() works via lower_tail = TRUE */
 68 
	/* in this case, pnchisq() works via lower_tail = TRUE */