[Rcpp-commits] r4594 - in pkg/Rcpp: . inst inst/unitTests inst/unitTests/cpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Nov 22 18:54:53 CET 2013
Author: edd
Date: 2013-11-22 18:54:53 +0100 (Fri, 22 Nov 2013)
New Revision: 4594
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/inst/NEWS.Rd
pkg/Rcpp/inst/unitTests/cpp/stats.cpp
pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
expanded pt() unit tests to cover cases with and without ncp argument
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2013-11-22 13:19:52 UTC (rev 4593)
+++ pkg/Rcpp/ChangeLog 2013-11-22 17:54:53 UTC (rev 4594)
@@ -1,6 +1,8 @@
2013-11-22 Dirk Eddelbuettel <edd at debian.org>
- * inst/include/Rcpp/stats/nt.h: Correct expandion for (d|q|p)nt() function
+ * inst/include/Rcpp/stats/nt.h: Correct expansion of (d|q|p)nt()
+ * inst/unitTests/runit.stats.R: Added unit tests for t dist with ncp
+ * inst/unitTests/cpp/stats.cpp: C++ side of expamded unit tests
2013-10-28 Romain Francois <romain at r-enthusiasts.com>
Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd 2013-11-22 13:19:52 UTC (rev 4593)
+++ pkg/Rcpp/inst/NEWS.Rd 2013-11-22 17:54:53 UTC (rev 4594)
@@ -1,7 +1,19 @@
\name{NEWS}
-\title{News for Package 'Rcpp'}
+sv\title{News for Package 'Rcpp'}
\newcommand{\cpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}}
+\section{Changes in [unreleased] Rcpp version 0.10.7 (2013-11-21)}{
+ \itemize{
+ \item Changes in Rcpp API:
+ \itemize{
+ \item The function \code{dnt}, \code{pnt}, \code{qnt} sugar
+ functions were incorrectly expanding to the no-degree-of-freedoms
+ variant.
+ \item Unit tests for \code{pnt} were added.
+ }
+ }
+}
+
\section{Changes in Rcpp version 0.10.6 (2013-10-27)}{
\itemize{
\item Changes in Rcpp API:
Modified: pkg/Rcpp/inst/unitTests/cpp/stats.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/stats.cpp 2013-11-22 13:19:52 UTC (rev 4593)
+++ pkg/Rcpp/inst/unitTests/cpp/stats.cpp 2013-11-22 17:54:53 UTC (rev 4594)
@@ -197,14 +197,22 @@
}
// [[Rcpp::export]]
-List runit_pt( NumericVector xx ){
- return List::create(
- _["false"] = pt( xx, 5, true),
- _["true"] = pt( xx, 5, true, true )
- );
+List runit_pt(NumericVector xx){
+ return List::create(_["lowerNoLog"] = pt( xx, 5 /*true, false*/),
+ _["lowerLog"] = pt( xx, 5, true, true),
+ _["upperNoLog"] = pt( xx, 5, false /*,false*/),
+ _["upperLog"] = pt( xx, 5, false, true) );
}
// [[Rcpp::export]]
+List runit_pnt(cdNumericVector xx){
+ return List::create(_["lowerNoLog"] = pnt( xx, 5, 7 /*true, false*/),
+ _["lowerLog"] = pnt( xx, 5, 7, true, true),
+ _["upperNoLog"] = pnt( xx, 5, 7, false /*,false*/),
+ _["upperLog"] = pnt( xx, 5, 7, false, true) );
+}
+
+// [[Rcpp::export]]
List runit_qbinom_prob( NumericVector xx, int n, double p){
return List::create(
_["lower"] = qbinom( xx, n, p ),
Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R 2013-11-22 13:19:52 UTC (rev 4593)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R 2013-11-22 17:54:53 UTC (rev 4594)
@@ -22,7 +22,7 @@
if (.runThisTest) {
-.setUp <- Rcpp:::unit_test_setup( "stats.cpp" )
+.setUp <- Rcpp:::unit_test_setup( "stats.cpp" )
test.stats.dbeta <- function() {
vv <- seq(0, 1, by = 0.1)
@@ -225,7 +225,7 @@
checkEqualsNumeric(pz$lowerNoLog, runit_pnorm(-z)$upperNoLog, msg = "stats.pnorm")
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.ppois <- function( ) {
vv <- 0:20
@@ -241,10 +241,23 @@
test.stats.pt <- function( ) {
v <- seq(0.0, 1.0, by=0.1)
checkEquals(runit_pt(v),
- list( false = pt(v, 5), true = pt(v, 5, log=TRUE ) ), # NB: need log=TRUE here
+ list(lowerNoLog = pt(v, 5),
+ lowerLog = pt(v, 5, log=TRUE),
+ upperNoLog = pt(v, 5, lower=FALSE),
+ upperLog = pt(v, 5, lower=FALSE, log=TRUE) ),
msg = "stats.pt" )
}
+test.stats.pnt <- function( ) {
+ v <- seq(0.0, 1.0, by=0.1)
+ checkEquals(runit_pnt(v),
+ list(lowerNoLog = pt(v, 5, ncp=7),
+ lowerLog = pt(v, 5, ncp=7, log=TRUE),
+ upperNoLog = pt(v, 5, ncp=7, lower=FALSE),
+ upperLog = pt(v, 5, ncp=7, lower=FALSE, log=TRUE) ),
+ msg = "stats.pnt" )
+}
+
test.stats.qbinom <- function( ) {
n <- 20
p <- 0.5
@@ -299,19 +312,19 @@
( x1 <- runit_qt(v, 5, FALSE, FALSE) )
( x2 <- qt(v, df=5, lower=FALSE, log=FALSE) )
checkEquals(x1, x2, msg="stats.qt.f.f")
-
+
( x1 <- runit_qt(v, 5, TRUE, FALSE) )
- ( x2 <- qt(v, df=5, lower=TRUE, log=FALSE) )
+ ( x2 <- qt(v, df=5, lower=TRUE, log=FALSE) )
checkEquals(x1, x2, msg="stats.qt.t.f")
-
+
( x1 <- runit_qt(-v, 5, FALSE, TRUE) )
- ( x2 <- qt(-v, df=5, lower=FALSE, log=TRUE) )
+ ( x2 <- qt(-v, df=5, lower=FALSE, log=TRUE) )
checkEquals(x1, x2, msg="stats.qt.f.t")
-
+
( x1 <- runit_qt(-v, 5, TRUE, TRUE) )
- ( x2 <- qt(-v, df=5, lower=TRUE, log=TRUE) )
+ ( x2 <- qt(-v, df=5, lower=TRUE, log=TRUE) )
checkEquals(x1, x2, msg="stats.qt.t.t")
-
+
}
# TODO: test.stats.qgamma
More information about the Rcpp-commits
mailing list