[Rcpp-commits] r1943 - in pkg/Rcpp/inst: include/Rcpp/stats unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 6 10:11:36 CEST 2010
Author: romain
Date: 2010-08-06 10:11:35 +0200 (Fri, 06 Aug 2010)
New Revision: 1943
Added:
pkg/Rcpp/inst/include/Rcpp/stats/gamma.h
Modified:
pkg/Rcpp/inst/include/Rcpp/stats/stats.h
pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
(dpq)gamma
Added: pkg/Rcpp/inst/include/Rcpp/stats/gamma.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/gamma.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/stats/gamma.h 2010-08-06 08:11:35 UTC (rev 1943)
@@ -0,0 +1,118 @@
+
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 4 -*-
+//
+// auto generated file (from script/stats.R)
+//
+// gamma.h: Rcpp R/C++ interface class library --
+//
+// Copyright (C) 2010 Douglas Bates, Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp__stats__gamma_h
+#define Rcpp__stats__gamma_h
+
+namespace Rcpp {
+namespace stats {
+namespace impl {
+
+ template <bool NA, typename T>
+ class DGamma : public Rcpp::VectorBase< REALSXP, NA, DGamma<NA,T> >{
+ public:
+ typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+
+ DGamma( const VEC_TYPE& vec_, double shape_, double scale_ = 1.0 , bool log_ = false ) :
+ vec(vec_), shape(shape_), scale(scale_) , log(log_) {}
+
+ inline double operator[]( int i) const {
+ return ::dgamma( vec[i], shape, scale , log );
+ }
+
+ inline int size() const { return vec.size(); }
+
+ private:
+ const VEC_TYPE& vec;
+ double shape; double scale;
+ int log;
+
+ };
+
+ template <bool NA, typename T>
+ class PGamma : public Rcpp::VectorBase< REALSXP, NA, PGamma<NA,T> >{
+ public:
+ typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+
+ PGamma( const VEC_TYPE& vec_, double shape_, double scale_ = 1.0 ,
+ bool lower_tail = true, bool log_ = false ) :
+ vec(vec_), shape(shape_), scale(scale_) , lower(lower_tail), log(log_) {}
+
+ inline double operator[]( int i) const {
+ return ::pgamma( vec[i], shape, scale, lower, log );
+ }
+
+ inline int size() const { return vec.size(); }
+
+ private:
+ const VEC_TYPE& vec;
+ double shape; double scale;
+ int lower, log;
+
+ };
+
+ template <bool NA, typename T>
+ class QGamma : public Rcpp::VectorBase< REALSXP, NA, QGamma<NA,T> >{
+ public:
+ typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+
+ QGamma( const VEC_TYPE& vec_, double shape_, double scale_ = 1.0 ,
+ bool lower_tail = true, bool log_ = false ) :
+ vec(vec_), shape(shape_), scale(scale_), lower(lower_tail), log(log_) {}
+
+ inline double operator[]( int i) const {
+ return ::qgamma( vec[i], shape, scale, lower, log );
+ }
+
+ inline int size() const { return vec.size(); }
+
+ private:
+ const VEC_TYPE& vec;
+ double shape; double scale;
+ int lower, log;
+
+ };
+
+} // impl
+
+template <bool NA, typename T>
+inline impl::DGamma<NA,T> dgamma( const Rcpp::VectorBase<REALSXP,NA,T>& x, double shape_, double scale_ = 1.0, bool log = false ) {
+ return impl::DGamma<NA,T>( x, shape_, scale_, log );
+}
+
+template <bool NA, typename T>
+inline impl::PGamma<NA,T> pgamma( const Rcpp::VectorBase<REALSXP,NA,T>& x, double shape_, double scale_ = 1.0, bool lower = true, bool log = false ) {
+ return impl::PGamma<NA,T>( x, shape_, scale_, lower, log );
+}
+
+template <bool NA, typename T>
+inline impl::QGamma<NA,T> qgamma( const Rcpp::VectorBase<REALSXP,NA,T>& x, double shape_, double scale_ = 1.0, bool lower = true, bool log = false ) {
+ return impl::QGamma<NA,T>( x, shape_, scale_, lower, log );
+}
+
+}
+}
+
+#endif
+
Modified: pkg/Rcpp/inst/include/Rcpp/stats/stats.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/stats.h 2010-08-06 07:51:00 UTC (rev 1942)
+++ pkg/Rcpp/inst/include/Rcpp/stats/stats.h 2010-08-06 08:11:35 UTC (rev 1943)
@@ -23,8 +23,9 @@
#define Rcpp__stats__stats_h
#include <Rcpp/stats/unif.h>
+#include <Rcpp/stats/norm.h>
+#include <Rcpp/stats/gamma.h>
#include <Rcpp/stats/beta.h>
-#include <Rcpp/stats/norm.h>
#include <Rcpp/stats/t.h>
#include <Rcpp/stats/binom.h>
Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-06 07:51:00 UTC (rev 1942)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-06 08:11:35 UTC (rev 1943)
@@ -52,7 +52,15 @@
_["Log"] = stats::dunif( xx, 0, 1, true )
) ;
'),
- "runit_dpois" = list(
+ "runit_dgamma" = list( signature( x = "integer" ),
+ '
+ NumericVector xx(x) ;
+ return List::create(
+ _["NoLog"] = stats::dgamma( xx, 1.0, 1.0),
+ _["Log"] = stats::dgamma( xx, 1.0, 1.0, true )
+ ) ;
+ '),
+ "runit_dpois" = list(
signature( x = "integer" ),
'
IntegerVector xx(x) ;
@@ -135,6 +143,18 @@
) ;
'
),
+ "runit_pgamma" = list(
+ signature( x = "numeric" ),
+ '
+ NumericVector xx(x) ;
+ return List::create(
+ _["lowerNoLog"] = stats::pgamma( xx, 2.0, 1.0 ),
+ _["lowerLog"] = stats::pgamma( xx, 2.0, 1.0, true, true ),
+ _["upperNoLog"] = stats::pgamma( xx, 2.0, 1.0, false ),
+ _["upperLog"] = stats::pgamma( xx, 2.0, 1.0, false, true )
+ ) ;
+ '
+ ),
"runit_pnorm" = list(
signature( x = "numeric" ),
'
@@ -267,6 +287,27 @@
msg = "stats.dnorm" )
}
+test.stats.dgamma <- function( ) {
+ fx <- .rcpp.stats$runit_dgamma
+ v <- 1:4
+ checkEquals(fx(v),
+ list( NoLog = dgamma(v, 1.0, 1.0), Log = dgamma(v, 1.0, 1.0, log = TRUE ) ),
+ msg = "stats.dgamma" )
+}
+
+test.stats.pgamma <- function( ) {
+ fx <- .rcpp.stats$runit_pgamma
+ v <- (1:9)/10
+ checkEquals(fx(v),
+ list(lowerNoLog = pgamma(v, shape = 2.0),
+ lowerLog = pgamma(v, shape = 2.0, log=TRUE ),
+ upperNoLog = pgamma(v, shape = 2.0, lower=FALSE),
+ upperLog = pgamma(v, shape = 2.0, lower=FALSE, log=TRUE)
+ ),
+ msg = "stats.pgamma" )
+}
+
+
test.stats.pnorm <- function( ) {
fx <- .rcpp.stats$runit_pnorm
v <- qnorm(seq(0.0, 1.0, by=0.1))
@@ -286,7 +327,7 @@
checkEqualsNumeric(log(pz$lowerNoLog[z.ok]), pz$lowerLog[z.ok], msg = "stats.pnorm")
## FIXME: Add tests that use non-default mu and sigma
}
-
+
test.stats.punif <- function( ) {
fx <- .rcpp.stats$runit_punif
v <- qunif(seq(0.0, 1.0, by=0.1))
@@ -444,3 +485,5 @@
msg = " stats.dunif")
}
+# TODO: test.stats.qgamma
+
More information about the Rcpp-commits
mailing list