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 76836
Line 2... Line 2...
2 
 *  AUTHOR
 2 
 *  AUTHOR
3 
 *    Catherine Loader, catherine@research.bell-labs.com.
 3 
 *    Catherine Loader, catherine@research.bell-labs.com.
4 
 *    October 23, 2000.
 4 
 *    October 23, 2000.
5 
 *
 5 
 *
6 
 *  Merge in to R:
 6 
 *  Merge in to R:
7 
 *	Copyright (C) 2000 The R Core Team
 7 
 *	Copyright (C) 2000-2019 The R Core Team
8 
 *	Copyright (C) 2004 The R Foundation
 8 
 *	Copyright (C) 2004-2019 The R Foundation
9 
 *
 9 
 *
10 
 *  This program is free software; you can redistribute it and/or modify
 10 
 *  This program is free software; you can redistribute it and/or modify
11 
 *  it under the terms of the GNU General Public License as published by
 11 
 *  it under the terms of the GNU General Public License as published by
12 
 *  the Free Software Foundation; either version 2 of the License, or
 12 
 *  the Free Software Foundation; either version 2 of the License, or
13 
 *  (at your option) any later version.
 13 
 *  (at your option) any later version.
Line 28... Line 28...
28 
 *
 28 
 *
29 
 *                   1/s (x/s)^{a-1} exp(-x/s)
 29 
 *                   1/s (x/s)^{a-1} exp(-x/s)
30 
 *        p(x;a,s) = -----------------------
 30 
 *        p(x;a,s) = -----------------------
31 
 *                            (a-1)!
 31 
 *                            (a-1)!
32 
 *
 32 
 *
33 
 *   where `s' is the scale (= 1/lambda in other parametrizations)
 33 
 *   where 's' is the scale (= 1/lambda in other parametrizations)
34 
 *     and `a' is the shape parameter ( = alpha in other contexts).
 34 
 *     and 'a' is the shape parameter ( = alpha in other contexts).
35 
 *
 35 
 *
36 
 * The old (R 1.1.1) version of the code is available via `#define D_non_pois'
 36 
 * The old (R 1.1.1) version of the code is available via '#define D_non_pois'
37 
 */
 37 
 */
38 
 
 38 
 
39 
#include "nmath.h"
 39 
#include "nmath.h"
40 
#include "dpq.h"
 40 
#include "dpq.h"
41 
 
 41 
 
Line 58... Line 58...
58 
	return give_log ? -log(scale) : 1 / scale;
 58 
	return give_log ? -log(scale) : 1 / scale;
59 
    }
 59 
    }
60 
 
 60 
 
61 
    if (shape < 1) {
 61 
    if (shape < 1) {
62 
	pr = dpois_raw(shape, x/scale, give_log);
 62 
	pr = dpois_raw(shape, x/scale, give_log);
- 
 
 63 
	return (
63 
	return give_log ?  pr + log(shape/x) : pr*shape/x;
 64 
	    give_log/* NB: currently *always*  shape/x > 0  if shape < 1:
- 
 
 65 
		     * -- overflow to Inf happens, but underflow to 0 does NOT : */
- 
 
 66 
	    ? pr + (R_FINITE(shape/x)
- 
 
 67 
		    ? log(shape/x)
- 
 
 68 
		    : /* shape/x overflows to +Inf */ log(shape) - log(x))
- 
 
 69 
	    : pr*shape / x);
64 
    }
 70 
    }
65 
    /* else  shape >= 1 */
 71 
    /* else  shape >= 1 */
66 
    pr = dpois_raw(shape-1, x/scale, give_log);
 72 
    pr = dpois_raw(shape-1, x/scale, give_log);
67 
    return give_log ? pr - log(scale) : pr/scale;
 73 
    return give_log ? pr - log(scale) : pr/scale;
68 
}
 74 
}