[Rcpp-devel] more on stats functions

Dirk Eddelbuettel edd at debian.org
Thu Dec 9 05:20:20 CET 2010


On 8 December 2010 at 20:54, Christian Gunning wrote:
| On Wed, Dec 8, 2010 at 1:18 AM, Romain Francois
| <romain at r-enthusiasts.com> wrote:
| >
| > It might make sense to get rid of the log = argument and maybe add a ldnorm,
| > or log_dnorm, or dnorm_log instead. so that there is no ambiguity.
| 
| One nice part about the current setup is that R-exts.pdf chapter 6
| serves as a (mostly) definitive guide for arguments and behavior,
| since the Rf_* functions are at the back-end. The only d* example I
| found that didn't work (given that all non-missing scalar arguments
| were doubles) was:
| 
| wrong = cxxfunction(signature(x='numeric'),
|   'NumericVector xx(x) ;
|   return( xx = dunif( xx, true ));',
|   plugin='Rcpp'
| )
| 
| vv <- seq(0, 1, by = 0.1)
| identical(wrong(vv), dunif(vv, log=TRUE))
| 
| >
| > It would be great to recycle this effort of yours into testing. Can you have
| > a look at the runit.stats.R file and add some test cases.
| 
| See attached for patch with some added d* cases.  Patch is relative to
| rcpp/pkg/Rcpp/inst/unitTests.

Cool, thanks!  I'll let Romain tackle it tomorrow as my day is ending here.
 
| Is there a convenient way to run only and all of the tests in
| runit.stats.R?  Other than running *all* the Rcpp unit tests, the best
| I found was doing individual tests with:
| 
| rm(.rcpp.stats)
| rm(.setUp)
| source('~/src/rcpp/pkg/Rcpp/inst/unitTests/runit.stats.R')
| .setUp()
| test.stats.dnorm()

I have a helper script '~/bin/runit.sh' which looks like this:

---------------------------------------------------------------------------------------------------------------
#!/bin/sh

set -u 
set -e

progname=`basename $0`
options='p:h?'
 
usage_and_exit()
{
    echo "Usage: $progname [-p package[,package2,..]] [-?|-h]"
    echo "  Run unit test script for R package"
    echo "Options:"
    echo "  -p package[,package2,..]]  load additional package(s)"
    echo "  -h                         show this help"
    exit 0
}

while getopts "$options" i 
do 
    case "$i" in
	p)
	    pkg=",$OPTARG"
	    shift 
	    shift
	    ;;
	h|?)
	    usage_and_exit
	    ;;
    esac
done

if [ ! -f $1 ]; then
    echo "Error: No file '$1' found"
    exit 1
fi

file=`pwd`/$1

r -i -t -lRUnit${pkg} -e"cppfunction <- function(...) cxxfunction(..., plugin=\"Rcpp\"); runTestFile(\"$file\")"
---------------------------------------------------------------------------------------------------------------

With that I simply do  

   $ ~/bin/runit.sh -p Rcpp,inline inst/unitTests/runit.stats.R

as shown below.

Hth,  Dirk


edd at max:~/svn/rcpp/pkg/Rcpp$ ~/bin/runit.sh -p Rcpp,inline inst/unitTests/runit.stats.R 


Executing test function test.stats.dbeta  ...  done successfully.



Executing test function test.stats.dbinom  ...  done successfully.



Executing test function test.stats.dgamma  ...  done successfully.



Executing test function test.stats.dnorm  ...  done successfully.



Executing test function test.stats.dpois  ...  done successfully.



Executing test function test.stats.dt  ...  done successfully.



Executing test function test.stats.dunif  ...  done successfully.



Executing test function test.stats.pbeta  ...  done successfully.



Executing test function test.stats.pbinom  ...  done successfully.



Executing test function test.stats.pgamma  ...  done successfully.



Executing test function test.stats.pnorm  ...  done successfully.



Executing test function test.stats.ppois  ...  done successfully.



Executing test function test.stats.pt  ...  done successfully.



Executing test function test.stats.punif  ...  done successfully.



Executing test function test.stats.qbinom  ...  done successfully.



Executing test function test.stats.qnorm  ...  done successfully.



Executing test function test.stats.qpois.prob  ...  done successfully.



Executing test function test.stats.qt  ...  done successfully.



Executing test function test.stats.qunif  ...  done successfully.

edd at max:~/svn/rcpp/pkg/Rcpp$ 


| best,
| xian
| -- 
| A man, a plan, a cat, a ham, a yak, a yam, a hat, a canal – Panama!
| 
| ----------------------------------------------------------------------
| Index: runit.stats.R
| ===================================================================
| --- runit.stats.R	(revision 2747)
| +++ runit.stats.R	(working copy)
| @@ -47,8 +47,14 @@
|  				  signature( x = "numeric" ),
|  				  '
|  				  NumericVector xx(x) ;
| -				  return List::create(_["NoLog"] = dunif( xx, 0.0 , 1.0 ),
| -									  _["Log"]	= dunif( xx, 0.0, 1.0 , true ));
| +				  return List::create(
| +                                      _["NoLog_noMin_noMax"] = dunif( xx ),
| +                                      _["NoLog_noMax"] = dunif( xx, 0.0 ),
| +                                      _["NoLog"] = dunif( xx, 0.0 , 1.0 ),
| +									  _["Log"]	= dunif( xx, 0.0, 1.0 , true ),
| +									  _["Log_noMax"]	= dunif( xx, 0.0, true )
| +                                    //,_["Log_noMin_noMax"]	= dunif( xx, true )
| +                  );
|  				  ')
|  
|  				  ,
| @@ -56,7 +62,9 @@
|  				  '
|  				  NumericVector xx(x) ;
|  				  return List::create(_["NoLog"] = dgamma( xx, 1.0, 1.0),
| -									  _["Log"]	 = dgamma( xx, 1.0, 1.0, true ));
| +									  _["Log"]	 = dgamma( xx, 1.0, 1.0, true ),
| +									  _["Log_noRate"]	 = dgamma( xx, 1.0, true )
| +                  );
|  				  ')
|  
|  				  ,
| @@ -73,8 +81,13 @@
|  				  signature( x = "numeric" ),
|  				  '
|  				  NumericVector xx(x) ;
| -				  return List::create(_["false"] = dnorm( xx, 0.0, 1.0 ),
| -									  _["true"]	 = dnorm( xx, 0.0, 1.0, true ));
| +				  return List::create(
| +                                      _["false_noMean_noSd"] = dnorm( xx ),
| +                                      _["false_noSd"] = dnorm( xx, 0.0  ),
| +                                      _["false"] = dnorm( xx, 0.0, 1.0 ),
| +									  _["true"]	 = dnorm( xx, 0.0, 1.0, true ),
| +									  _["true_noSd"]	 = dnorm( xx, 0.0, true ),
| +									  _["true_noMean_noSd"]	 = dnorm( xx, true ));
|  				  ')
|  
|  				  ,
| @@ -240,7 +253,8 @@
|      vv <- seq(0, 1, by = 0.1)
|      a <- 0.5; b <- 2.5
|      checkEquals(fx(vv, a, b),
| -                list(NoLog = dbeta(vv, a, b),
| +                list(
| +                     NoLog = dbeta(vv, a, b),
|                       Log   = dbeta(vv, a, b, log=TRUE)
|                       ),
|                  msg = " stats.qbeta")
| @@ -248,17 +262,25 @@
|  
|  test.stats.dbinom <- function( ){
|  	fx <- .rcpp.stats$runit_dbinom
| -	checkEquals(fx(1:10) ,
| -                list( false = dbinom(1:10, 10, .5), true = dbinom(1:10, 10, .5, TRUE ) ),
| -                msg = "stats.dbinom" )
| +    v <- 1:10
| +	checkEquals(fx(v) ,
| +                list( 
| +                    false = dbinom(v, 10, .5), 
| +                    true = dbinom(v, 10, .5, TRUE ) 
| +                ), msg = "stats.dbinom" )
|  }
|  
|  test.stats.dunif <- function() {
|      fx <- .rcpp.stats$runit_dunif
|      vv <- seq(0, 1, by = 0.1)
|      checkEquals(fx(vv),
| -                list(NoLog = dunif(vv),
| -                     Log   = dunif(vv, log=TRUE)
| +                list(
| +                    NoLog_noMin_noMax = dunif(vv),
| +                    NoLog_noMax = dunif(vv, 0),
| +                    NoLog = dunif(vv, 0, 1),
| +                     Log   = dunif(vv, 0, 1, log=TRUE),
| +                     Log_noMax   = dunif(vv, 0, log=TRUE)
| +                     #,Log_noMin_noMax   = dunif(vv, log=TRUE)  ## wrong answer
|                       ),
|                  msg = " stats.dunif")
|  }
| @@ -267,32 +289,42 @@
|      fx <- .rcpp.stats$runit_dgamma
|      v <- 1:4
|      checkEquals(fx(v),
| -                list( NoLog = dgamma(v, 1.0, 1.0), Log = dgamma(v, 1.0, 1.0, log = TRUE ) ),
| -                msg = "stats.dgamma" )
| +                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 ) 
| +                ), msg = "stats.dgamma" )
|  }
|  
|  
|  test.stats.dpois <- function( ){
|  	fx <- .rcpp.stats$runit_dpois
| -	checkEquals(fx(0:5) ,
| -                list( false = dpois(0:5, .5), true = dpois(0:5, .5, TRUE ) ),
| -                msg = "stats.dpois" )
| +    v <- 0:5
| +	checkEquals(fx(v) ,
| +                list( false = dpois(v, .5), 
| +                      true = dpois(v, .5, TRUE ) 
| +                ), msg = "stats.dpois" )
|  }
|  
|  test.stats.dnorm <- function( ) {
|      fx <- .rcpp.stats$runit_dnorm
|      v <- seq(0.0, 1.0, by=0.1)
|      checkEquals(fx(v),
| -                list( false = dnorm(v, 0.0, 1.0), true = dnorm(v, 0.0, 1.0, TRUE ) ),
| -                msg = "stats.dnorm" )
| +                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 ) 
| +                ), 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" )
| +                list( false = dt(v, 5), 
| +                      true = dt(v, 5, log=TRUE ) # NB: need log=TRUE here
| +                ), msg = "stats.dt" )
|  }
|  
|  test.stats.pbeta <- function( ) {
| 
| ----------------------------------------------------------------------
| _______________________________________________
| Rcpp-devel mailing list
| Rcpp-devel at lists.r-forge.r-project.org
| https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-devel

-- 
Dirk Eddelbuettel | edd at debian.org | http://dirk.eddelbuettel.com


More information about the Rcpp-devel mailing list