The R Project SVN R

Rev

Rev 5408 | Rev 7002 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
3279 pd 1
/*
2
 *  Mathlib : A C Library of Special Functions
5458 ripley 3
 *  Copyright (C) 1998-1999 R Development Core Team
3279 pd 4
 *
5
 *  This program is free software; you can redistribute it and/or modify
6
 *  it under the terms of the GNU General Public License as published by
7
 *  the Free Software Foundation; either version 2 of the License, or
8
 *  (at your option) any later version.
9
 *
10
 *  This program is distributed in the hope that it will be useful,
11
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
12
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13
 *  GNU General Public License for more details.
14
 *
15
 *  You should have received a copy of the GNU General Public License
16
 *  along with this program; if not, write to the Free Software
5458 ripley 17
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
3279 pd 18
 *
19
 
20
 * Mathlib.h  should contain ALL headers from R's C code in `src/nmath'
21
   ---------  such that ``the Math library'' can be used by simply
22
 
23
   ``#include "Mathlib.h" ''
24
 
25
   and nothing else.
26
*/
571 ihaka 27
#ifndef MATHLIB_H
28
#define MATHLIB_H
2 r 29
 
3279 pd 30
/*-- Mathlib as part of R --  undefine this for standalone : */
31
#define MATHLIB_IN_R
3076 pd 32
 
2 r 33
#include "Arith.h"
3076 pd 34
#include "Random.h"
2 r 35
 
2629 maechler 36
#ifdef FORTRAN_H
37
#error __MUST__include "Mathlib.h"  _before_  "Fortran.h"
38
#endif
39
 
571 ihaka 40
#include <errno.h>
2737 hornik 41
#include <limits.h>
571 ihaka 42
#include <float.h>
2 r 43
#include <math.h>
44
#include <stdlib.h>
45
 
2629 maechler 46
/* TRUE and FALSE conflict with the Mac --- Fortran.h still defines them... */
47
#define LTRUE	(1)
48
#define LFALSE	(0)
49
 
3244 ihaka 50
/* 30 Decimal-place constants */
51
/* Computed with bc -l (scale=32; proper round) */
2 r 52
 
3244 ihaka 53
/* SVID & X/Open Constants */
54
/* Names from Solaris math.h */
55
 
56
#ifndef M_E
57
#define M_E		2.718281828459045235360287471353	/* e */
58
#endif
59
 
60
#ifndef M_LOG2E
61
#define M_LOG2E		1.442695040888963407359924681002	/* log2(e) */
62
#endif
63
 
64
#ifndef M_LOG10E
4835 maechler 65
#define M_LOG10E	0.434294481903251827651128918917	/* log10(e) */
3244 ihaka 66
#endif
67
 
68
#ifndef M_LN2
69
#define M_LN2		0.693147180559945309417232121458	/* ln(2) */
70
#endif
71
 
72
#ifndef M_LN10
73
#define M_LN10		2.302585092994045684017991454684	/* ln(10) */
74
#endif
75
 
76
#ifndef M_PI
4835 maechler 77
#define M_PI		3.141592653589793238462643383280	/* pi */
3244 ihaka 78
#endif
79
 
80
#ifndef M_PI_2
81
#define M_PI_2		1.570796326794896619231321691640	/* pi/2 */
82
#endif
83
 
84
#ifndef M_PI_4
85
#define M_PI_4		0.785398163397448309615660845820	/* pi/4 */
86
#endif
87
 
4835 maechler 88
#ifndef M_1_PI
3244 ihaka 89
#define M_1_PI		0.318309886183790671537767526745	/* 1/pi */
90
#endif
91
 
4835 maechler 92
#ifndef M_2_PI
3244 ihaka 93
#define M_2_PI		0.636619772367581343075535053490	/* 1/pi */
94
#endif
95
 
96
#ifndef M_2_SQRTPI
97
#define M_2_SQRTPI	1.128379167095512573896158903122	/* 1/sqrt(pi) */
98
#endif
99
 
100
#ifndef M_SQRT2
101
#define M_SQRT2		1.414213562373095048801688724210	/* sqrt(2) */
102
#endif
103
 
104
#ifndef M_SQRT1_2
105
#define M_SQRT1_2	0.707106781186547524400844362105	/* 1/sqrt(2) */
106
#endif
107
 
108
/* Other, R-Specific Constants */
109
/* Note there are some repeats of values above */
110
/* Needs a cleanup */
111
 
112
#ifndef M_1_SQRT_2
777 maechler 113
#define M_1_SQRT_2	0.707106781186547524400844362105	/* 1/sqrt(2) */
3244 ihaka 114
#endif
115
 
116
#ifndef M_SQRT_32
777 maechler 117
#define M_SQRT_32	5.656854249492380195206754896838	/* sqrt(32) */
2 r 118
#endif
119
 
3244 ihaka 120
#ifndef M_LOG10_2
121
#define M_LOG10_2	0.301029995663981195213738894724	/* log10(2) */
777 maechler 122
#endif
123
 
2 r 124
#ifndef M_PI_half
3244 ihaka 125
#define M_PI_half	1.570796326794896619231321691640	/* pi/2 */
2 r 126
#endif
127
 
128
#ifndef M_SQRT_PI
3244 ihaka 129
#define M_SQRT_PI	1.772453850905516027298167483341	/* sqrt(pi) */
2 r 130
#endif
131
 
3244 ihaka 132
#ifndef M_1_SQRT_2PI
133
#define M_1_SQRT_2PI	0.398942280401432677939946059934	/* 1/sqrt(2pi) */
134
#endif
2 r 135
 
3244 ihaka 136
#ifndef M_SQRT_2dPI
137
#define M_SQRT_2dPI	0.797884560802865355879892119869	/* sqrt(2/pi) */
138
#endif
139
 
140
 
777 maechler 141
#ifndef M_LN_SQRT_PI
3244 ihaka 142
#define M_LN_SQRT_PI	0.572364942924700087071713675677	/* log(sqrt(pi)) */
2 r 143
#endif
144
 
3244 ihaka 145
#ifndef M_LN_SQRT_2PI
146
#define M_LN_SQRT_2PI	0.918938533204672741780329736406	/* log(sqrt(2*pi)) */
147
#endif
777 maechler 148
 
3244 ihaka 149
#ifndef M_LN_SQRT_PId2
150
#define M_LN_SQRT_PId2	0.225791352644727432363097614947	/* log(sqrt(pi/2)) */
151
#endif
152
 
153
 
3076 pd 154
#ifdef MATHLIB_IN_R/* Mathlib in R */
777 maechler 155
 
3076 pd 156
#include "Error.h"
157
# define MATHLIB_ERROR(fmt,x)		error(fmt,x);
158
# define MATHLIB_WARNING(fmt,x)		warning(fmt,x)
159
# define MATHLIB_WARNING2(fmt,x,x2)	warning(fmt,x,x2)
160
# define MATHLIB_WARNING3(fmt,x,x2,x3)	warning(fmt,x,x2,x3)
161
# define MATHLIB_WARNING4(fmt,x,x2,x3,x4) warning(fmt,x,x2,x3,x4)
2 r 162
 
3076 pd 163
#else/* Mathlib standalone */
164
 
165
#include <stdio.h>
3786 pd 166
# define MATHLIB_ERROR(fmt,x)	{ printf(fmt,x); exit(1) }
3076 pd 167
# define MATHLIB_WARNING(fmt,x)		printf(fmt,x)
168
# define MATHLIB_WARNING2(fmt,x,x2)	printf(fmt,x,x2)
169
# define MATHLIB_WARNING3(fmt,x,x2,x3)	printf(fmt,x,x2,x3)
170
# define MATHLIB_WARNING4(fmt,x,x2,x3,x4) printf(fmt,x,x2,x3,x4)
171
#endif
172
 
571 ihaka 173
#define ME_NONE		0
3786 pd 174
/*	no error */
571 ihaka 175
#define ME_DOMAIN	1
3786 pd 176
/*	argument out of domain */
571 ihaka 177
#define ME_RANGE	2
3786 pd 178
/*	value out of range */
179
#define ME_NOCONV	4
180
/*	process did not converge */
181
#define ME_PRECISION	8
182
/*	does not have "full" precision */
183
#define ME_UNDERFLOW	16
184
/*	and underflow occured (important for IEEE)*/
571 ihaka 185
 
186
 
187
#ifdef IEEE_754
3786 pd 188
 
3609 pd 189
# ifdef HAVE_IEEE754_H
190
#  include <ieee754.h> /* newer Linuxen */
191
# else
192
#  ifdef HAVE_IEEEFP_H
193
#   include <ieeefp.h> /* others [Solaris 2.5.x], .. */
194
#  endif
195
# endif
995 ihaka 196
 
571 ihaka 197
extern double m_zero;
198
extern double m_one;
3548 ihaka 199
/* extern double m_tiny; */
571 ihaka 200
#define ML_ERROR(x)	/* nothing */
201
#define ML_POSINF	(m_one / m_zero)
202
#define ML_NEGINF	((-m_one) / m_zero)
203
#define ML_NAN		(m_zero / m_zero)
3548 ihaka 204
#define ML_UNDERFLOW	(DBL_MIN * DBL_MIN)
777 maechler 205
#define ML_VALID(x)	(!isnan(x))
3609 pd 206
 
207
#else/*--- NO IEEE: No +/-Inf, NAN,... ---*/
571 ihaka 208
#define ML_ERROR(x)	ml_error(x)
209
#define ML_POSINF	DBL_MAX
210
#define ML_NEGINF	(-DBL_MAX)
211
#define ML_NAN		(-DBL_MAX)
212
#define ML_UNDERFLOW	0
777 maechler 213
#define ML_VALID(x)	(errno == 0)
2 r 214
#endif
215
 
571 ihaka 216
	/* Splus Compatibility */
2 r 217
 
571 ihaka 218
#define snorm	norm_rand
219
#define sunif	unif_rand
220
#define sexp	exp_rand
2 r 221
 
1394 ihaka 222
	/* Undo SGI Madness */
223
 
224
#ifdef ftrunc
5408 hornik 225
# undef ftrunc
1394 ihaka 226
#endif
227
#ifdef qexp
5408 hornik 228
# undef qexp
1394 ihaka 229
#endif
5408 hornik 230
#ifdef qgamma
231
# undef qgamma
232
#endif
1394 ihaka 233
 
571 ihaka 234
	/* Name Hiding to Avoid Clashes with Fortran */
2 r 235
 
571 ihaka 236
#ifdef HIDE_NAMES
3076 pd 237
# define d1mach	c_d1mach
238
# define i1mach	c_i1mach
571 ihaka 239
#endif
2 r 240
 
571 ihaka 241
#define	rround	fround
242
#define	prec	fprec
3244 ihaka 243
#undef trunc
571 ihaka 244
#define	trunc	ftrunc
2 r 245
 
4835 maechler 246
 
247
	/* Utilities for `dpq' handling (density/probability/quantile) */
248
 
249
#define R_D__0 (give_log ? ML_NEGINF : 0.)
250
#define R_D__1 (give_log ? 0. : 1.)
251
#define R_DT_0 (lower_tail ? R_D__0 : R_D__1)
252
#define R_DT_1 (lower_tail ? R_D__1 : R_D__0)
253
 
254
#define R_D_val(x)   (give_log	 ? log(x) : x)	      /*  x  */
255
#define R_D_log(x)   (give_log	 ?  x	  : exp(x))   /* log(x) */
256
 
257
#define R_DT_val(x)  R_D_val(lower_tail ? x	 : 1. - x) /*  x  */
258
#define R_DT_Cval(x) R_D_val(lower_tail ? 1. - x : x)	   /*  1 - x */
259
#define R_DT_log(x)  R_D_log(lower_tail ? x	 : 1. - x) /* log(x) */
260
#define R_DT_Clog(x) R_D_log(lower_tail ? 1. - x : x)	   /* log(1 - x) */
261
 
262
#define R_D_give_log(dd)    (((int)dd) >> 1) /* Extract ``give_log'' flag */
263
#define R_D_lower_tail(dd)  (((int)dd) % 2)  /* Extract ``lower_tail'' flag */
264
 
265
	/* R's version of C functions: */
266
 
267
double R_log(double x);
268
double R_pow(double x, double y);
269
 
571 ihaka 270
	/* Machine Characteristics */
2 r 271
 
571 ihaka 272
double	d1mach(int);
273
double	d1mach_(int*);
274
int	i1mach(int);
275
int	i1mach_(int*);
2 r 276
 
571 ihaka 277
	/* General Support Functions */
2 r 278
 
571 ihaka 279
int	imax2(int, int);
280
int	imin2(int, int);
281
double	fmax2(double, double);
282
double	fmin2(double, double);
283
double	fmod(double, double);
284
double	fprec(double, double);
285
double	fround(double, double);
286
double	ftrunc(double);
3076 pd 287
double	sign(double);
571 ihaka 288
double	fsign(double, double);
289
double	fsquare(double);
290
double	fcube(double);
2 r 291
 
571 ihaka 292
	/* Random Number Generators */
2 r 293
 
571 ihaka 294
double	snorm(void);
295
double	sunif(void);
296
double	sexp(void);
2 r 297
 
571 ihaka 298
	/* Chebyshev Series */
2 r 299
 
571 ihaka 300
int	chebyshev_init(double*, int, double);
301
double	chebyshev_eval(double, double *, int);
2 r 302
 
571 ihaka 303
	/* Gamma and Related Functions */
2 r 304
 
571 ihaka 305
double	logrelerr(double);
306
void	gammalims(double*, double*);
307
double	lgammacor(double);
2278 maechler 308
double	gammafn(double);
2629 maechler 309
double	gamma_cody(double);
2278 maechler 310
double	lgammafn(double);
571 ihaka 311
void	dpsifn(double, int, int, int, double*, int*, int*);
312
double	digamma(double);
313
double	trigamma(double);
314
double	tetragamma(double);
315
double	pentagamma(double);
2 r 316
 
571 ihaka 317
double	choose(double, double);
318
double	lchoose(double, double);
319
double	fastchoose(double, double);
320
double	lfastchoose(double, double);
2 r 321
 
2629 maechler 322
	/* Bessel Functions of All Kinds */
323
 
3786 pd 324
double	bessel_i(double, double, double);
325
double	bessel_j(double, double);
326
double	bessel_k(double, double, double);
327
double	bessel_y(double, double);
328
void	I_bessel(double*, double*, long*, long*, double*, long*);
329
void	J_bessel(double*, double*, long*,	 double*, long*);
330
void	K_bessel(double*, double*, long*, long*, double*, long*);
331
void	Y_bessel(double*, double*, long*,	 double*, long*);
2629 maechler 332
 
571 ihaka 333
	/* Beta and Related Functions */
2 r 334
 
571 ihaka 335
double	beta(double, double);
336
double	lbeta(double, double);
2 r 337
 
571 ihaka 338
	/* Normal Distribution */
2 r 339
 
571 ihaka 340
double	dnorm(double, double, double);
341
double	pnorm(double, double, double);
342
double	qnorm(double, double, double);
343
double	rnorm(double, double);
2 r 344
 
571 ihaka 345
	/* Uniform Distribution */
2 r 346
 
571 ihaka 347
double	dunif(double, double, double);
348
double	punif(double, double, double);
349
double	qunif(double, double, double);
350
double	runif(double, double);
2 r 351
 
571 ihaka 352
	/* Gamma Distribution */
2 r 353
 
571 ihaka 354
double	dgamma(double, double, double);
355
double	pgamma(double, double, double);
356
double	qgamma(double, double, double);
357
double	rgamma(double, double);
2 r 358
 
571 ihaka 359
	/* Beta Distribution */
2 r 360
 
571 ihaka 361
double	dbeta(double, double, double);
362
double	pbeta(double, double, double);
363
double	pbeta_raw(double, double, double);
364
double	qbeta(double, double, double);
365
double	rbeta(double, double);
2 r 366
 
571 ihaka 367
	/* Lognormal Distribution */
2 r 368
 
571 ihaka 369
double	dlnorm(double, double, double);
370
double	plnorm(double, double, double);
371
double	qlnorm(double, double, double);
372
double	rlnorm(double, double);
2 r 373
 
571 ihaka 374
	/* Chi-squared Distribution */
2 r 375
 
571 ihaka 376
double	dchisq(double, double);
377
double	pchisq(double, double);
378
double	qchisq(double, double);
379
double	rchisq(double);
2 r 380
 
571 ihaka 381
	/* Non-central Chi-squared Distribution */
2 r 382
 
605 ihaka 383
double	dnchisq(double, double, double);
571 ihaka 384
double	pnchisq(double, double, double);
385
double	qnchisq(double, double, double);
605 ihaka 386
double	rnchisq(double, double);
571 ihaka 387
 
388
	/* F Distibution */
389
 
390
double	df(double, double, double);
391
double	pf(double, double, double);
392
double	qf(double, double, double);
393
double	rf(double, double);
394
 
395
	/* Student t Distibution */
396
 
397
double	dt(double, double);
398
double	pt(double, double);
399
double	qt(double, double);
400
double	rt(double);
401
 
402
	/* Binomial Distribution */
403
 
404
double	dbinom(double, double, double);
405
double	pbinom(double, double, double);
406
double	qbinom(double, double, double);
407
double	rbinom(double, double);
408
 
409
	/* Cauchy Distribution */
410
 
411
double	dcauchy(double, double, double);
412
double	pcauchy(double, double, double);
413
double	qcauchy(double, double, double);
414
double	rcauchy(double, double);
415
 
416
	/* Exponential Distribution */
417
 
418
double	dexp(double, double);
419
double	pexp(double, double);
420
double	qexp(double, double);
421
double	rexp(double);
422
 
423
	/* Geometric Distribution */
424
 
425
double	dgeom(double, double);
426
double	pgeom(double, double);
427
double	qgeom(double, double);
428
double	rgeom(double);
429
 
430
	/* Hypergeometric Distibution */
431
 
432
double	dhyper(double, double, double, double);
433
double	phyper(double, double, double, double);
434
double	qhyper(double, double, double, double);
435
double	rhyper(double, double, double);
436
 
437
	/* Negative Binomial Distribution */
438
 
439
double	dnbinom(double, double, double);
440
double	pnbinom(double, double, double);
441
double	qnbinom(double, double, double);
442
double	rnbinom(double, double);
443
 
444
	/* Poisson Distribution */
445
 
446
double	dpois(double, double);
447
double	ppois(double, double);
448
double	qpois(double, double);
449
double	rpois(double);
450
 
451
	/* Weibull Distribution */
452
 
453
double	dweibull(double, double, double);
454
double	pweibull(double, double, double);
455
double	qweibull(double, double, double);
456
double	rweibull(double, double);
457
 
458
	/* Logistic Distribution */
459
 
460
double	dlogis(double, double, double);
461
double	plogis(double, double, double);
462
double	qlogis(double, double, double);
463
double	rlogis(double, double);
464
 
602 ihaka 465
	/* Non-central Beta Distribution */
466
 
467
double	dnbeta(double, double, double, double);
468
double	pnbeta(double, double, double, double);
469
double	qnbeta(double, double, double, double);
470
double	rnbeta(double, double, double);
471
 
472
	/* Non-central F Distribution */
473
 
474
double	dnf(double, double, double, double);
475
double	pnf(double, double, double, double);
476
double	qnf(double, double, double, double);
477
double	rnf(double, double, double);
478
 
479
	/* Non-central Student t Distribution */
480
 
481
double	dnt(double, double, double);
482
double	pnt(double, double, double);
483
double	qnt(double, double, double);
484
double	rnt(double, double);
485
 
624 ihaka 486
	/* Studentized Range Distribution */
487
 
488
double	dtukey(double, double, double, double);
489
double	ptukey(double, double, double, double);
490
double	qtukey(double, double, double, double);
491
double	rtukey(double, double, double);
492
 
2235 hornik 493
/* Wilcoxon Rank Sum Distribution */
1276 hornik 494
 
3865 pd 495
#define WILCOX_MAX 50
1276 hornik 496
double dwilcox(double, double, double);
497
double pwilcox(double, double, double);
498
double qwilcox(double, double, double);
499
double rwilcox(double, double);
500
 
2235 hornik 501
/* Wilcoxon Signed Rank Distribution */
502
 
3865 pd 503
#define SIGNRANK_MAX 50
2235 hornik 504
double dsignrank(double, double);
505
double psignrank(double, double);
506
double qsignrank(double, double);
507
double rsignrank(double);
508
 
2 r 509
#endif