The R Project SVN R

Rev

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

Rev 68947 Rev 70610
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-2015 The R Core Team
 7 
 *	Copyright (C) 2000-2016 The R Core Team
8 
 *
 8 
 *
9 
 *  This program is free software; you can redistribute it and/or modify
 9 
 *  This program is free software; you can redistribute it and/or modify
10 
 *  it under the terms of the GNU General Public License as published by
 10 
 *  it under the terms of the GNU General Public License as published by
11 
 *  the Free Software Foundation; either version 2 of the License, or
 11 
 *  the Free Software Foundation; either version 3 of the License, or
12 
 *  (at your option) any later version.
 12 
 *  (at your option) any later version.
13 
 *
 13 
 *
14 
 *  This program is distributed in the hope that it will be useful,
 14 
 *  This program is distributed in the hope that it will be useful,
15 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 15 
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
16 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 16 
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Line 33... Line 33...
33 
 */
 33 
 */
34 
 
 34 
 
35 
#include "nmath.h"
 35 
#include "nmath.h"
36 
#include "dpq.h"
 36 
#include "dpq.h"
37 
 
 37 
 
- 
 
 38 
// called also from dgamma.c, pgamma.c, dnbeta.c, dnbinom.c, dnchisq.c :
38 
double dpois_raw(double x, double lambda, int give_log)
 39 
double dpois_raw(double x, double lambda, int give_log)
39 
{
 40 
{
40 
    /*       x >= 0 ; integer for dpois(), but not e.g. for pgamma()!
 41 
    /*       x >= 0 ; integer for dpois(), but not e.g. for pgamma()!
41 
        lambda >= 0
 42 
        lambda >= 0
42 
    */
 43 
    */
43 
    if (lambda == 0) return( (x == 0) ? R_D__1 : R_D__0 );
 44 
    if (lambda == 0) return( (x == 0) ? R_D__1 : R_D__0 );
44 
    if (!R_FINITE(lambda)) return R_D__0;
 45 
    if (!R_FINITE(lambda)) return R_D__0; // including for the case where  x = lambda = +Inf
45 
    if (x < 0) return( R_D__0 );
 46 
    if (x < 0) return( R_D__0 );
46 
    if (x <= lambda * DBL_MIN) return(R_D_exp(-lambda) );
 47 
    if (x <= lambda * DBL_MIN) return(R_D_exp(-lambda) );
- 
 
 48 
    if (lambda < x * DBL_MIN) {
- 
 
 49 
	if (!R_FINITE(x)) // lambda < x = +Inf
- 
 
 50 
	    return R_D__0;
- 
 
 51 
	// else
47 
    if (lambda < x * DBL_MIN) return(R_D_exp(-lambda + x*log(lambda) -lgammafn(x+1)));
 52 
	return(R_D_exp(-lambda + x*log(lambda) -lgammafn(x+1)));
- 
 
 53 
    }
48 
    return(R_D_fexp( M_2PI*x, -stirlerr(x)-bd0(x,lambda) ));
 54 
    return(R_D_fexp( M_2PI*x, -stirlerr(x)-bd0(x,lambda) ));
49 
}
 55 
}
50 
 
 56 
 
51 
double dpois(double x, double lambda, int give_log)
 57 
double dpois(double x, double lambda, int give_log)
52 
{
 58 
{