[Rcpp-commits] r1942 - in pkg/Rcpp: . inst/include/Rcpp/stats inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 6 09:51:02 CEST 2010
Author: romain
Date: 2010-08-06 09:51:00 +0200 (Fri, 06 Aug 2010)
New Revision: 1942
Added:
pkg/Rcpp/inst/include/Rcpp/stats/unif.h
Modified:
pkg/Rcpp/DESCRIPTION
pkg/Rcpp/NEWS
pkg/Rcpp/inst/include/Rcpp/stats/stats.h
pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
(dpq)unif generated by the script, TODO: doug style testing
Modified: pkg/Rcpp/DESCRIPTION
===================================================================
--- pkg/Rcpp/DESCRIPTION 2010-08-06 07:31:02 UTC (rev 1941)
+++ pkg/Rcpp/DESCRIPTION 2010-08-06 07:51:00 UTC (rev 1942)
@@ -1,6 +1,6 @@
Package: Rcpp
Title: Seamless R and C++ Integration
-Version: 0.8.5.4
+Version: 0.8.5.5
Date: $Date$
Author: Dirk Eddelbuettel and Romain Francois, with contributions
by Simon Urbanek, David Reiss and Douglas Bates; based on code written during
Modified: pkg/Rcpp/NEWS
===================================================================
--- pkg/Rcpp/NEWS 2010-08-06 07:31:02 UTC (rev 1941)
+++ pkg/Rcpp/NEWS 2010-08-06 07:51:00 UTC (rev 1942)
@@ -1,9 +1,11 @@
0.8.6 (future)
- o various patches to comply with solaris/suncc stricter standards
-
+ o new sugar functions (dpq)(unif|norm|pois|binom|t|beta)
+
o new vignette Rcpp-quickref : quick reference guide of Rcpp API
+ o various patches to comply with solaris/suncc stricter standards
+
0.8.5 2010-07-25
o speed improvements. Vector::names, RObject::slot have been improved
Modified: pkg/Rcpp/inst/include/Rcpp/stats/stats.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/stats.h 2010-08-06 07:31:02 UTC (rev 1941)
+++ pkg/Rcpp/inst/include/Rcpp/stats/stats.h 2010-08-06 07:51:00 UTC (rev 1942)
@@ -22,10 +22,12 @@
#ifndef Rcpp__stats__stats_h
#define Rcpp__stats__stats_h
-#include <Rcpp/stats/binom.h>
+#include <Rcpp/stats/unif.h>
#include <Rcpp/stats/beta.h>
-#include <Rcpp/stats/pois.h>
#include <Rcpp/stats/norm.h>
#include <Rcpp/stats/t.h>
+#include <Rcpp/stats/binom.h>
+#include <Rcpp/stats/pois.h>
+
#endif
Added: pkg/Rcpp/inst/include/Rcpp/stats/unif.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/unif.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/stats/unif.h 2010-08-06 07:51:00 UTC (rev 1942)
@@ -0,0 +1,118 @@
+
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 4 -*-
+//
+// auto generated file (from script/stats.R)
+//
+// unif.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__unif_h
+#define Rcpp__stats__unif_h
+
+namespace Rcpp {
+namespace stats {
+namespace impl {
+
+ template <bool NA, typename T>
+ class DUnif : public Rcpp::VectorBase< REALSXP, NA, DUnif<NA,T> >{
+ public:
+ typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+
+ DUnif( const VEC_TYPE& vec_, double min_ = 0.0, double max_ = 1.0 , bool log_ = false ) :
+ vec(vec_), min(min_), max(max_) , log(log_) {}
+
+ inline double operator[]( int i) const {
+ return ::dunif( vec[i], min, max , log );
+ }
+
+ inline int size() const { return vec.size(); }
+
+ private:
+ const VEC_TYPE& vec;
+ double min; double max;
+ int log;
+
+ };
+
+ template <bool NA, typename T>
+ class PUnif : public Rcpp::VectorBase< REALSXP, NA, PUnif<NA,T> >{
+ public:
+ typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+
+ PUnif( const VEC_TYPE& vec_, double min_ = 0.0, double max_ = 1.0 ,
+ bool lower_tail = true, bool log_ = false ) :
+ vec(vec_), min(min_), max(max_) , lower(lower_tail), log(log_) {}
+
+ inline double operator[]( int i) const {
+ return ::punif( vec[i], min, max, lower, log );
+ }
+
+ inline int size() const { return vec.size(); }
+
+ private:
+ const VEC_TYPE& vec;
+ double min; double max;
+ int lower, log;
+
+ };
+
+ template <bool NA, typename T>
+ class QUnif : public Rcpp::VectorBase< REALSXP, NA, QUnif<NA,T> >{
+ public:
+ typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+
+ QUnif( const VEC_TYPE& vec_, double min_ = 0.0, double max_ = 1.0 ,
+ bool lower_tail = true, bool log_ = false ) :
+ vec(vec_), min(min_), max(max_), lower(lower_tail), log(log_) {}
+
+ inline double operator[]( int i) const {
+ return ::qunif( vec[i], min, max, lower, log );
+ }
+
+ inline int size() const { return vec.size(); }
+
+ private:
+ const VEC_TYPE& vec;
+ double min; double max;
+ int lower, log;
+
+ };
+
+} // impl
+
+template <bool NA, typename T>
+inline impl::DUnif<NA,T> dunif( const Rcpp::VectorBase<REALSXP,NA,T>& x, double min_ = 0.0, double max_ = 1.0, bool log = false ) {
+ return impl::DUnif<NA,T>( x, min_, max_, log );
+}
+
+template <bool NA, typename T>
+inline impl::PUnif<NA,T> punif( const Rcpp::VectorBase<REALSXP,NA,T>& x, double min_ = 0.0, double max_ = 1.0, bool lower = true, bool log = false ) {
+ return impl::PUnif<NA,T>( x, min_, max_, lower, log );
+}
+
+template <bool NA, typename T>
+inline impl::QUnif<NA,T> qunif( const Rcpp::VectorBase<REALSXP,NA,T>& x, double min_ = 0.0, double max_ = 1.0, bool lower = true, bool log = false ) {
+ return impl::QUnif<NA,T>( x, min_, max_, lower, log );
+}
+
+}
+}
+
+#endif
+
Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-06 07:31:02 UTC (rev 1941)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-06 07:51:00 UTC (rev 1942)
@@ -43,7 +43,15 @@
_["true"] = stats::dbinom( xx, 10, .5, true )
) ;
'),
-
+ "runit_dunif" = list(
+ signature( x = "integer" ),
+ '
+ NumericVector xx(x) ;
+ return List::create(
+ _["NoLog"] = stats::dunif( xx, 0, 1),
+ _["Log"] = stats::dunif( xx, 0, 1, true )
+ ) ;
+ '),
"runit_dpois" = list(
signature( x = "integer" ),
'
@@ -115,6 +123,18 @@
) ;
'
),
+ "runit_punif" = list(
+ signature( x = "numeric" ),
+ '
+ NumericVector xx(x) ;
+ return List::create(
+ _["lowerNoLog"] = stats::punif( xx, 0.0, 1.0 ),
+ _["lowerLog"] = stats::punif( xx, 0.0, 1.0, true, true ),
+ _["upperNoLog"] = stats::punif( xx, 0.0, 1.0, false ),
+ _["upperLog"] = stats::punif( xx, 0.0, 1.0, false, true )
+ ) ;
+ '
+ ),
"runit_pnorm" = list(
signature( x = "numeric" ),
'
@@ -171,6 +191,16 @@
_["upper"] = stats::qbinom( xx, 20, 0.5, false)
) ;
'
+ ),
+ "runit_qunif_prob" = list(
+ signature( x = "numeric" ),
+ '
+ NumericVector xx(x) ;
+ return List::create(
+ _["lower"] = stats::qunif( xx, 0.0, 1.0 ),
+ _["upper"] = stats::qunif( xx, 0.0, 1.0, false)
+ ) ;
+ '
)
, "runit_qnorm_prob" = list(
signature( x = "numeric" ),
@@ -257,6 +287,29 @@
## 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))
+ checkEquals(fx(v),
+ list(lowerNoLog = punif(v),
+ lowerLog = punif(v, log=TRUE ),
+ upperNoLog = punif(v, lower=FALSE),
+ upperLog = punif(v, lower=FALSE, log=TRUE)
+ ),
+ msg = "stats.punif" )
+ # TODO: also borrow from R's d-p-q-r-tests.R
+}
+
+test.stats.qunif <- function( ) {
+ fx <- .rcpp.stats$runit_qunif_prob
+ checkEquals(fx(c(0, 1, 1.1, -.1)),
+ list(lower = c(0, 1, NaN, NaN),
+ upper = c(1, 0, NaN, NaN)
+ ),
+ msg = "stats.qunif" )
+ # TODO: also borrow from R's d-p-q-r-tests.R
+}
+
test.stats.qnorm <- function( ) {
fx <- .rcpp.stats$runit_qnorm_prob
checkEquals(fx(c(0, 1, 1.1, -.1)),
@@ -379,3 +432,15 @@
checkEqualsNumeric(fx(x, 0.8, 2)$upperLog, pbval, msg = " stats.pbeta")
checkEqualsNumeric(fx(1-x, 2, 0.8)$lowerLog, pbval, msg = " stats.pbeta")
}
+
+
+test.stats.dunif <- function() {
+ fx <- .rcpp.stats$runit_dunif
+ vv <- seq(0, 1, by = 0.1)
+ checkEquals(fx(vv),
+ list(NoLog = dunif(vv),
+ Log = dunif(vv, log=TRUE)
+ ),
+ msg = " stats.dunif")
+}
+
More information about the Rcpp-commits
mailing list