[Rcpp-commits] r3341 - in pkg/Rcpp: . inst inst/unitTests

[noreply at r-forge.r-project.org]

Author: edd
Date: 2011-11-13 19:45:37 +0100 (Sun, 13 Nov 2011)
New Revision: 3341

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/NEWS
   pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
quick new unit tests for pnf() in response to rcpp-devel yesterday


Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2011-11-13 02:07:44 UTC (rev 3340)
+++ pkg/Rcpp/ChangeLog	2011-11-13 18:45:37 UTC (rev 3341)
@@ -1,3 +1,7 @@
+2011-11-13  Dirk Eddelbuettel  <edd at debian.org>
+
+	* inst/unitTests/runit.stats.R: Add unit test for pnf() 
+
 2011-11-07  Romain Francois  <romain at r-enthusiasts.com>
 
 	* include/Rcpp/internal/wrap.h: implemented wrap_dispatch_importer__impl

Modified: pkg/Rcpp/inst/NEWS
===================================================================
--- pkg/Rcpp/inst/NEWS	2011-11-13 02:07:44 UTC (rev 3340)
+++ pkg/Rcpp/inst/NEWS	2011-11-13 18:45:37 UTC (rev 3341)
@@ -8,6 +8,8 @@
         of them. This work has been sponsored by the Google Open Source
         Programs Office. 
 
+    o   New unit test for pnf() (ie prob. function of a non-central F dist.)
+
 0.9.7   2011-09-29
 
     o   Applied two patches kindly provided by Martyn Plummer which provide

Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R	2011-11-13 02:07:44 UTC (rev 3340)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R	2011-11-13 18:45:37 UTC (rev 3341)
@@ -1,7 +1,7 @@
 #!/usr/bin/r -t
 # -*- mode: R; tab-width: 4 -*-
 #
-# Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2011	Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -144,6 +144,17 @@
 				  ')
 
 				  ,
+				  "runit_pnf" = list(
+				  signature( x = "numeric" ),
+				  '
+				  NumericVector xx(x) ;
+				  return List::create(_["lowerNoLog"] = pnf( xx, 6.0, 8.0, 0.0, true ),
+									  _["lowerLog"]	  = pnf( xx, 6.0, 8.0, 0.0, true, true ),
+									  _["upperNoLog"] = pnf( xx, 6.0, 8.0, 0.0, false ),
+									  _["upperLog"]	  = pnf( xx, 6.0, 8.0, 0.0, false, true ));
+				  ')
+
+				  ,
 				  "runit_pnorm" = list(signature( x = "numeric" ),
 				  '
 				  NumericVector xx(x) ;
@@ -240,7 +251,7 @@
 
 .setUp <- function(){
 	if( ! exists( ".rcpp.stats", globalenv() ) ){
-		fun <- Rcpp:::compile_unit_tests( 
+		fun <- Rcpp:::compile_unit_tests(
 		    definitions()
 		)
 	    assign( ".rcpp.stats", fun, globalenv() )
@@ -263,9 +274,9 @@
 	fx <- .rcpp.stats$runit_dbinom
     v <- 1:10
 	checkEquals(fx(v) ,
-                list( 
-                    false = dbinom(v, 10, .5), 
-                    true = dbinom(v, 10, .5, TRUE ) 
+                list(
+                    false = dbinom(v, 10, .5),
+                    true = dbinom(v, 10, .5, TRUE )
                 ), msg = "stats.dbinom" )
 }
 
@@ -288,9 +299,9 @@
     fx <- .rcpp.stats$runit_dgamma
     v <- 1:4
     checkEquals(fx(v),
-                list( NoLog = dgamma(v, 1.0, 1.0), 
+                list( NoLog = dgamma(v, 1.0, 1.0),
                       Log = dgamma(v, 1.0, 1.0, log = TRUE ),
-                      Log_noRate = dgamma(v, 1.0, log = TRUE ) 
+                      Log_noRate = dgamma(v, 1.0, log = TRUE )
                 ), msg = "stats.dgamma" )
 }
 
@@ -299,8 +310,8 @@
 	fx <- .rcpp.stats$runit_dpois
     v <- 0:5
 	checkEquals(fx(v) ,
-                list( false = dpois(v, .5), 
-                      true = dpois(v, .5, TRUE ) 
+                list( false = dpois(v, .5),
+                      true = dpois(v, .5, TRUE )
                 ), msg = "stats.dpois" )
 }
 
@@ -308,12 +319,12 @@
     fx <- .rcpp.stats$runit_dnorm
     v <- seq(0.0, 1.0, by=0.1)
     checkEquals(fx(v),
-                list( false_noMean_noSd = dnorm(v), 
-                      false_noSd = dnorm(v, 0.0), 
-                      false = dnorm(v, 0.0, 1.0), 
+                list( false_noMean_noSd = dnorm(v),
+                      false_noSd = dnorm(v, 0.0),
+                      false = dnorm(v, 0.0, 1.0),
                       true = dnorm(v, 0.0, 1.0, log=TRUE ),
                       true_noSd = dnorm(v, 0.0, log=TRUE ),
-                      true_noMean_noSd = dnorm(v, log=TRUE ) 
+                      true_noMean_noSd = dnorm(v, log=TRUE )
                 ), msg = "stats.dnorm" )
 }
 
@@ -321,7 +332,7 @@
 	fx <- .rcpp.stats$runit_dt
     v <- seq(0.0, 1.0, by=0.1)
     checkEquals(fx(v),
-                list( false = dt(v, 5), 
+                list( false = dt(v, 5),
                       true = dt(v, 5, log=TRUE ) # NB: need log=TRUE here
                 ), msg = "stats.dt" )
 }
@@ -372,6 +383,18 @@
     # TODO: also borrow from R's d-p-q-r-tests.R
 }
 
+test.stats.pnf <- function( ) {
+    fx <- .rcpp.stats$runit_pnf
+    v <- (1:9)/10
+    checkEquals(fx(v),
+                list(lowerNoLog = pf(v, 6, 8, lower=TRUE, log=FALSE),
+                     lowerLog   = pf(v, 6, 8, log=TRUE ),
+                     upperNoLog = pf(v, 6, 8, lower=FALSE),
+                     upperLog   = pf(v, 6, 8, lower=FALSE, log=TRUE)
+                     ),
+                msg = "stats.pf" )
+}
+
 test.stats.pgamma <- function( ) {
     fx <- .rcpp.stats$runit_pgamma
     v <- (1:9)/10