The R Project SVN R

Rev

Rev 68947 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 68947 Rev 70234
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  Mathlib : A C Library of Special Functions
 2 
 *  Mathlib : A C Library of Special Functions
3 
 *  Copyright (C) 1998 Ross Ihaka
 3 
 *  Copyright (C) 1998 Ross Ihaka
4 
 *  Copyright (C) 2000-2013 The R Core Team
 4 
 *  Copyright (C) 2000-2016 The R Core Team
5 
 *
 5 
 *
6 
 *  This program is free software; you can redistribute it and/or modify
 6 
 *  This program is free software; you can redistribute it and/or modify
7 
 *  it under the terms of the GNU General Public License as published by
 7 
 *  it under the terms of the GNU General Public License as published by
8 
 *  the Free Software Foundation; either version 2 of the License, or
 8 
 *  the Free Software Foundation; either version 2 of the License, or
9 
 *  (at your option) any later version.
 9 
 *  (at your option) any later version.
Line 37... Line 37...
37 
    if(!R_FINITE(size) || !R_FINITE(prob))	ML_ERR_return_NAN;
 37 
    if(!R_FINITE(size) || !R_FINITE(prob))	ML_ERR_return_NAN;
38 
#endif
 38 
#endif
39 
    if (size < 0 || prob <= 0 || prob > 1)	ML_ERR_return_NAN;
 39 
    if (size < 0 || prob <= 0 || prob > 1)	ML_ERR_return_NAN;
40 
 
 40 
 
41 
    /* limiting case: point mass at zero */
 41 
    /* limiting case: point mass at zero */
42 
    if (size == 0)
42 
    if (size == 0)
43 
        return (x >= 0) ? R_DT_1 : R_DT_0;
43 
        return (x >= 0) ? R_DT_1 : R_DT_0;
44 
 
 44 
 
45 
    if (x < 0) return R_DT_0;
 45 
    if (x < 0) return R_DT_0;
46 
    if (!R_FINITE(x)) return R_DT_1;
 46 
    if (!R_FINITE(x)) return R_DT_1;
47 
    x = floor(x + 1e-7);
 47 
    x = floor(x + 1e-7);
48 
    return pbeta(prob, size, x + 1, lower_tail, log_p);
 48 
    return pbeta(prob, size, x + 1, lower_tail, log_p);
Line 51... Line 51...
51 
double pnbinom_mu(double x, double size, double mu, int lower_tail, int log_p)
 51 
double pnbinom_mu(double x, double size, double mu, int lower_tail, int log_p)
52 
{
 52 
{
53 
#ifdef IEEE_754
 53 
#ifdef IEEE_754
54 
    if (ISNAN(x) || ISNAN(size) || ISNAN(mu))
 54 
    if (ISNAN(x) || ISNAN(size) || ISNAN(mu))
55 
	return x + size + mu;
 55 
	return x + size + mu;
56 
    if(!R_FINITE(size) || !R_FINITE(mu))	ML_ERR_return_NAN;
 56 
    if(!R_FINITE(mu))	ML_ERR_return_NAN;
57 
#endif
 57 
#endif
58 
    if (size < 0 || mu < 0)	ML_ERR_return_NAN;
 58 
    if (size < 0 || mu < 0)	ML_ERR_return_NAN;
59 
 
 59 
 
60 
    /* limiting case: point mass at zero */
 60 
    /* limiting case: point mass at zero */
61 
    if (size == 0)
61 
    if (size == 0)
62 
        return (x >= 0) ? R_DT_1 : R_DT_0;
62 
        return (x >= 0) ? R_DT_1 : R_DT_0;
63 
 
 63 
 
64 
    if (x < 0) return R_DT_0;
 64 
    if (x < 0) return R_DT_0;
65 
    if (!R_FINITE(x)) return R_DT_1;
 65 
    if (!R_FINITE(x)) return R_DT_1;
- 
 
 66 
    if (!R_FINITE(size)) // limit case: Poisson
- 
 
 67 
	return(ppois(x, mu, lower_tail, log_p));
- 
 
 68 
 
66 
    x = floor(x + 1e-7);
 69 
    x = floor(x + 1e-7);
67 
    /* return
 70 
    /* return
68 
     * pbeta(pr, size, x + 1, lower_tail, log_p);  pr = size/(size + mu), 1-pr = mu/(size+mu)
 71 
     * pbeta(pr, size, x + 1, lower_tail, log_p);  pr = size/(size + mu), 1-pr = mu/(size+mu)
69 
     *
 72 
     *
70 
     *= pbeta_raw(pr, size, x + 1, lower_tail, log_p)
 73 
     *= pbeta_raw(pr, size, x + 1, lower_tail, log_p)