[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