expand unit tests for pt() and correct use of pt() with ncp argument

Author: eddelbuettel

ChangeLog

@@ -1,6 +1,8 @@
 2013-11-22  Dirk Eddelbuettel  <edd@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-11-05  Dirk Eddelbuettel  <edd@debian.org>
 

inst/NEWS.Rd

@@ -2,12 +2,14 @@
 \title{News for Package 'Rcpp'}
 \newcommand{\cpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}}
 
-\section{Changes in Rcpp version 0.10.7 (2013-11-21)}{
+\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.
+      functions were incorrectly expanding to the no-degree-of-freedoms
+      variant.
+      \item Unit tests for \code{pnt} were added.
     }
   }
 }

inst/unitTests/cpp/stats.cpp

@@ -197,11 +197,19 @@ List runit_ppois( NumericVector xx){
 }
 
 // [[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]]

inst/unitTests/runit.stats.R

@@ -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 @@ test.stats.pnorm <- function( ) {
     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.ppois <- function( ) {
 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 @@ test.stats.qt <- function( ) {
     ( 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