| Clover coverage report - baseCode - 0.2.5 |
|
 |
|
|
|||||||||||||||||||
| 30 day Evaluation Version distributed via the Maven Jar Repository. Clover is not free. You have 30 days to evaluate it. Please visit http://www.thecortex.net/clover to obtain a licensed version of Clover | |||||||||||||||||||
| Source file | Conditionals | Statements | Methods | TOTAL | |||||||||||||||
| SpecFunc.java | 51.8% | 80.2% | 100% | 70.8% |
|
||||||||||||||
| 1 |
package baseCode.math;
|
|
| 2 |
|
|
| 3 |
import cern.jet.stat.Gamma;
|
|
| 4 |
|
|
| 5 |
/**
|
|
| 6 |
* Assorted special functions, primarily concerning probability distributions. For cumBinomial use
|
|
| 7 |
* cern.jet.stat.Probability.binomial.
|
|
| 8 |
* <p>
|
|
| 9 |
* Mostly ported from the R source tree (dhyper.c etc.), much due to Catherine Loader.
|
|
| 10 |
* <p>
|
|
| 11 |
*
|
|
| 12 |
* @see <a href="http://hoschek.home.cern.ch/hoschek/colt/V1.0.3/doc/cern/jet/stat/Gamma.html">cern.jet.stat.gamma </a>
|
|
| 13 |
* @see <a
|
|
| 14 |
* href="http://hoschek.home.cern.ch/hoschek/colt/V1.0.3/doc/cern/jet/math/Arithmetic.html">cern.jet.math.arithmetic
|
|
| 15 |
* </a>
|
|
| 16 |
* <p>
|
|
| 17 |
* Copyright (c) 2004 Columbia University
|
|
| 18 |
* @author Paul Pavlidis
|
|
| 19 |
* @version $Id: SpecFunc.java,v 1.7 2004/12/24 23:16:09 pavlidis Exp $
|
|
| 20 |
*/
|
|
| 21 |
public class SpecFunc { |
|
| 22 |
|
|
| 23 |
/**
|
|
| 24 |
* Ported from R phyper.c
|
|
| 25 |
* <p>
|
|
| 26 |
* Sample of n balls from NR red and NB black ones; x are red
|
|
| 27 |
* <p>
|
|
| 28 |
*
|
|
| 29 |
* @param x - number of reds retrieved == successes
|
|
| 30 |
* @param NR - number of reds in the urn. == positives
|
|
| 31 |
* @param NB - number of blacks in the urn == negatives
|
|
| 32 |
* @param n - the total number of objects drawn == successes + failures
|
|
| 33 |
* @param lowerTail
|
|
| 34 |
* @return cumulative hypergeometric distribution.
|
|
| 35 |
*/
|
|
| 36 | 2 |
public static double phyper( int x, int NR, int NB, int n, boolean lowerTail ) { |
| 37 |
|
|
| 38 | 2 |
double d, pd;
|
| 39 |
|
|
| 40 | 2 |
if ( NR < 0 || NB < 0 || n < 0 || n > NR + NB ) {
|
| 41 | 0 |
throw new IllegalArgumentException(); |
| 42 |
} |
|
| 43 |
|
|
| 44 | 2 |
if ( x * ( NR + NB ) > n * NR ) {
|
| 45 |
/* Swap tails. */
|
|
| 46 | 1 |
int oldNB = NB;
|
| 47 | 1 |
NB = NR; |
| 48 | 1 |
NR = oldNB; |
| 49 | 1 |
x = n - x - 1; |
| 50 | 1 |
lowerTail = !lowerTail; |
| 51 |
} |
|
| 52 |
|
|
| 53 | 0 |
if ( x < 0 ) return 0.0; |
| 54 |
|
|
| 55 | 2 |
d = dhyper( x, NR, NB, n ); |
| 56 | 2 |
pd = pdhyper( x, NR, NB, n ); |
| 57 |
|
|
| 58 | 2 |
return lowerTail ? d * pd : 1.0 - ( d * pd );
|
| 59 |
} |
|
| 60 |
|
|
| 61 |
/**
|
|
| 62 |
* Ported from R (Catherine Loader)
|
|
| 63 |
* <p>
|
|
| 64 |
* DESCRIPTION
|
|
| 65 |
* <p>
|
|
| 66 |
* Given a sequence of r successes and b failures, we sample n (\le b+r) items without replacement. The
|
|
| 67 |
* hypergeometric probability is the probability of x successes:
|
|
| 68 |
*
|
|
| 69 |
* <pre>
|
|
| 70 |
*
|
|
| 71 |
*
|
|
| 72 |
*
|
|
| 73 |
*
|
|
| 74 |
*
|
|
| 75 |
*
|
|
| 76 |
*
|
|
| 77 |
*
|
|
| 78 |
*
|
|
| 79 |
*
|
|
| 80 |
* choose(r, x) * choose(b, n-x)
|
|
| 81 |
* p(x; r,b,n) = ----------------------------- =
|
|
| 82 |
* choose(r+b, n)
|
|
| 83 |
*
|
|
| 84 |
* dbinom(x,r,p) * dbinom(n-x,b,p)
|
|
| 85 |
* = --------------------------------
|
|
| 86 |
* dbinom(n,r+b,p)
|
|
| 87 |
*
|
|
| 88 |
*
|
|
| 89 |
*
|
|
| 90 |
*
|
|
| 91 |
*
|
|
| 92 |
*
|
|
| 93 |
*
|
|
| 94 |
*
|
|
| 95 |
*
|
|
| 96 |
*
|
|
| 97 |
* </pre>
|
|
| 98 |
*
|
|
| 99 |
* for any p. For numerical stability, we take p=n/(r+b); with this choice, the denominator is not exponentially
|
|
| 100 |
* small.
|
|
| 101 |
*/
|
|
| 102 | 3 |
public static double dhyper( int x, int r, int b, int n ) { |
| 103 | 3 |
double p, q, p1, p2, p3;
|
| 104 |
|
|
| 105 | 3 |
if ( r < 0 || b < 0 || n < 0 || n > r + b )
|
| 106 | 0 |
throw new IllegalArgumentException(); |
| 107 |
|
|
| 108 | 0 |
if ( x < 0 ) return 0.0; |
| 109 |
|
|
| 110 | 0 |
if ( n < x || r < x || n - x > b ) return 0; |
| 111 | 0 |
if ( n == 0 ) return ( ( x == 0 ) ? 1 : 0 ); |
| 112 |
|
|
| 113 | 3 |
p = ( ( double ) n ) / ( ( double ) ( r + b ) ); |
| 114 | 3 |
q = ( ( double ) ( r + b - n ) ) / ( ( double ) ( r + b ) ); |
| 115 |
|
|
| 116 | 3 |
p1 = dbinom_raw( x, r, p, q ); |
| 117 | 3 |
p2 = dbinom_raw( n - x, b, p, q ); |
| 118 | 3 |
p3 = dbinom_raw( n, r + b, p, q ); |
| 119 |
|
|
| 120 | 3 |
return p1 * p2 / p3;
|
| 121 |
} |
|
| 122 |
|
|
| 123 |
/**
|
|
| 124 |
* See dbinom_raw.
|
|
| 125 |
* <hr>
|
|
| 126 |
*
|
|
| 127 |
* @param x Number of successes
|
|
| 128 |
* @param n Number of trials
|
|
| 129 |
* @param p Probability of success
|
|
| 130 |
* @return
|
|
| 131 |
*/
|
|
| 132 | 1 |
public static double dbinom( double x, double n, double p ) { |
| 133 |
|
|
| 134 | 0 |
if ( p < 0 || p > 1 || n < 0 ) throw new IllegalArgumentException(); |
| 135 |
|
|
| 136 | 1 |
return dbinom_raw( x, n, p, 1 - p );
|
| 137 |
} |
|
| 138 |
|
|
| 139 |
/**
|
|
| 140 |
* Ported from R phyper.c
|
|
| 141 |
* <p>
|
|
| 142 |
* Calculate
|
|
| 143 |
*
|
|
| 144 |
* <pre>
|
|
| 145 |
*
|
|
| 146 |
*
|
|
| 147 |
*
|
|
| 148 |
* phyper (x, NR, NB, n, TRUE, FALSE)
|
|
| 149 |
* [log] ----------------------------------
|
|
| 150 |
* dhyper (x, NR, NB, n, FALSE)
|
|
| 151 |
*
|
|
| 152 |
*
|
|
| 153 |
*
|
|
| 154 |
* </pre>
|
|
| 155 |
*
|
|
| 156 |
* without actually calling phyper. This assumes that
|
|
| 157 |
*
|
|
| 158 |
* <pre>
|
|
| 159 |
* x * ( NR + NB ) <= n * NR
|
|
| 160 |
* </pre>
|
|
| 161 |
*
|
|
| 162 |
* <hr>
|
|
| 163 |
*
|
|
| 164 |
* @param x - number of reds retrieved == successes
|
|
| 165 |
* @param NR - number of reds in the urn. == positives
|
|
| 166 |
* @param NB - number of blacks in the urn == negatives
|
|
| 167 |
* @param n - the total number of objects drawn == successes + failures
|
|
| 168 |
*/
|
|
| 169 | 2 |
private static double pdhyper( int x, int NR, int NB, int n ) { |
| 170 | 2 |
double sum = 0.0;
|
| 171 | 2 |
double term = 1.0;
|
| 172 |
|
|
| 173 | 2 |
while ( x > 0.0 && term >= Double.MIN_VALUE * sum ) {
|
| 174 | 33 |
term *= ( double ) x * ( NB - n + x ) / ( n + 1 - x ) / ( NR + 1 - x );
|
| 175 | 33 |
sum += term; |
| 176 | 33 |
x--; |
| 177 |
} |
|
| 178 |
|
|
| 179 | 2 |
return 1.0 + sum;
|
| 180 |
} |
|
| 181 |
|
|
| 182 |
/**
|
|
| 183 |
* Ported from R dbinom.c
|
|
| 184 |
* <p>
|
|
| 185 |
* Due to Catherine Loader, catherine@research.bell-labs.com.
|
|
| 186 |
* <p>
|
|
| 187 |
* To compute the binomial probability, call dbinom(x,n,p). This checks for argument validity, and calls
|
|
| 188 |
* dbinom_raw().
|
|
| 189 |
* <p>
|
|
| 190 |
* dbinom_raw() does the actual computation; note this is called by other functions in addition to dbinom()).
|
|
| 191 |
* <ol>
|
|
| 192 |
* <li>dbinom_raw() has both p and q arguments, when one may be represented more accurately than the other (in
|
|
| 193 |
* particular, in df()).
|
|
| 194 |
* <li>dbinom_raw() does NOT check that inputs x and n are integers. This should be done in the calling function,
|
|
| 195 |
* where necessary.
|
|
| 196 |
* <li>Also does not check for 0 <= p <= 1 and 0 <= q <= 1 or NaN's. Do this in the calling function.
|
|
| 197 |
* </ol>
|
|
| 198 |
* <hr>
|
|
| 199 |
*
|
|
| 200 |
* @param x Number of successes
|
|
| 201 |
* @param n Number of trials
|
|
| 202 |
* @param p Probability of success
|
|
| 203 |
* @param q 1 - p
|
|
| 204 |
*/
|
|
| 205 | 10 |
private static double dbinom_raw( double x, double n, double p, double q ) { |
| 206 | 10 |
double f, lc;
|
| 207 |
|
|
| 208 | 0 |
if ( p == 0 ) return ( ( x == 0 ) ? 1 : 0 ); |
| 209 | 0 |
if ( q == 0 ) return ( ( x == n ) ? 1 : 0 ); |
| 210 |
|
|
| 211 | 10 |
if ( x == 0 ) {
|
| 212 | 0 |
if ( n == 0 ) return 1; |
| 213 | 0 |
lc = ( p < 0.1 ) ? -bd0( n, n * q ) - n * p : n * Math.log( q ); |
| 214 | 0 |
return ( Math.exp( lc ) );
|
| 215 |
} |
|
| 216 | 10 |
if ( x == n ) {
|
| 217 | 0 |
lc = ( q < 0.1 ) ? -bd0( n, n * p ) - n * q : n * Math.log( p ); |
| 218 | 0 |
return ( Math.exp( lc ) );
|
| 219 |
} |
|
| 220 | 0 |
if ( x < 0 || x > n ) return ( 0 ); |
| 221 |
|
|
| 222 | 10 |
lc = stirlerr( n ) - stirlerr( x ) - stirlerr( n - x ) - bd0( x, n * p ) |
| 223 |
- bd0( n - x, n * q ); |
|
| 224 | 10 |
f = ( 2 * Math.PI * x * ( n - x ) ) / n; |
| 225 |
|
|
| 226 | 10 |
return Math.exp( lc ) / Math.sqrt( f );
|
| 227 |
} |
|
| 228 |
|
|
| 229 |
/**
|
|
| 230 |
* Ported from stirlerr.c (Catherine Loader).
|
|
| 231 |
* <p>
|
|
| 232 |
* Note that this is the same functionality as colt's Arithemetic.stirlingCorrection. I am keeping this version for
|
|
| 233 |
* compatibility with R.
|
|
| 234 |
*
|
|
| 235 |
* <pre>
|
|
| 236 |
*
|
|
| 237 |
*
|
|
| 238 |
*
|
|
| 239 |
*
|
|
| 240 |
*
|
|
| 241 |
*
|
|
| 242 |
*
|
|
| 243 |
* stirlerr(n) = log(n!) - log( sqrt(2*pi*n)*(n/e)ˆn )
|
|
| 244 |
* = log Gamma(n+1) - 1/2 * [log(2*pi) + log(n)] - n*[log(n) - 1]
|
|
| 245 |
* = log Gamma(n+1) - (n + 1/2) * log(n) + n - log(2*pi)/2
|
|
| 246 |
*
|
|
| 247 |
*
|
|
| 248 |
*
|
|
| 249 |
*
|
|
| 250 |
*
|
|
| 251 |
*
|
|
| 252 |
*
|
|
| 253 |
* </pre>
|
|
| 254 |
*/
|
|
| 255 | 30 |
private static double stirlerr( double n ) { |
| 256 |
|
|
| 257 | 30 |
double S0 = 0.083333333333333333333; /* 1/12 */ |
| 258 | 30 |
double S1 = 0.00277777777777777777778; /* 1/360 */ |
| 259 | 30 |
double S2 = 0.00079365079365079365079365; /* 1/1260 */ |
| 260 | 30 |
double S3 = 0.000595238095238095238095238;/* 1/1680 */ |
| 261 | 30 |
double S4 = 0.0008417508417508417508417508;/* 1/1188 */ |
| 262 |
|
|
| 263 |
/*
|
|
| 264 |
* error for 0, 0.5, 1.0, 1.5, ..., 14.5, 15.0.
|
|
| 265 |
*/
|
|
| 266 | 30 |
double[] sferr_halves = new double[] { |
| 267 |
0.0, /* n=0 - wrong, place holder only */
|
|
| 268 |
0.1534264097200273452913848, /* 0.5 */
|
|
| 269 |
0.0810614667953272582196702, /* 1.0 */
|
|
| 270 |
0.0548141210519176538961390, /* 1.5 */
|
|
| 271 |
0.0413406959554092940938221, /* 2.0 */
|
|
| 272 |
0.03316287351993628748511048, /* 2.5 */
|
|
| 273 |
0.02767792568499833914878929, /* 3.0 */
|
|
| 274 |
0.02374616365629749597132920, /* 3.5 */
|
|
| 275 |
0.02079067210376509311152277, /* 4.0 */
|
|
| 276 |
0.01848845053267318523077934, /* 4.5 */
|
|
| 277 |
0.01664469118982119216319487, /* 5.0 */
|
|
| 278 |
0.01513497322191737887351255, /* 5.5 */
|
|
| 279 |
0.01387612882307074799874573, /* 6.0 */
|
|
| 280 |
0.01281046524292022692424986, /* 6.5 */
|
|
| 281 |
0.01189670994589177009505572, /* 7.0 */
|
|
| 282 |
0.01110455975820691732662991, /* 7.5 */
|
|
| 283 |
0.010411265261972096497478567, /* 8.0 */
|
|
| 284 |
0.009799416126158803298389475, /* 8.5 */
|
|
| 285 |
0.009255462182712732917728637, /* 9.0 */
|
|
| 286 |
0.008768700134139385462952823, /* 9.5 */
|
|
| 287 |
0.008330563433362871256469318, /* 10.0 */
|
|
| 288 |
0.007934114564314020547248100, /* 10.5 */
|
|
| 289 |
0.007573675487951840794972024, /* 11.0 */
|
|
| 290 |
0.007244554301320383179543912, /* 11.5 */
|
|
| 291 |
0.006942840107209529865664152, /* 12.0 */
|
|
| 292 |
0.006665247032707682442354394, /* 12.5 */
|
|
| 293 |
0.006408994188004207068439631, /* 13.0 */
|
|
| 294 |
0.006171712263039457647532867, /* 13.5 */
|
|
| 295 |
0.005951370112758847735624416, /* 14.0 */
|
|
| 296 |
0.005746216513010115682023589, /* 14.5 */
|
|
| 297 |
0.005554733551962801371038690 |
|
| 298 |
/* 15.0 */
|
|
| 299 |
}; |
|
| 300 |
|
|
| 301 | 30 |
double nn;
|
| 302 |
|
|
| 303 | 30 |
if ( n <= 15.0 ) {
|
| 304 | 4 |
nn = n + n; |
| 305 | 4 |
if ( nn == ( int ) nn ) return ( sferr_halves[( int ) nn] ); |
| 306 | 0 |
return ( Gamma.logGamma( n + 1. ) - ( n + 0.5 ) * Math.log( n ) + n - Constants.M_LN_SQRT_2PI );
|
| 307 |
} |
|
| 308 |
|
|
| 309 | 26 |
nn = n * n; |
| 310 | 0 |
if ( n > 500 ) return ( ( S0 - S1 / nn ) / n ); |
| 311 | 8 |
if ( n > 80 ) return ( ( S0 - ( S1 - S2 / nn ) / nn ) / n ); |
| 312 | 18 |
if ( n > 35 )
|
| 313 | 11 |
return ( ( S0 - ( S1 - ( S2 - S3 / nn ) / nn ) / nn ) / n );
|
| 314 |
/* 15 < n <= 35 : */
|
|
| 315 | 7 |
return ( ( S0 - ( S1 - ( S2 - ( S3 - S4 / nn ) / nn ) / nn ) / nn ) / n );
|
| 316 |
} |
|
| 317 |
|
|
| 318 |
/**
|
|
| 319 |
* Ported from bd0.c in R source.
|
|
| 320 |
* <p>
|
|
| 321 |
* Evaluates the "deviance part"
|
|
| 322 |
*
|
|
| 323 |
* <pre>
|
|
| 324 |
*
|
|
| 325 |
*
|
|
| 326 |
*
|
|
| 327 |
* bd0(x,M) := M * D0(x/M) = M*[ x/M * log(x/M) + 1 - (x/M) ] =
|
|
| 328 |
* = x * log(x/M) + M - x
|
|
| 329 |
* where M = E[X] = n*p (or = lambda), for x, M > 0
|
|
| 330 |
*
|
|
| 331 |
*
|
|
| 332 |
*
|
|
| 333 |
* <p>
|
|
| 334 |
*
|
|
| 335 |
*
|
|
| 336 |
*
|
|
| 337 |
* in a manner that should be stable (with small relative error)
|
|
| 338 |
* for all x and np. In particular for x/np close to 1, direct
|
|
| 339 |
* evaluation fails, and evaluation is based on the Taylor series
|
|
| 340 |
* of log((1+v)/(1-v)) with v = (x-np)/(x+np).
|
|
| 341 |
*
|
|
| 342 |
*
|
|
| 343 |
*
|
|
| 344 |
* <hr>
|
|
| 345 |
*
|
|
| 346 |
*
|
|
| 347 |
* @param x
|
|
| 348 |
* @param np
|
|
| 349 |
* @return
|
|
| 350 |
*
|
|
| 351 |
*/
|
|
| 352 | 20 |
private static double bd0( double x, double np ) { |
| 353 | 20 |
double ej, s, s1, v;
|
| 354 | 20 |
int j;
|
| 355 |
|
|
| 356 | 20 |
if ( Math.abs( x - np ) < 0.1 * ( x + np ) ) {
|
| 357 | 12 |
v = ( x - np ) / ( x + np ); |
| 358 | 12 |
s = ( x - np ) * v;/* s using v -- change by MM */
|
| 359 | 12 |
ej = 2 * x * v; |
| 360 | 12 |
v = v * v; |
| 361 | 12 |
for ( j = 1;; j++ ) { /* Taylor series */ |
| 362 | 50 |
ej *= v; |
| 363 | 50 |
s1 = s + ej / ( ( j << 1 ) + 1 ); |
| 364 | 50 |
if ( s1 == s ) /* last term was effectively 0 */ |
| 365 | 12 |
return ( s1 );
|
| 366 | 38 |
s = s1; |
| 367 |
} |
|
| 368 |
} |
|
| 369 |
/* else: | x - np | is not too small */
|
|
| 370 | 8 |
return ( x * Math.log( x / np ) + np - x );
|
| 371 |
} |
|
| 372 |
|
|
| 373 |
|
|
| 374 |
|
|
| 375 |
|
|
| 376 |
|
|
| 377 |
} |
|
||||||||||
