[Rcpp-commits] r3888 - in pkg/Rcpp: . inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 3 01:19:12 CET 2012
Author: edd
Date: 2012-11-03 01:19:12 +0100 (Sat, 03 Nov 2012)
New Revision: 3888
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/inst/unitTests/runTests.R
pkg/Rcpp/inst/unitTests/runit.DataFrame.R
pkg/Rcpp/inst/unitTests/runit.Date.R
pkg/Rcpp/inst/unitTests/runit.Function.R
pkg/Rcpp/inst/unitTests/runit.RObject.R
pkg/Rcpp/inst/unitTests/runit.rmath.R
pkg/Rcpp/inst/unitTests/runit.stats.R
pkg/Rcpp/inst/unitTests/runit.sugarOps.R
Log:
more Rmath unit tests, some minor edits in emacs headers for unit test files
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2012-11-02 18:36:44 UTC (rev 3887)
+++ pkg/Rcpp/ChangeLog 2012-11-03 00:19:12 UTC (rev 3888)
@@ -1,12 +1,17 @@
+2012-11-02 Dirk Eddelbuettel <edd at debian.org>
+
+ * inst/unitTests/runit.rmath.R: More tests added
+
2012-11-02 Romain Francois <romain at r-enthusiasts.com>
- * include/Rcpp/module/CppFunction.h : factored CppFunction in its own file
- and added the get_function_ptr virtual method. added documentation
- * include/Rcpp/module/Module_generated_CppFunction.h: implementation
- of get_function_ptr in classes that derive CppFunction
+ * include/Rcpp/module/CppFunction.h : factored CppFunction in its own
+ file and added the get_function_ptr virtual method. added
+ documentation
+ * include/Rcpp/module/Module_generated_CppFunction.h: implementation
+ of get_function_ptr in classes that derive CppFunction
* src/Module.cpp: s/get_function_ptr/get_function/
- * include/Rcpp/module/Module.h : factored out and documented.
- s/get_function_ptr/get_function/
+ * include/Rcpp/module/Module.h : factored out and documented.
+ s/get_function_ptr/get_function/
2012-11-01 Dirk Eddelbuettel <edd at debian.org>
Modified: pkg/Rcpp/inst/unitTests/runTests.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runTests.R 2012-11-02 18:36:44 UTC (rev 3887)
+++ pkg/Rcpp/inst/unitTests/runTests.R 2012-11-03 00:19:12 UTC (rev 3888)
@@ -1,4 +1,4 @@
-## -*- mode: R; tab-width: 4 -*-
+## -*- mode: R; tab-width: 4; -*-
##
## Copyright (C) 2009 - 2012 Dirk Eddelbuettel and Romain Francois
##
Modified: pkg/Rcpp/inst/unitTests/runit.DataFrame.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.DataFrame.R 2012-11-02 18:36:44 UTC (rev 3887)
+++ pkg/Rcpp/inst/unitTests/runit.DataFrame.R 2012-11-03 00:19:12 UTC (rev 3888)
@@ -1,5 +1,5 @@
#!/usr/bin/r -t
-# -*- mode: R; tab-width: 4 -*-
+# -*- mode: R; tab-width: 4; -*-
#
# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
#
@@ -84,7 +84,7 @@
_["stringsAsFactors"] = false ); ')
)
-
+
}
.setUp <- function(){
Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R 2012-11-02 18:36:44 UTC (rev 3887)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R 2012-11-03 00:19:12 UTC (rev 3888)
@@ -1,5 +1,5 @@
#!/usr/bin/r -t
-# -*- mode: R; tab-width: 4 -*-
+# -*- mode: R; tab-width: 4; -*-
#
# Copyright (C) 2010, 2012 Dirk Eddelbuettel and Romain Francois
#
Modified: pkg/Rcpp/inst/unitTests/runit.Function.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Function.R 2012-11-02 18:36:44 UTC (rev 3887)
+++ pkg/Rcpp/inst/unitTests/runit.Function.R 2012-11-03 00:19:12 UTC (rev 3888)
@@ -1,5 +1,5 @@
#!/usr/bin/r -t
-# -*- mode: R; tab-width: 4 -*-
+# -*- mode: R; tab-width: 4; -*-
#
# Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
#
Modified: pkg/Rcpp/inst/unitTests/runit.RObject.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RObject.R 2012-11-02 18:36:44 UTC (rev 3887)
+++ pkg/Rcpp/inst/unitTests/runit.RObject.R 2012-11-03 00:19:12 UTC (rev 3888)
@@ -1,5 +1,5 @@
#!/usr/bin/r -t
-# -*- mode: R; tab-width: 4 -*-
+# -*- mode: R; tab-width: 4; -*-
#
# Copyright (C) 2009 - 2010 Romain Francois and Dirk Eddelbuettel
#
@@ -162,7 +162,7 @@
tests <- ".Rcpp.RObject"
if( ! exists(tests, globalenv() )) {
fun <- Rcpp:::compile_unit_tests(
- definitions(),
+ definitions(),
cxxargs = cxxargs()
)
assign( tests, fun, globalenv() )
Modified: pkg/Rcpp/inst/unitTests/runit.rmath.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.rmath.R 2012-11-02 18:36:44 UTC (rev 3887)
+++ pkg/Rcpp/inst/unitTests/runit.rmath.R 2012-11-03 00:19:12 UTC (rev 3888)
@@ -26,12 +26,10 @@
list("runit_dnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::dnorm(x, a, b, 0), R::dnorm(x, a, b, 1));')
-
,"runit_pnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
return NumericVector::create(R::pnorm(x, a, b, 1, 0), R::pnorm(log(x), a, b, 1, 1),
R::pnorm(x, a, b, 0, 0), R::pnorm(log(x), a, b, 0, 1));')
-
,"runit_qnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::qnorm(x, a, b, 1, 0), R::qnorm(log(x), a, b, 1, 1),
@@ -41,12 +39,10 @@
,"runit_dunif" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::dunif(x, a, b, 0), R::dunif(x, a, b, 1));')
-
,"runit_punif" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
return NumericVector::create(R::punif(x, a, b, 1, 0), R::punif(log(x), a, b, 1, 1),
R::punif(x, a, b, 0, 0), R::punif(log(x), a, b, 0, 1));')
-
,"runit_qunif" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::qunif(x, a, b, 1, 0), R::qunif(log(x), a, b, 1, 1),
@@ -56,12 +52,10 @@
,"runit_dgamma" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::dgamma(x, a, b, 0), R::dgamma(x, a, b, 1));')
-
,"runit_pgamma" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
return NumericVector::create(R::pgamma(x, a, b, 1, 0), R::pgamma(log(x), a, b, 1, 1),
R::pgamma(x, a, b, 0, 0), R::pgamma(log(x), a, b, 0, 1));')
-
,"runit_qgamma" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::qgamma(x, a, b, 1, 0), R::qgamma(log(x), a, b, 1, 1),
@@ -71,12 +65,10 @@
,"runit_dbeta" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::dbeta(x, a, b, 0), R::dbeta(x, a, b, 1));')
-
,"runit_pbeta" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
return NumericVector::create(R::pbeta(x, a, b, 1, 0), R::pbeta(log(x), a, b, 1, 1),
R::pbeta(x, a, b, 0, 0), R::pbeta(log(x), a, b, 0, 1));')
-
,"runit_qbeta" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::qbeta(x, a, b, 1, 0), R::qbeta(log(x), a, b, 1, 1),
@@ -86,18 +78,79 @@
,"runit_dlnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::dlnorm(x, a, b, 0), R::dlnorm(x, a, b, 1));')
-
,"runit_plnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
return NumericVector::create(R::plnorm(x, a, b, 1, 0), R::plnorm(log(x), a, b, 1, 1),
R::plnorm(x, a, b, 0, 0), R::plnorm(log(x), a, b, 0, 1));')
-
,"runit_qlnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
return NumericVector::create(R::qlnorm(x, a, b, 1, 0), R::qlnorm(log(x), a, b, 1, 1),
R::qlnorm(x, a, b, 0, 0), R::qlnorm(log(x), a, b, 0, 1));')
+ ,"runit_dchisq" = list(signature(x_ = "double", a_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_);
+ return NumericVector::create(R::dchisq(x, a, 0), R::dchisq(x, a, 1));')
+ ,"runit_pchisq" = list(signature(x_ = "double", a_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_);
+ return NumericVector::create(R::pchisq(x, a, 1, 0), R::pchisq(log(x), a, 1, 1),
+ R::pchisq(x, a, 0, 0), R::pchisq(log(x), a, 0, 1));')
+ ,"runit_qchisq" = list(signature(x_ = "double", a_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_);
+ return NumericVector::create(R::qchisq(x, a, 1, 0), R::qchisq(log(x), a, 1, 1),
+ R::qchisq(x, a, 0, 0), R::qchisq(log(x), a, 0, 1));')
+
+
+ ,"runit_dnchisq" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
+ return NumericVector::create(R::dnchisq(x, a, b, 0), R::dnchisq(x, a, b, 1));')
+ ,"runit_pnchisq" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
+ return NumericVector::create(R::pnchisq(x, a, b, 1, 0), R::pnchisq(log(x), a, b, 1, 1),
+ R::pnchisq(x, a, b, 0, 0), R::pnchisq(log(x), a, b, 0, 1));')
+ ,"runit_qnchisq" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
+ return NumericVector::create(R::qnchisq(x, a, b, 1, 0), R::qnchisq(log(x), a, b, 1, 1),
+ R::qnchisq(x, a, b, 0, 0), R::qnchisq(log(x), a, b, 0, 1));')
+
+
+ ,"runit_df" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
+ return NumericVector::create(R::df(x, a, b, 0), R::df(x, a, b, 1));')
+ ,"runit_pf" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
+ return NumericVector::create(R::pf(x, a, b, 1, 0), R::pf(log(x), a, b, 1, 1),
+ R::pf(x, a, b, 0, 0), R::pf(log(x), a, b, 0, 1));')
+ ,"runit_qf" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
+ return NumericVector::create(R::qf(x, a, b, 1, 0), R::qf(log(x), a, b, 1, 1),
+ R::qf(x, a, b, 0, 0), R::qf(log(x), a, b, 0, 1));')
+
+
+ ,"runit_dt" = list(signature(x_ = "double", a_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_);
+ return NumericVector::create(R::dt(x, a, 0), R::dt(x, a, 1));')
+ ,"runit_pt" = list(signature(x_ = "double", a_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_);
+ return NumericVector::create(R::pt(x, a, 1, 0), R::pt(log(x), a, 1, 1),
+ R::pt(x, a, 0, 0), R::pt(log(x), a, 0, 1));')
+ ,"runit_qt" = list(signature(x_ = "double", a_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_);
+ return NumericVector::create(R::qt(x, a, 1, 0), R::qt(log(x), a, 1, 1),
+ R::qt(x, a, 0, 0), R::qt(log(x), a, 0, 1));')
+
+ ,"runit_dbinom" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
+ return NumericVector::create(R::dbinom(x, a, b, 0), R::dbinom(x, a, b, 1));')
+ ,"runit_pbinom" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
+ return NumericVector::create(R::pbinom(x, a, b, 1, 0), R::pbinom(log(x), a, b, 1, 1),
+ R::pbinom(x, a, b, 0, 0), R::pbinom(log(x), a, b, 0, 1));')
+ ,"runit_qbinom" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
+ double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
+ return NumericVector::create(R::qbinom(x, a, b, 1, 0), R::qbinom(log(x), a, b, 1, 1),
+ R::qbinom(x, a, b, 0, 0), R::qbinom(log(x), a, b, 0, 1));')
+
)
}
@@ -219,4 +272,121 @@
msg = " rmath.qlnorm")
}
+
+test.rmath.chisq <- function() {
+ x <- 0.25
+ a <- 0.8
+ f <- .rcpp.rmath$runit_dchisq
+ checkEquals(f(x, a),
+ c(dchisq(x, a, log=FALSE), dchisq(x, a, log=TRUE)),
+ msg = " rmath.chisq")
+
+ f <- .rcpp.rmath$runit_pchisq
+ checkEquals(f(x, a),
+ c(pchisq(x, a, lower=TRUE, log=FALSE), pchisq(log(x), a, lower=TRUE, log=TRUE),
+ pchisq(x, a, lower=FALSE, log=FALSE), pchisq(log(x), a, lower=FALSE, log=TRUE)),
+ msg = " rmath.qchisq")
+
+ f <- .rcpp.rmath$runit_qchisq
+ checkEquals(f(x, a),
+ c(qchisq(x, a, lower=TRUE, log=FALSE), qchisq(log(x), a, lower=TRUE, log=TRUE),
+ qchisq(x, a, lower=FALSE, log=FALSE), qchisq(log(x), a, lower=FALSE, log=TRUE)),
+ msg = " rmath.qchisq")
}
+
+
+test.rmath.nchisq <- function() {
+ x <- 0.25
+ a <- 0.8
+ b <- 2.5
+ f <- .rcpp.rmath$runit_dnchisq
+ checkEquals(f(x, a, b),
+ c(dchisq(x, a, b, log=FALSE), dchisq(x, a, b, log=TRUE)),
+ msg = " rmath.nchisq")
+
+ f <- .rcpp.rmath$runit_pnchisq
+ checkEquals(f(x, a, b),
+ c(pchisq(x, a, b, lower=TRUE, log=FALSE), pchisq(log(x), a, b, lower=TRUE, log=TRUE),
+ pchisq(x, a, b, lower=FALSE, log=FALSE), pchisq(log(x), a, b, lower=FALSE, log=TRUE)),
+ msg = " rmath.qnchisq")
+
+ f <- .rcpp.rmath$runit_qnchisq
+ checkEquals(f(x, a, b),
+ c(qchisq(x, a, b, lower=TRUE, log=FALSE), qchisq(log(x), a, b, lower=TRUE, log=TRUE),
+ qchisq(x, a, b, lower=FALSE, log=FALSE), qchisq(log(x), a, b, lower=FALSE, log=TRUE)),
+ msg = " rmath.qnchisq")
+}
+
+
+test.rmath.f <- function() {
+ x <- 0.25
+ a <- 0.8
+ b <- 2.5
+ f <- .rcpp.rmath$runit_df
+ checkEquals(f(x, a, b),
+ c(df(x, a, b, log=FALSE), df(x, a, b, log=TRUE)),
+ msg = " rmath.f")
+
+ f <- .rcpp.rmath$runit_pf
+ checkEquals(f(x, a, b),
+ c(pf(x, a, b, lower=TRUE, log=FALSE), pf(log(x), a, b, lower=TRUE, log=TRUE),
+ pf(x, a, b, lower=FALSE, log=FALSE), pf(log(x), a, b, lower=FALSE, log=TRUE)),
+ msg = " rmath.qf")
+
+ f <- .rcpp.rmath$runit_qf
+ checkEquals(f(x, a, b),
+ c(qf(x, a, b, lower=TRUE, log=FALSE), qf(log(x), a, b, lower=TRUE, log=TRUE),
+ qf(x, a, b, lower=FALSE, log=FALSE), qf(log(x), a, b, lower=FALSE, log=TRUE)),
+ msg = " rmath.qf")
+}
+
+
+test.rmath.t <- function() {
+ x <- 0.25
+ a <- 0.8
+ f <- .rcpp.rmath$runit_dt
+ checkEquals(f(x, a),
+ c(dt(x, a, log=FALSE), dt(x, a, log=TRUE)),
+ msg = " rmath.t")
+
+ f <- .rcpp.rmath$runit_pt
+ checkEquals(f(x, a),
+ c(pt(x, a, lower=TRUE, log=FALSE), pt(log(x), a, lower=TRUE, log=TRUE),
+ pt(x, a, lower=FALSE, log=FALSE), pt(log(x), a, lower=FALSE, log=TRUE)),
+ msg = " rmath.qt")
+
+ f <- .rcpp.rmath$runit_qt
+ checkEquals(f(x, a),
+ c(qt(x, a, lower=TRUE, log=FALSE), qt(log(x), a, lower=TRUE, log=TRUE),
+ qt(x, a, lower=FALSE, log=FALSE), qt(log(x), a, lower=FALSE, log=TRUE)),
+ msg = " rmath.qt")
+}
+
+
+test.rmath.binom <- function() {
+ x <- 5
+ a <- 10
+ b <- 0.5
+ f <- .rcpp.rmath$runit_dbinom
+ checkEquals(f(x, a, b),
+ c(dbinom(x, a, b, log=FALSE), dbinom(x, a, b, log=TRUE)),
+ msg = " rmath.binom")
+
+ f <- .rcpp.rmath$runit_pbinom
+ checkEquals(f(x, a, b),
+ c(pbinom(x, a, b, lower=TRUE, log=FALSE), pbinom(log(x), a, b, lower=TRUE, log=TRUE),
+ pbinom(x, a, b, lower=FALSE, log=FALSE), pbinom(log(x), a, b, lower=FALSE, log=TRUE)),
+ msg = " rmath.qbinom")
+
+ x <- x/a
+ f <- .rcpp.rmath$runit_qbinom
+ checkEquals(f(x, a, b),
+ c(qbinom(x, a, b, lower=TRUE, log=FALSE), qbinom(log(x), a, b, lower=TRUE, log=TRUE),
+ qbinom(x, a, b, lower=FALSE, log=FALSE), qbinom(log(x), a, b, lower=FALSE, log=TRUE)),
+ msg = " rmath.qbinom")
+}
+
+}
+
+
+
Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R 2012-11-02 18:36:44 UTC (rev 3887)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R 2012-11-03 00:19:12 UTC (rev 3888)
@@ -1,5 +1,5 @@
#!/usr/bin/r -t
-# -*- mode: R; tab-width: 4 -*-
+# -*- mode: R; tab-width: 4; -*-
#
# Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois
#
Modified: pkg/Rcpp/inst/unitTests/runit.sugarOps.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugarOps.R 2012-11-02 18:36:44 UTC (rev 3887)
+++ pkg/Rcpp/inst/unitTests/runit.sugarOps.R 2012-11-03 00:19:12 UTC (rev 3888)
@@ -1,5 +1,5 @@
#!/usr/bin/r -t
-# -*- mode: R; ess-indent-level: 4; indent-tabs-mode: nil; -*-
+# -*- mode: R; ess-indent-level: 4; indent-tabs-mode: nil; -*-
#
# Copyright (C) 2012 Dirk Eddelbuettel and Romain Francois
#
More information about the Rcpp-commits
mailing list