[Rcpp-commits] r1948 - pkg/Rcpp/inst/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 6 16:47:12 CEST 2010
Author: edd
Date: 2010-08-06 16:47:11 +0200 (Fri, 06 Aug 2010)
New Revision: 1948
Modified:
pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
reinstated dt and pt test that had been swallowed by the svn gremlines
reordered actual test invocation function to matter order in source list
Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-06 14:36:05 UTC (rev 1947)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R 2010-08-06 14:47:11 UTC (rev 1948)
@@ -259,6 +259,17 @@
}
}
+test.stats.dbeta <- function() {
+ fx <- .rcpp.stats$runit_dbeta
+ vv <- seq(0, 1, by = 0.1)
+ a <- 0.5; b <- 2.5
+ checkEquals(fx(vv, a, b),
+ list(NoLog = dbeta(vv, a, b),
+ Log = dbeta(vv, a, b, log=TRUE)
+ ),
+ msg = " stats.qbeta")
+}
+
test.stats.dbinom <- function( ){
fx <- .rcpp.stats$runit_dbinom
checkEquals(fx(1:10) ,
@@ -266,6 +277,25 @@
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)
+ ),
+ msg = " stats.dunif")
+}
+
+test.stats.dgamma <- function( ) {
+ 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" )
+}
+
+
test.stats.dpois <- function( ){
fx <- .rcpp.stats$runit_dpois
checkEquals(fx(0:5) ,
@@ -281,14 +311,72 @@
msg = "stats.dnorm" )
}
-test.stats.dgamma <- function( ) {
- fx <- .rcpp.stats$runit_dgamma
- v <- 1:4
+test.stats.dt <- function( ) {
+ fx <- .rcpp.stats$runit_dt
+ v <- seq(0.0, 1.0, by=0.1)
checkEquals(fx(v),
- list( NoLog = dgamma(v, 1.0, 1.0), Log = dgamma(v, 1.0, 1.0, log = TRUE ) ),
- msg = "stats.dgamma" )
+ list( false = dt(v, 5), true = dt(v, 5, log=TRUE ) ), # NB: need log=TRUE here
+ msg = "stats.dt" )
}
+test.stats.pbeta <- function( ) {
+ fx <- .rcpp.stats$runit_pbeta
+ a <- 0.5; b <- 2.5
+ v <- qbeta(seq(0.0, 1.0, by=0.1), a, b)
+ checkEquals(fx(v, a, b),
+ list(lowerNoLog = pbeta(v, a, b),
+ lowerLog = pbeta(v, a, b, log=TRUE),
+ upperNoLog = pbeta(v, a, b, lower=FALSE),
+ upperLog = pbeta(v, a, b, lower=FALSE, log=TRUE)
+ ),
+ msg = " stats.pbeta" )
+ ## Borrowed from R's d-p-q-r-tests.R
+ x <- c(.01, .10, .25, .40, .55, .71, .98)
+ pbval <- c(-0.04605755624088, -0.3182809860569, -0.7503593555585,
+ -1.241555830932, -1.851527837938, -2.76044482378, -8.149862739881)
+ checkEqualsNumeric(fx(x, 0.8, 2)$upperLog, pbval, msg = " stats.pbeta")
+ checkEqualsNumeric(fx(1-x, 2, 0.8)$lowerLog, pbval, msg = " stats.pbeta")
+}
+
+test.stats.pbinom <- function( ) {
+ fx <- .rcpp.stats$runit_pbinom
+ n <- 20
+ p <- 0.5
+ vv <- 0:n
+ checkEquals(fx(vv, n, p),
+ list(lowerNoLog = pbinom(vv, n, p),
+ lowerLog = pbinom(vv, n, p, log=TRUE),
+ upperNoLog = pbinom(vv, n, p, lower=FALSE),
+ upperLog = pbinom(vv, n, p, lower=FALSE, log=TRUE)
+ ),
+ msg = " stats.pbinom")
+}
+
+test.stats.pbinom.fixed <- function( ) {
+ fx <- .rcpp.stats$runit_pbinom_fixed
+ vv <- 0:20
+ checkEquals(fx(vv),
+ list(lowerNoLog = pbinom(vv, 20, 0.5),
+ lowerLog = pbinom(vv, 20, 0.5, log=TRUE),
+ upperNoLog = pbinom(vv, 20, 0.5, lower=FALSE),
+ upperLog = pbinom(vv, 20, 0.5, lower=FALSE, log=TRUE)
+ ),
+ msg = " stats.pbinom.fixed")
+}
+
+test.stats.punif <- function( ) {
+ fx <- .rcpp.stats$runit_punif
+ v <- qunif(seq(0.0, 1.0, by=0.1))
+ checkEquals(fx(v),
+ list(lowerNoLog = punif(v),
+ lowerLog = punif(v, log=TRUE ),
+ upperNoLog = punif(v, lower=FALSE),
+ upperLog = punif(v, lower=FALSE, log=TRUE)
+ ),
+ msg = "stats.punif" )
+ # TODO: also borrow from R's d-p-q-r-tests.R
+}
+
test.stats.pgamma <- function( ) {
fx <- .rcpp.stats$runit_pgamma
v <- (1:9)/10
@@ -322,19 +410,48 @@
## FIXME: Add tests that use non-default mu and sigma
}
-test.stats.punif <- function( ) {
- fx <- .rcpp.stats$runit_punif
- v <- qunif(seq(0.0, 1.0, by=0.1))
+test.stats.ppois <- function( ) {
+ fx <- .rcpp.stats$runit_ppois
+ vv <- 0:20
+ checkEquals(fx(vv),
+ list(lowerNoLog = ppois(vv, 0.5),
+ lowerLog = ppois(vv, 0.5, log=TRUE),
+ upperNoLog = ppois(vv, 0.5, lower=FALSE),
+ upperLog = ppois(vv, 0.5, lower=FALSE, log=TRUE)
+ ),
+ msg = " stats.ppois")
+}
+
+test.stats.pt <- function( ) {
+ fx <- .rcpp.stats$runit_pt
+ v <- seq(0.0, 1.0, by=0.1)
checkEquals(fx(v),
- list(lowerNoLog = punif(v),
- lowerLog = punif(v, log=TRUE ),
- upperNoLog = punif(v, lower=FALSE),
- upperLog = punif(v, lower=FALSE, log=TRUE)
+ list( false = pt(v, 5), true = pt(v, 5, log=TRUE ) ), # NB: need log=TRUE here
+ msg = "stats.pt" )
+}
+
+test.stats.qbinom <- function( ) {
+ fx <- .rcpp.stats$runit_qbinom_prob
+ n <- 20
+ p <- 0.5
+ vv <- seq(0, 1, by = 0.1)
+ checkEquals(fx(vv, n, p),
+ list(lower = qbinom(vv, n, p),
+ upper = qbinom(vv, n, p, lower=FALSE)
),
- msg = "stats.punif" )
- # TODO: also borrow from R's d-p-q-r-tests.R
+ msg = " stats.qbinom")
}
+test.stats.qbinom.fixed <- function( ) {
+ fx <- .rcpp.stats$runit_qbinom_prob_fixed
+ vv <- seq(0, 1, by = 0.1)
+ checkEquals(fx(vv),
+ list(lower = qbinom(vv, 20, 0.5),
+ upper = qbinom(vv, 20, 0.5, lower=FALSE)
+ ),
+ msg = " stats.qbinom.fixed")
+}
+
test.stats.qunif <- function( ) {
fx <- .rcpp.stats$runit_qunif_prob
checkEquals(fx(c(0, 1, 1.1, -.1)),
@@ -367,66 +484,6 @@
checkEqualsNumeric(fx(-1e5)$lower, -447.1974945)
}
-test.stats.pbinom <- function( ) {
- fx <- .rcpp.stats$runit_pbinom
- n <- 20
- p <- 0.5
- vv <- 0:n
- checkEquals(fx(vv, n, p),
- list(lowerNoLog = pbinom(vv, n, p),
- lowerLog = pbinom(vv, n, p, log=TRUE),
- upperNoLog = pbinom(vv, n, p, lower=FALSE),
- upperLog = pbinom(vv, n, p, lower=FALSE, log=TRUE)
- ),
- msg = " stats.pbinom")
-}
-
-test.stats.qbinom <- function( ) {
- fx <- .rcpp.stats$runit_qbinom_prob
- n <- 20
- p <- 0.5
- vv <- seq(0, 1, by = 0.1)
- checkEquals(fx(vv, n, p),
- list(lower = qbinom(vv, n, p),
- upper = qbinom(vv, n, p, lower=FALSE)
- ),
- msg = " stats.qbinom")
-}
-
-test.stats.pbinom.fixed <- function( ) {
- fx <- .rcpp.stats$runit_pbinom_fixed
- vv <- 0:20
- checkEquals(fx(vv),
- list(lowerNoLog = pbinom(vv, 20, 0.5),
- lowerLog = pbinom(vv, 20, 0.5, log=TRUE),
- upperNoLog = pbinom(vv, 20, 0.5, lower=FALSE),
- upperLog = pbinom(vv, 20, 0.5, lower=FALSE, log=TRUE)
- ),
- msg = " stats.pbinom.fixed")
-}
-
-test.stats.qbinom.fixed <- function( ) {
- fx <- .rcpp.stats$runit_qbinom_prob_fixed
- vv <- seq(0, 1, by = 0.1)
- checkEquals(fx(vv),
- list(lower = qbinom(vv, 20, 0.5),
- upper = qbinom(vv, 20, 0.5, lower=FALSE)
- ),
- msg = " stats.qbinom.fixed")
-}
-
-test.stats.ppois <- function( ) {
- fx <- .rcpp.stats$runit_ppois
- vv <- 0:20
- checkEquals(fx(vv),
- list(lowerNoLog = ppois(vv, 0.5),
- lowerLog = ppois(vv, 0.5, log=TRUE),
- upperNoLog = ppois(vv, 0.5, lower=FALSE),
- upperLog = ppois(vv, 0.5, lower=FALSE, log=TRUE)
- ),
- msg = " stats.ppois")
-}
-
test.stats.qpois.prob <- function( ) {
fx <- .rcpp.stats$runit_qpois_prob
vv <- seq(0, 1, by = 0.1)
@@ -437,48 +494,6 @@
msg = " stats.qpois.prob")
}
-test.stats.dbeta <- function() {
- fx <- .rcpp.stats$runit_dbeta
- vv <- seq(0, 1, by = 0.1)
- a <- 0.5; b <- 2.5
- checkEquals(fx(vv, a, b),
- list(NoLog = dbeta(vv, a, b),
- Log = dbeta(vv, a, b, log=TRUE)
- ),
- msg = " stats.qbeta")
-}
-
-
-test.stats.pbeta <- function( ) {
- fx <- .rcpp.stats$runit_pbeta
- a <- 0.5; b <- 2.5
- v <- qbeta(seq(0.0, 1.0, by=0.1), a, b)
- checkEquals(fx(v, a, b),
- list(lowerNoLog = pbeta(v, a, b),
- lowerLog = pbeta(v, a, b, log=TRUE),
- upperNoLog = pbeta(v, a, b, lower=FALSE),
- upperLog = pbeta(v, a, b, lower=FALSE, log=TRUE)
- ),
- msg = " stats.pbeta" )
- ## Borrowed from R's d-p-q-r-tests.R
- x <- c(.01, .10, .25, .40, .55, .71, .98)
- pbval <- c(-0.04605755624088, -0.3182809860569, -0.7503593555585,
- -1.241555830932, -1.851527837938, -2.76044482378, -8.149862739881)
- checkEqualsNumeric(fx(x, 0.8, 2)$upperLog, pbval, msg = " stats.pbeta")
- checkEqualsNumeric(fx(1-x, 2, 0.8)$lowerLog, pbval, msg = " stats.pbeta")
-}
-
-
-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)
- ),
- msg = " stats.dunif")
-}
-
test.stats.qt <- function( ) {
fx <- .rcpp.stats$runit_qt
v <- seq(0.05, 0.95, by=0.05)
More information about the Rcpp-commits
mailing list