|
Rcpp Version 0.9.10
|
00001 00002 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 4 -*- 00003 // 00004 // auto generated file (from script/stats.R) 00005 // 00006 // gamma.h: Rcpp R/C++ interface class library -- 00007 // 00008 // Copyright (C) 2010 - 2011 Douglas Bates, Dirk Eddelbuettel and Romain Francois 00009 // 00010 // This file is part of Rcpp. 00011 // 00012 // Rcpp is free software: you can redistribute it and/or modify it 00013 // under the terms of the GNU General Public License as published by 00014 // the Free Software Foundation, either version 2 of the License, or 00015 // (at your option) any later version. 00016 // 00017 // Rcpp is distributed in the hope that it will be useful, but 00018 // WITHOUT ANY WARRANTY; without even the implied warranty of 00019 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00020 // GNU General Public License for more details. 00021 // 00022 // You should have received a copy of the GNU General Public License 00023 // along with Rcpp. If not, see <http://www.gnu.org/licenses/>. 00024 00025 #ifndef Rcpp__stats__gamma_h 00026 #define Rcpp__stats__gamma_h 00027 00028 namespace Rcpp { 00029 namespace stats { 00030 00031 inline double dgamma_1(double x, double shape, int log_p){ 00032 double pr; 00033 #ifdef IEEE_754 00034 if (ISNAN(x) || ISNAN(shape) ) 00035 return x + shape + 1.0 ; 00036 #endif 00037 if (shape < 0) return R_NaN ; 00038 if (x < 0) 00039 return R_D__0; 00040 if (shape == 0) /* point mass at 0 */ 00041 return (x == 0)? ML_POSINF : R_D__0; 00042 if (x == 0) { 00043 if (shape < 1) return ML_POSINF; 00044 if (shape > 1) return R_D__0; 00045 /* else */ 00046 return log_p ? 0.0 : 1.0 ; 00047 } 00048 00049 if (shape < 1) { 00050 pr = ::Rf_dpois(shape, x, log_p); 00051 return log_p ? pr + ::log(shape/x) : pr*shape/x; 00052 } 00053 /* else shape >= 1 */ 00054 pr = ::Rf_dpois(shape-1, x, log_p); 00055 return pr; 00056 } 00057 inline double pgamma_1(double x, double alph, int lower_tail, int log_p){ 00058 return ::Rf_pgamma(x, alph, 1.0, lower_tail, log_p) ; 00059 } 00060 inline double qgamma_1(double p, double alpha, int lower_tail, int log_p){ 00061 return ::Rf_qgamma(p, alpha, 1.0, lower_tail, log_p ); 00062 } 00063 00064 } 00065 } 00066 00067 // 1 parameter case (scale = 1) 00068 RCPP_DPQ_1(gamma,Rcpp::stats::dgamma_1,Rcpp::stats::pgamma_1, Rcpp::stats::qgamma_1) 00069 00070 00071 // 2 parameter case 00072 RCPP_DPQ_2(gamma,::Rf_dgamma,::Rf_pgamma,::Rf_qgamma) 00073 00074 00075 #endif 00076