[Rcpp-commits] r1928 - in pkg/Rcpp/inst: . include/Rcpp/stats unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 5 23:11:26 CEST 2010
Author: edd
Date: 2010-08-05 23:11:25 +0200 (Thu, 05 Aug 2010)
New Revision: 1928
Modified:
pkg/Rcpp/inst/ChangeLog
pkg/Rcpp/inst/include/Rcpp/stats/t.h
pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
added qt() with a unit test (note that is only qt without the ncp parameter)
Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog 2010-08-05 20:30:16 UTC (rev 1927)
+++ pkg/Rcpp/inst/ChangeLog 2010-08-05 21:11:25 UTC (rev 1928)
@@ -3,27 +3,33 @@
* include/Rcpp/stats/norm.h (Rcpp): Added pnorm and qnorm and
corresponding tests in unitTests/runit.stats.R
+2010-08-05 Dirk Eddelbuettel <deddelbuettel at wtchi-stat-l2.wolve.com>
+
+ * inst/include/Rcpp/stats/norm.h: Added dnorm sugar function
+ * inst/include/Rcpp/stats/t.h: Added dt, pt, qt sugar functions
+ * inst/include/unitTests/runit.stats.R: Added corresponding tests
+
2010-08-05 Romain Francois <romain at r-enthusiasts.com>
- * inst/include/Rcpp/sugar/functions/seq_along.h: added seq(int,int) to
+ * inst/include/Rcpp/sugar/functions/seq_along.h: added seq(int,int) to
mimic the R syntax : seq( 0, 5 )
-
+
* inst/include/Rcpp/sugar/Range.h: fixed compiler confusion
-
+
* inst/include/Rcpp/stats: new sugar functions Rcpp::stats::dpois and
Rcpp::stats::dbinom inspired by Richard Chandler post on Rcpp-devel:
http://lists.r-forge.r-project.org/pipermail/rcpp-devel/2010-August/000940.html
- * inst/include/Rcpp/sugar/sum.h: preliminary version of Rcpp::sum (does not
+ * inst/include/Rcpp/sugar/sum.h: preliminary version of Rcpp::sum (does not
deal with NA properly yet)
-
+
2010-08-04 Romain Francois <romain at r-enthusiasts.com>
* inst/include/Rcpp/sugar/: rework sugar matrix so that operator()(int,int)
is always used instead of operator[](int)
-
- * inst/include/Rcpp/sugar/matrix/outer.h: new implementation based on
- LazyVector, so that the value from the vector expression is only
+
+ * inst/include/Rcpp/sugar/matrix/outer.h: new implementation based on
+ LazyVector, so that the value from the vector expression is only
retrieved once
2010-08-02 Romain Francois <romain at r-enthusiasts.com>
Modified: pkg/Rcpp/inst/include/Rcpp/stats/t.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/stats/t.h 2010-08-05 20:30:16 UTC (rev 1927)
+++ pkg/Rcpp/inst/include/Rcpp/stats/t.h 2010-08-05 21:11:25 UTC (rev 1928)
@@ -29,16 +29,14 @@
namespace impl {
template <bool NA, typename T>
- class DT : public Rcpp::VectorBase< REALSXP, NA, DT<NA,T> >{
+ class DT : public Rcpp::VectorBase< REALSXP, NA, DT<NA,T> > {
public:
typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-
+
DT( const VEC_TYPE& vec_, double df_, bool log_ = false ) :
vec(vec_), df(df_), log(log_) {}
- inline double operator[]( int i) const {
- return ::dt( vec[i], df, log );
- }
+ inline double operator[]( int i) const { return ::dt( vec[i], df, log ); }
inline int size() const { return vec.size(); }
@@ -50,16 +48,14 @@
};
template <bool NA, typename T>
- class PT : public Rcpp::VectorBase< REALSXP, NA, PT<NA,T> >{
+ class PT : public Rcpp::VectorBase< REALSXP, NA, PT<NA,T> > {
public:
typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
-
+
PT( const VEC_TYPE& vec_, double df_, bool lowertail_ = true, bool log_ = false ) :
vec(vec_), df(df_), lowertail(lowertail_), log(log_) {}
- inline double operator[]( int i) const {
- return ::pt( vec[i], df, lowertail, log );
- }
+ inline double operator[]( int i) const { return ::pt( vec[i], df, lowertail, log ); }
inline int size() const { return vec.size(); }
@@ -69,7 +65,26 @@
int lowertail, log;
};
+
+ template <bool NA, typename T>
+ class QT : public Rcpp::VectorBase< REALSXP, NA, QT<NA,T> > {
+ public:
+ typedef typename Rcpp::VectorBase<REALSXP,NA,T> VEC_TYPE;
+
+ QT( const VEC_TYPE& vec_, double df_, bool lowertail_ = true, bool log_ = false ) :
+ vec(vec_), df(df_), lowertail(lowertail_), log(log_) {}
+
+ inline double operator[]( int i) const { return ::qt( vec[i], df, lowertail, log ); }
+
+ inline int size() const { return vec.size(); }
+
+ private:
+ const VEC_TYPE& vec;
+ double df;
+ int lowertail, log;
+ };
+
} // impl
template <bool NA, typename T>
@@ -81,6 +96,11 @@
inline impl::PT<NA,T> pt( const Rcpp::VectorBase<REALSXP,NA,T>& x, double df, bool lowertail = true, bool log = false ) {
return impl::PT<NA,T>( x, df, lowertail, log );
}
+
+template <bool NA, typename T>
+inline impl::QT<NA,T> qt( const Rcpp::VectorBase<REALSXP,NA,T>& x, double df, bool lowertail = true, bool log = false ) {
+ return impl::QT<NA,T>( x, df, lowertail, log );
+}
}
}
Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-05 20:30:16 UTC (rev 1927)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-05 21:11:25 UTC (rev 1928)
@@ -31,8 +31,8 @@
_["true"] = stats::dbinom( xx, 10, .5, true )
) ;
'
- ),
- "runit_dpois" = list(
+ )
+ , "runit_dpois" = list(
signature( x = "integer" ),
'
IntegerVector xx(x) ;
@@ -41,8 +41,8 @@
_["true"] = stats::dpois( xx, .5 , true )
) ;
'
- ),
- "runit_dnorm" = list(
+ )
+ , "runit_dnorm" = list(
signature( x = "numeric" ),
'
NumericVector xx(x) ;
@@ -51,8 +51,8 @@
_["true"] = stats::dnorm( xx, 0.0, 1.0, true )
) ;
'
- ),
- "runit_dt" = list(
+ )
+ , "runit_dt" = list(
signature( x = "numeric" ),
'
NumericVector xx(x) ;
@@ -61,8 +61,8 @@
_["true"] = stats::dt( xx, 5, true )
) ;
'
- ),
- "runit_pt" = list(
+ )
+ , "runit_pt" = list(
signature( x = "numeric" ),
'
NumericVector xx(x) ;
@@ -71,8 +71,8 @@
_["true"] = stats::pt( xx, 5, true, true )
) ;
'
- ),
- "runit_pnorm" = list(
+ )
+ , "runit_pnorm" = list(
signature( x = "numeric" ),
'
NumericVector xx(x) ;
@@ -82,9 +82,9 @@
_["upperNoLog"] = stats::pnorm( xx, 0.0, 1.0, false ),
_["upperLog"] = stats::pnorm( xx, 0.0, 1.0, false, true )
) ;
- '
- ),
- "runit_qnorm_prob" = list(
+ '
+ )
+ , "runit_qnorm_prob" = list(
signature( x = "numeric" ),
'
NumericVector xx(x) ;
@@ -92,19 +92,31 @@
_["lower"] = stats::qnorm( xx, 0.0, 1.0 ),
_["upper"] = stats::qnorm( xx, 0.0, 1.0, false)
) ;
- '
- ),
- ## need a separate test for log prob because different allowable range of x
- "runit_qnorm_log" = list(
- signature( x = "numeric" ),
- '
+ '
+ )
+
+ ## need a separate test for log prob because different allowable range of x
+ , "runit_qnorm_log" = list(
+ signature( x = "numeric" ),
+ '
NumericVector xx(x) ;
return List::create(
_["lower"] = stats::qnorm( xx, 0.0, 1.0, true, true),
_["upper"] = stats::qnorm( xx, 0.0, 1.0, false, true)
) ;
- '
- )
+ '
+ )
+ , "runit_qt" = list(
+ signature( x = "numeric", p = "list" ),
+ '
+ NumericVector xx(x);
+ List pp(p);
+ int df = as<int>(pp["df"]);
+ bool lt = as<bool>(pp["lower"]);
+ bool lg = as<bool>(pp["log"]);
+ return wrap(stats::qt( xx, df, lt, lg));
+ '
+ )
)
@@ -138,21 +150,6 @@
msg = "stats.dnorm" )
}
-test.stats.dt <- function( ) {
- fx <- .rcpp.stats$runit_dt
- v <- seq(0.0, 1.0, by=0.1)
- checkEquals(fx(v),
- list( false = dt(v, 5), true = dt(v, 5, log=TRUE ) ), # NB: need log=TRUE here
- msg = "stats.dt" )
-}
-
-test.stats.pt <- function( ) {
- fx <- .rcpp.stats$runit_pt
- v <- seq(0.0, 1.0, by=0.1)
- checkEquals(fx(v),
- list( false = pt(v, 5), true = pt(v, 5, log=TRUE ) ), # NB: need log=TRUE here
- msg = "stats.pt" )
-}
test.stats.pnorm <- function( ) {
fx <- .rcpp.stats$runit_pnorm
v <- qnorm(seq(0.0, 1.0, by=0.1))
@@ -195,4 +192,33 @@
checkEqualsNumeric(fx(-1e5)$lower, -447.1974945)
}
+test.stats.dt <- function( ) {
+ fx <- .rcpp.stats$runit_dt
+ v <- seq(0.0, 1.0, by=0.1)
+ checkEquals(fx(v),
+ list( false = dt(v, 5), true = dt(v, 5, log=TRUE ) ), # NB: need log=TRUE here
+ msg = "stats.dt" )
+}
+test.stats.pt <- function( ) {
+ fx <- .rcpp.stats$runit_pt
+ v <- seq(0.0, 1.0, by=0.1)
+ checkEquals(fx(v),
+ list( false = pt(v, 5), true = pt(v, 5, log=TRUE ) ), # NB: need log=TRUE here
+ msg = "stats.pt" )
+}
+
+test.stats.qt <- function( ) {
+ fx <- .rcpp.stats$runit_qt
+ v <- seq(0.05, 0.95, by=0.05)
+ checkEquals(fx(v, list(df=5, lower=FALSE, log=FALSE)),
+ qt(v, df=5, lower=FALSE, log=FALSE), msg="stats.qt.f.f")
+ checkEquals(fx(v, list(df=5, lower=TRUE, log=FALSE)),
+ qt(v, df=5, lower=TRUE, log=FALSE), msg="stats.qt.t.f")
+ checkEquals(fx(-v, list(df=5, lower=FALSE, log=TRUE)),
+ qt(-v, df=5, lower=FALSE, log=TRUE), msg="stats.qt.f.t")
+ checkEquals(fx(-v, list(df=5, lower=TRUE, log=TRUE)),
+ qt(-v, df=5, lower=TRUE, log=TRUE), msg="stats.qt.t.t")
+}
+
+
More information about the Rcpp-commits
mailing list