[Power-commits] r32 - in pkg/sse: inst/slowTests/testthat tests/testthat
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 16 22:37:46 CEST 2019
Author: thofab
Date: 2019-08-16 22:37:45 +0200 (Fri, 16 Aug 2019)
New Revision: 32
Added:
pkg/sse/inst/slowTests/testthat/test-advanced.R
pkg/sse/inst/slowTests/testthat/test-oldStylepowPar.R
pkg/sse/inst/slowTests/testthat/test-updatePower.R
pkg/sse/inst/slowTests/testthat/test-updateResample.R
Removed:
pkg/sse/tests/testthat/test-advanced.R
pkg/sse/tests/testthat/test-lintr.R
pkg/sse/tests/testthat/test-oldStylepowPar.R
pkg/sse/tests/testthat/test-parallel.R
pkg/sse/tests/testthat/test-updatePower.R
pkg/sse/tests/testthat/test-updateResample.R
Log:
moving most tests to inst/slowTests
Copied: pkg/sse/inst/slowTests/testthat/test-advanced.R (from rev 31, pkg/sse/tests/testthat/test-advanced.R)
===================================================================
--- pkg/sse/inst/slowTests/testthat/test-advanced.R (rev 0)
+++ pkg/sse/inst/slowTests/testthat/test-advanced.R 2019-08-16 20:37:45 UTC (rev 32)
@@ -0,0 +1,122 @@
+context("Advanced applications")
+
+library(sse)
+library(testthat)
+### ------------------------------------------------------------------
+### with pilot data and several endpoints
+pilot.data <- rnorm(1000)
+#
+psi <- powPar(F.hat = pilot.data,
+ delta = seq(from = 0.5, to = 1.5, by = 0.05),
+ n = seq(from = 20, to = 50, by = 2),
+ theta.name = "delta")
+
+powFun <- function(psi){
+ a <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE)
+ b <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE) + theta(psi)
+ w <- wilcox.test(a, b)$p.value < 0.05
+ t <- t.test(a, b)$p.value < 0.05
+ return(c(w = w, t = t))
+ }
+
+calc <- powCalc(psi, statistic = powFun, n.iter = 99)
+
+pow.w <- powEx(calc, theta = 1, drop = 0.1, endpoint = "w")
+
+plot(pow.w, smooth = 0.5,
+ xlab = expression(paste("Delta, ", delta)),
+ ylab = "Total sample size",
+ main = "Wilcoxon Test")
+
+pow.t <- powEx(calc, theta = 1, drop = 0.1, endpoint = "t")
+
+plot(pow.t, smooth = 0.5,
+ xlab = expression(paste("Delta, ", delta)),
+ ylab = "Total sample size",
+ main = "T- Test",
+ ylim = c(30, 40))
+
+## parametric resampling:
+psi.parametric <- powPar(delta = seq(from = 0.5, to = 1.5, by = 0.05),
+ xi = seq(from = 0.5, to = 1.5, by = 0.5),
+ n = seq(from = 20, to = 50, by = 2),
+ theta.name = "delta")
+
+
+powFun.parametric <- function(psi){
+ a <- rnorm(n(psi), mean = 0, sd = xi(psi))
+ b <- rnorm(n(psi), mean = theta(psi), sd = xi(psi))
+ w <- wilcox.test(a, b)$p.value < 0.05
+ t <- t.test(a, b)$p.value < 0.05
+ return(c(w = w, t = t))
+}
+
+calc.parametric <- powCalc(psi.parametric,
+ statistic = powFun.parametric,
+ n.iter = 99)
+
+pow.t.parametric <- powEx(calc.parametric,
+ xi = 1,
+ theta = 1,
+ drop = 0.1,
+ endpoint = "t")
+
+pow.t.parametric.xi05 <- powEx(calc.parametric,
+ xi = 0.5,
+ theta = 1,
+ drop = 0.1,
+ endpoint = "t")
+
+plot(pow.t.parametric)
+
+show(pow.t.parametric)
+
+### --------------------------------- TESTS
+test_that("endpoints", {
+#
+ ## selecting an endpoint that does not exist
+ expect_error(
+ powEx(calc, theta = 1, drop = 0.1, endpoint = "T") ## READ ERROR MESSAGE
+ )
+ expect_equal(pow.t.parametric at endpoint.example, "t")
+})
+
+
+test_that("powPar with data", {
+#
+ ## data extracted from psi is like the original
+ expect_equal(pp(psi, "F.hat"), pilot.data)
+})
+
+
+test_that("refine", {
+ pow.w.rf <- refine(pow.w)
+ expect_equal(pow.w.rf at iter, pow.w at iter)
+ expect_equal(pow.w.rf at iter.example, pow.w at iter * 10)
+})
+
+test_that("powEx", {
+ ## choosing and endpoint for example that is not part of the calc-object
+ expect_error(powEx(calc.power, theta = 2, endpoint = "s")) ## READ MESSAGE
+})
+
+test_that("plot", {
+ ## power is constant at 1
+ expect_error(
+ plot(pow.t.parametric.xi05)
+ )
+})
+
+test_that("List as return", {
+ powFun.list <- function(psi){
+ a <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE)
+ b <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE) + theta(psi)
+ w <- wilcox.test(a, b)$p.value < 0.05
+ t <- t.test(a, b)$p.value < 0.05
+ length(c(a,b) %% 2)
+ return(list(power = c(w = w, t = t), size = sum(c(a,b) %/% 2)))
+}
+expect_error(
+ calc.power <- powCalc(psi, statistic = powFun.list)
+)
+})
Copied: pkg/sse/inst/slowTests/testthat/test-oldStylepowPar.R (from rev 31, pkg/sse/tests/testthat/test-oldStylepowPar.R)
===================================================================
--- pkg/sse/inst/slowTests/testthat/test-oldStylepowPar.R (rev 0)
+++ pkg/sse/inst/slowTests/testthat/test-oldStylepowPar.R 2019-08-16 20:37:45 UTC (rev 32)
@@ -0,0 +1,44 @@
+context("Old style powPar object")
+
+library(testthat)
+library(sse)
+
+test_that("theta.name", {
+ psi <- powPar(delta = seq(from = 0.5, to = 1.5, by = 0.05),
+ n = seq(from = 20, to = 60, by = 2),
+ theta.name = "delta")
+ expect_equal(theta(psi), 0.5)
+
+ ## theta.name and theta
+ expect_warning(powPar(theta = seq(from = 0.5, to = 1.5, by = 0.05),
+ n = seq(from = 20, to = 60, by = 2),
+ delta = 1:10,
+ theta.name = "delta"))
+})
+
+
+
+test_that("xi.name", {
+ ## a xi.name without corresponding entry with xi
+ expect_warning(
+ powPar(theta = seq(from = 0.5, to = 1.5, by = 0.05),
+ n = seq(from = 20, to = 60, by = 2),
+ xi = 1:3,
+ xi.name = "delta")
+ )
+ ## a xi.name without corresponding entry without xi
+ expect_error(
+ powPar(theta = seq(from = 0.5, to = 1.5, by = 0.05),
+ n = seq(from = 20, to = 60, by = 2),
+ xi.name = "delta")
+ )
+
+ psi.xi <- powPar(theta = seq(from = 0.5, to = 1.5, by = 0.05),
+ delta = seq(from = 0.5, to = 1.5, by = 0.05),
+ n = seq(from = 20, to = 60, by = 2),
+ xi.name = "delta")
+ expect_equal(xi(psi.xi), 0.5)
+ expect_equal(psi.xi at xi.name, "delta")
+
+
+})
Copied: pkg/sse/inst/slowTests/testthat/test-updatePower.R (from rev 31, pkg/sse/tests/testthat/test-updatePower.R)
===================================================================
--- pkg/sse/inst/slowTests/testthat/test-updatePower.R (rev 0)
+++ pkg/sse/inst/slowTests/testthat/test-updatePower.R 2019-08-16 20:37:45 UTC (rev 32)
@@ -0,0 +1,181 @@
+context("Update, statistic returns a power")
+
+library(sse)
+library(testthat)
+
+## n
+n.l <- list(
+n0 = seq(from = 50, to = 100, by = 10), # ..XXXX.., corse
+n1 = seq(from = 50, to = 100, by = 5), # ..XXXX.., fine
+n2 = c(seq(from = 50, to = 80, by = 2), # ..XXXX.., mixed
+ seq(from = 85, to = 100, by = 5)),
+n3 = seq(from = 70, to = 100, by = 10), # ....XX.., corse subset
+n4 = seq(from = 70, to = 150, by = 10), # ..XXXXXX, corse extendet
+n5 = seq(from = 70, to = 150, by = 10), # ....XXXX, corse subset, extended
+n6 = seq(from = 0, to = 150, by = 10), # XXXXXXXX, corse subset, extended
+n7 = seq(from = 160, to = 200, by = 10), # ........XX, corse
+n8.e = c(seq(from = 50, to = 80, by = 2), # mixed with dublicated element
+ seq(from = 80, to = 100, by = 5)),
+n9 = 80) # length 1 and existing element
+
+
+## theta
+theta.l <- n.l
+theta.l <- lapply(theta.l, function(x) {
+ x / 100
+})
+names(theta.l) <- sub("n", "theta", names(theta.l))
+
+## xi
+xi.l <- list(
+ xi0 = seq(from = 1, to = 3, by = 1), # ..XXXX.., corse
+ xi1 = seq(from = 1, to = 3, by = 0.5), # ..XXXX.., fixie
+ xi2 = c(seq(from = 1, to = 1, by = 1), # ..XXXX.., mixed
+ seq(from = 1.5, to = 3, by = 0.5)),
+ xi3 = seq(from = 2, to = 3, by = 1), # ....XX.., corse subset
+ xi4 = seq(from = 1, to = 5, by = 1), # ..XXXXXX, corse extendet
+ xi5 = seq(from = 2, to = 5, by = 1), # ....XXXX, corse subset, extended
+ xi6 = seq(from = 0.5, to = 5, by = 0.5), # XXXXXXXX, corse subset, extended
+ xi7 = seq(from = 4, to = 5, by = 1), # ........XX, corse
+ xi8.e = c(seq(from = 1, to = 2, by = 1), # mixed with dublicated element
+ seq(from = 2, to = 5, by = 0.5)),
+ xi9 = 2) # length 1 and existing element
+
+
+attach(n.l)
+attach(theta.l)
+attach(xi.l)
+psi0 <- powPar(n = n0,
+ theta = theta0,
+ xi = xi0)
+
+##
+powFun0 <- function(psi){
+ n <- n(psi)
+ theta <- theta(psi)
+ xi <- xi(psi)
+ return(((n * theta) / 100) / xi)
+ }
+powFun1 <- function(psi){
+ n <- n(psi)
+ theta <- theta(psi)
+ return( (n * theta) / 100)
+ }
+
+calc.0.0.0.0 <- powCalc(psi0, statistic = powFun0)
+
+## correct result for powFun, n, theta, xi
+res0 <- function(n, theta, xi){
+ res.array <- array((n %*% t(theta)) / 100,
+ ## last dimension 1 because of powfun:
+ dim = c(length(n), length(theta), length(xi), 1))
+ for (i in seq(along.with = xi)) {
+ res.array[, , i, ] <- res.array[, , i, ] / xi[i]
+ }
+ return(res.array)
+}
+
+## ------------------------------------------------------------------
+## auto test
+for (n.i in names(n.l)) {
+ for (theta.i in names(theta.l)) {
+ for (xi.i in names(xi.l)) {
+ ## changing all n, theta and xi
+ what <- paste0(
+"update(calc.0.0.0.0,
+ n = ", n.i, ",
+ theta = ", theta.i, ",
+ xi = ", xi.i, ")@core")
+ ## additionally changing the statistic also
+ what2 <- paste0(
+"update(calc.0.0.0.0,
+ n = ", n.i, ",
+ theta = ", theta.i, ",
+ xi = ", xi.i, ", statistic = powFun0)@core")
+ cat("\n---------------------------------\n")
+ cat(what)
+ cat("\n")
+ res <- paste0("res0(", n.i, ", ", theta.i, ", ", xi.i, ")")
+ if (grepl(".e", n.i, fixed = TRUE)
+ | grepl(".e", theta.i, fixed = TRUE)
+ | grepl(".e", xi.i, fixed = TRUE)) {
+ ## expect an error
+ expect_error(eval(parse(text = what)))
+ } else {
+ ## if any n0 theta0 or xi0: expect a warning if not 7
+ if (n.i == "n0" & !(theta.i == "theta7" | xi.i == "xi7")
+ | theta.i == "theta0" & !(n.i == "n7" | xi.i == "xi7")
+ | xi.i == "xi0" & !(n.i == "n7" | theta.i == "theta7")) {
+ expect_warning(eval(parse(text = what)))
+ }
+ ## should work
+ eval(parse(text = paste0("expect_equal(",
+ paste0("suppressWarnings(",
+ what,
+ ")"),
+ ",",
+ res,
+ ", check.attributes = FALSE)")))
+ ## should work but completely new evaluation
+ cat("\n")
+ cat(what2)
+ cat("\n")
+ eval(parse(text = paste0("expect_equal(",
+ what2,
+ ",",
+ res,
+ ", check.attributes = FALSE)")))
+ }
+ }
+ }
+}
+
+
+# ---------------------------------
+test_that("update without any changes", {
+ expect_equal(update(calc.0.0.0.0)@core,
+ res0(n0, theta0, xi0),
+ check.attributes = FALSE)
+})
+
+# ---------------------------------
+test_that("update of an element that is not allowed", {
+#
+ expect_error(
+ update(calc.0.0.0.0, iter.example = 2)
+ )
+})
+
+# ---------------------------------
+test_that("update of n.iter when it does not make sense", {
+#
+ expect_warning(
+ update(calc.0.0.0.0, n.iter = 2)
+ )
+ expect_equal(
+ update(calc.0.0.0.0, n.iter = 2)@core,
+ res0(n0, theta0, xi0),
+ check.attributes = FALSE)
+})
+
+# ---------------------------------
+test_that("update of n, theta, xi with dublicated element", {
+#
+ expect_error(
+ update(calc.0.0.0.0, n = n8)
+ )
+ expect_error(
+ update(calc.0.0.0.0, n = theta8)
+ )
+ expect_error(
+ update(calc.0.0.0.0, n = xi8)
+ )
+})
+
+# ---------------------------------
+test_that("update statistic only", {
+#
+ expect_equal(update(calc.0.0.0.0, statistic = powFun0)@core,
+ res0(n0, theta0, xi0),
+ check.attributes = FALSE)
+})
Copied: pkg/sse/inst/slowTests/testthat/test-updateResample.R (from rev 31, pkg/sse/tests/testthat/test-updateResample.R)
===================================================================
--- pkg/sse/inst/slowTests/testthat/test-updateResample.R (rev 0)
+++ pkg/sse/inst/slowTests/testthat/test-updateResample.R 2019-08-16 20:37:45 UTC (rev 32)
@@ -0,0 +1,143 @@
+context("Update, resampling")
+
+library(sse)
+library(testthat)
+psi1 <- powPar(theta = seq(from = 0, to = 1, by = 0.1),
+ n = seq(from = 0, to = 100, by = 10))
+##
+powFun2 <- function(psi) {
+ n <- n(psi)
+ theta <- theta(psi)
+ return(as.logical( (n * theta) %% 2))
+}
+powFun3 <- function(psi) {
+ n <- n(psi)
+ theta <- theta(psi)
+ return(as.logical(n %% 2))
+}
+
+## correct result for
+
+result1.2.x <- array(round(seq(from = 0, to = 1, by = 0.1) %*%
+ t(seq(from = 0, to = 100, by = 10)) %% 2, 10),
+ dim = c(11, 11, 1, 1))
+result1.2.n2 <- array(as.logical(seq(from = 0, to = 1, by = 0.1) %*%
+ t(seq(from = 50, to = 100, by = 5)) %% 2),
+ dim = c(11, 11, 1, 1))
+## result1.2.n5 <- array(as.logical(seq(from = 0, to = 1, by = 0.1) %*%
+## t(seq(from = 50, to = 150, by = 5)) %% 2),
+## dim = c(21, 11, 1, 1))
+## # FIXME
+result1.3.x <- array(0, dim = c(11, 11, 1, 1))
+
+##
+calc1.2.1 <- powCalc(psi1, statistic = powFun2, n.iter = 99)
+
+calc1.3.1 <- powCalc(psi1, statistic = powFun3, n.iter = 99)
+
+calc1.2.1.nc <- powCalc(psi1, statistic = powFun2, n.iter = 99, cluster = FALSE)
+ # as calc1.2.1 but without cluster
+##
+n.new <- as.integer(seq(from = 0, to = 100, by = 5))
+n.new2 <- as.integer(seq(from = 50, to = 100, by = 5))
+n.new5 <- as.integer(seq(from = 50, to = 150, by = 5))
+theta.new <- seq(from = 0, to = 1, by = 0.05)
+theta.new4 <- 0.51
+
+##
+pow1.2.1 <- powEx(calc1.2.1, theta = 1, power = 0.9)
+
+pow1.2.1.rf <- refine(pow1.2.1)
+
+test_that("update without any changes", {
+#
+ calc1.2.2 <- update(calc1.2.1)
+ calc1.3.2 <- update(calc1.3.1)
+ expect_equal(calc1.2.2 at core, result1.2.x, check.attributes = FALSE)
+ expect_equal(calc1.3.2 at core, result1.3.x, check.attributes = FALSE)
+})
+
+test_that("n.iter", {
+ ## increasing
+ calc1.2.3 <- update(calc1.2.1, n.iter = 500)
+ expect_equal(calc1.2.3 at core, result1.2.x, check.attributes = FALSE)
+ expect_equal(calc1.2.3 at iter, 500)
+ ## n.iter length > 1
+ expect_warning(
+ update(calc1.2.1, n.iter = c(500,100))
+ )
+})
+
+
+test_that("increasing n within existing range of n", {
+#
+ calc1.2.3 <- update(calc1.2.1, n = n.new)
+})
+
+
+test_that("increasing theta within existing range of theta", {
+#
+ calc1.2.4 <- update(calc1.2.1, theta = theta.new)
+ #expect_equal(calc1.1.4 at core, result1.1.t, check.attributes = FALSE)
+})
+
+
+
+test_that("increasing theta and n within existing range of theta and n", {
+#
+ calc1.2.5 <- update(calc1.2.1, n.iter = NA, n = n.new, theta = theta.new)
+# expect_equal(calc1.1.5 at core, result1.1.nt, check.attributes = FALSE)
+})
+
+
+
+test_that("update statistic only", {
+#
+ calc1.2.6 <- update(calc1.2.1, statistic = powFun2)
+ expect_equal(calc1.2.6 at core, result1.2.x, check.attributes = FALSE)
+})
+
+
+
+test_that("update statistic and increasing n within existing range of n", {
+#
+ calc1.2.7 <- update(calc1.2.1, statistic = powFun2, n = n.new)
+ calc1.2.7 <- update(calc1.2.7, n = n.new)
+# expect_equal(calc1.2.7 at core, result1.2.n, check.attributes = FALSE)
+})
+
+
+
+test_that("updating n within smaller range of n", {
+#
+ calc1.2.8 <- update(calc1.2.1, n = n.new2)
+ # expect_equal(array(as.logical(calc1.2.8 at core), dim = c(11,11,1,1)),
+ # result1.2.n2, check.attributes = FALSE)
+})
+
+test_that("updating n with new range of n only partially matching", {
+#
+ calc1.2.8 <- update(calc1.2.1, n = n.new5)
+ # expect_equal(array(as.logical(calc1.2.8 at core), dim = c(11,11,1,1)),
+ # result1.2.n2, check.attributes = FALSE)
+})
+
+test_that("not using cluster", {
+#
+ expect_equal(calc1.2.1.nc at core, result1.2.x, check.attributes = FALSE)
+ expect_equal(calc1.2.1.nc at core, result1.2.x, check.attributes = FALSE)
+})
+
+
+test_that("new theta of length 1 and increasing n.iter", {
+#
+ calc1.2.9 <- update(calc1.2.1.nc, theta = theta.new4, n.iter = 99)
+ calc1.2.10 <- update(calc1.2.9, theta = theta.new4, n.iter = 100)
+})
+
+test_that("updating n with new range of n only partially matching", {
+#
+ calc1.2.11 <- update(calc1.2.1, n = n.new5)
+ #expect_equal(array(as.logical(calc1.2.11 at core), dim = c(21,11,1,1)),
+ # result1.2.n5, check.attributes = FALSE)
+})
Deleted: pkg/sse/tests/testthat/test-advanced.R
===================================================================
--- pkg/sse/tests/testthat/test-advanced.R 2019-08-16 20:33:44 UTC (rev 31)
+++ pkg/sse/tests/testthat/test-advanced.R 2019-08-16 20:37:45 UTC (rev 32)
@@ -1,122 +0,0 @@
-context("Advanced applications")
-
-library(sse)
-library(testthat)
-### ------------------------------------------------------------------
-### with pilot data and several endpoints
-pilot.data <- rnorm(1000)
-#
-psi <- powPar(F.hat = pilot.data,
- delta = seq(from = 0.5, to = 1.5, by = 0.05),
- n = seq(from = 20, to = 50, by = 2),
- theta.name = "delta")
-
-powFun <- function(psi){
- a <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE)
- b <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE) + theta(psi)
- w <- wilcox.test(a, b)$p.value < 0.05
- t <- t.test(a, b)$p.value < 0.05
- return(c(w = w, t = t))
- }
-
-calc <- powCalc(psi, statistic = powFun, n.iter = 99)
-
-pow.w <- powEx(calc, theta = 1, drop = 0.1, endpoint = "w")
-
-plot(pow.w, smooth = 0.5,
- xlab = expression(paste("Delta, ", delta)),
- ylab = "Total sample size",
- main = "Wilcoxon Test")
-
-pow.t <- powEx(calc, theta = 1, drop = 0.1, endpoint = "t")
-
-plot(pow.t, smooth = 0.5,
- xlab = expression(paste("Delta, ", delta)),
- ylab = "Total sample size",
- main = "T- Test",
- ylim = c(30, 40))
-
-## parametric resampling:
-psi.parametric <- powPar(delta = seq(from = 0.5, to = 1.5, by = 0.05),
- xi = seq(from = 0.5, to = 1.5, by = 0.5),
- n = seq(from = 20, to = 50, by = 2),
- theta.name = "delta")
-
-
-powFun.parametric <- function(psi){
- a <- rnorm(n(psi), mean = 0, sd = xi(psi))
- b <- rnorm(n(psi), mean = theta(psi), sd = xi(psi))
- w <- wilcox.test(a, b)$p.value < 0.05
- t <- t.test(a, b)$p.value < 0.05
- return(c(w = w, t = t))
-}
-
-calc.parametric <- powCalc(psi.parametric,
- statistic = powFun.parametric,
- n.iter = 99)
-
-pow.t.parametric <- powEx(calc.parametric,
- xi = 1,
- theta = 1,
- drop = 0.1,
- endpoint = "t")
-
-pow.t.parametric.xi05 <- powEx(calc.parametric,
- xi = 0.5,
- theta = 1,
- drop = 0.1,
- endpoint = "t")
-
-plot(pow.t.parametric)
-
-show(pow.t.parametric)
-
-### --------------------------------- TESTS
-test_that("endpoints", {
-#
- ## selecting an endpoint that does not exist
- expect_error(
- powEx(calc, theta = 1, drop = 0.1, endpoint = "T") ## READ ERROR MESSAGE
- )
- expect_equal(pow.t.parametric at endpoint.example, "t")
-})
-
-
-test_that("powPar with data", {
-#
- ## data extracted from psi is like the original
- expect_equal(pp(psi, "F.hat"), pilot.data)
-})
-
-
-test_that("refine", {
- pow.w.rf <- refine(pow.w)
- expect_equal(pow.w.rf at iter, pow.w at iter)
- expect_equal(pow.w.rf at iter.example, pow.w at iter * 10)
-})
-
-test_that("powEx", {
- ## choosing and endpoint for example that is not part of the calc-object
- expect_error(powEx(calc.power, theta = 2, endpoint = "s")) ## READ MESSAGE
-})
-
-test_that("plot", {
- ## power is constant at 1
- expect_error(
- plot(pow.t.parametric.xi05)
- )
-})
-
-test_that("List as return", {
- powFun.list <- function(psi){
- a <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE)
- b <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE) + theta(psi)
- w <- wilcox.test(a, b)$p.value < 0.05
- t <- t.test(a, b)$p.value < 0.05
- length(c(a,b) %% 2)
- return(list(power = c(w = w, t = t), size = sum(c(a,b) %/% 2)))
-}
-expect_error(
- calc.power <- powCalc(psi, statistic = powFun.list)
-)
-})
Deleted: pkg/sse/tests/testthat/test-lintr.R
===================================================================
--- pkg/sse/tests/testthat/test-lintr.R 2019-08-16 20:33:44 UTC (rev 31)
+++ pkg/sse/tests/testthat/test-lintr.R 2019-08-16 20:37:45 UTC (rev 32)
@@ -1,101 +0,0 @@
-## context("lintr")
-
-
-
-## # "lintr_trailing_semicolon_linter" fails in bad1
-## # "lintr_attach_detach_linter" fails in bad2
-## # "lintr_setwd_linter" fails in bad2
-## # "lintr_sapply_linter" fails in bad2
-## # "lintr_library_require_linter" fails in bad2
-## # "lintr_seq_linter" fails in bad3
-## # not failing yet:
-## # "lintr_assignment_linter"
-## # "lintr_line_length_linter"
-
-## gp_lintrs <- c("lintr_assignment_linter", "lintr_line_length_linter",
-## "lintr_trailing_semicolon_linter",
-## "lintr_attach_detach_linter", "lintr_setwd_linter",
-## "lintr_sapply_linter", "lintr_library_require_linter",
-## "lintr_seq_linter")
-
-## bad1 <- system.file("bad1", package = "goodpractice")
-## gp_bad1 <- gp(bad1, checks = gp_lintrs)
-## res_bad1 <- results(gp_bad1)
-
-## gp_bad2 <- gp("bad2", checks = gp_lintrs)
-## res_bad2 <- results(gp_bad2)
-
-## gp_bad3 <- gp("bad3", checks = gp_lintrs)
-## res_bad3 <- results(gp_bad3)
-
-## get_result <- function(res, check) res$result[res$check == check]
-
-
-
-## test_that("lintr_assignment_linter", {
-
-## expect_true(get_result(res_bad1, "lintr_assignment_linter"))
-## # TODO expectation/example where the check fails
-
-## })
-
-
-## library(lintr)
-## test_that("code quality and style", {
-## # skip_if_not_installed("lintr")
-## # skip_on_travis()
-## # skip_on_cran()
-## lintr::expect_lint_free(linters = with_defaults(
-## line_length_linter(120)
-## ))
-## })
-
-
-## context("lints")
-
-## ## #if (requireNamespace("lintr", quietly = TRUE)) {
-
-
-## ## library(lintr)
-
-## ## # enforce camelCase rather than snake_case
-## ## with_defaults(camel_case_linter = NULL,
-## ## snake_case_linter)
-## ## # change the default line length cutoff
-## ## with_defaults(line_length_linter = line_length_linter(120))
-
-## ## lint("power.R")
-## ## , linters = list(line_length_linter(80)))
-
-
-## test_that("Package Style", {
-## ## lintr::expect_lint_free(#linters = list(
-## ## # e = lintr::line_length_linter(100))
-## ## )
-## ## })
-## ## #}
-## lintr::lint_package("sse",
-## linters = with_defaults(
-## ## absolute_paths_linter = NULL, # checks that no absolute paths are used.
-## ## assignment_linter = NULL, #checks that '<-' is always used for assignment.
-## ## closed_curly_linter = NULL, #check that closed curly braces should always be on their own line unless they follow an else.
-## ## commas_linter = NULL, #check that all commas are followed byspaces, but do not have spaces before them.
-## commented_code_linter = NULL, #checks that there is no commented code outside roxygen blocks
-## ## infix_spaces_linter = NULL, #check that all infix operators have spaces around them.
-## # line_length_linter(120), #check the line length of both comments and code is less than length.
-## ## no_tab_linter = NULL, #check that only spaces are used, never tabs.
-## ## object_usage_linter = NULL, #checks that closures have the proper usage using ‘checkUsage’. Note this runs ‘eval’ on the code, so do not use with untrusted code.
-## camel_case_linter = NULL, #check that objects are not in camelCase.
-## snake_case_linter = NULL, #check that objects are not in snake_case.
-## multiple_dots_linter = NULL, #check that objects do not have multiple.dots.
-## # object_length_linter = NULL, #check that objects do are not very long.not have.multiple.dots.
-## ## open_curly_linter = NULL, #check that opening curly braces are never on their own line and are always followed by a newline.
-## ## single_quotes_linter = NULL, #checks that only single quotes are used to delimit string contestants.
-## ## spaces_inside_linter = NULL, #check that parentheses and square brackets do not have spaces directly inside them.
-## ## spaces_left_parentheses_linter = NULL, #check that all left parentheses have a space before them unless they are in a function call.
-## ## trailing_blank_lines_linter = NULL, #check there are no trailing blank lines.
-## ## trailing_whitespace_linter = NULL, #check there are no trailing whitespace characters.
-## object_camel_case_linter = NULL
-## )
-## )
-## })
Deleted: pkg/sse/tests/testthat/test-oldStylepowPar.R
===================================================================
--- pkg/sse/tests/testthat/test-oldStylepowPar.R 2019-08-16 20:33:44 UTC (rev 31)
+++ pkg/sse/tests/testthat/test-oldStylepowPar.R 2019-08-16 20:37:45 UTC (rev 32)
@@ -1,44 +0,0 @@
-context("Old style powPar object")
-
-library(testthat)
-library(sse)
-
-test_that("theta.name", {
- psi <- powPar(delta = seq(from = 0.5, to = 1.5, by = 0.05),
- n = seq(from = 20, to = 60, by = 2),
- theta.name = "delta")
- expect_equal(theta(psi), 0.5)
-
- ## theta.name and theta
- expect_warning(powPar(theta = seq(from = 0.5, to = 1.5, by = 0.05),
- n = seq(from = 20, to = 60, by = 2),
- delta = 1:10,
- theta.name = "delta"))
-})
-
-
-
-test_that("xi.name", {
- ## a xi.name without corresponding entry with xi
- expect_warning(
- powPar(theta = seq(from = 0.5, to = 1.5, by = 0.05),
- n = seq(from = 20, to = 60, by = 2),
- xi = 1:3,
- xi.name = "delta")
- )
- ## a xi.name without corresponding entry without xi
- expect_error(
- powPar(theta = seq(from = 0.5, to = 1.5, by = 0.05),
- n = seq(from = 20, to = 60, by = 2),
- xi.name = "delta")
- )
-
- psi.xi <- powPar(theta = seq(from = 0.5, to = 1.5, by = 0.05),
- delta = seq(from = 0.5, to = 1.5, by = 0.05),
- n = seq(from = 20, to = 60, by = 2),
- xi.name = "delta")
- expect_equal(xi(psi.xi), 0.5)
- expect_equal(psi.xi at xi.name, "delta")
-
-
-})
Deleted: pkg/sse/tests/testthat/test-parallel.R
===================================================================
--- pkg/sse/tests/testthat/test-parallel.R 2019-08-16 20:33:44 UTC (rev 31)
+++ pkg/sse/tests/testthat/test-parallel.R 2019-08-16 20:37:45 UTC (rev 32)
@@ -1,118 +0,0 @@
-## context("Test using of parallel computations")
-
-## library(sse)
-## library(testthat)
-## ### ------------------------------------------------------------------
-## ### with pilot data and several endpoints
-## pilot.data <- rnorm(1000)
-## #
-## psi <- powPar(F.hat = pilot.data,
-## delta = seq(from = 0.5, to = 1.5, by = 0.05),
-## n = seq(from = 20, to = 50, by = 2),
-## theta.name = "delta")
-
-## powFun <- function(psi){
-## a <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE)
-## b <- sample(pp(psi, "F.hat"), size = n(psi) / 2, replace = TRUE) + theta(psi)
-## w <- wilcox.test(a, b)$p.value < 0.05
-## t <- t.test(a, b)$p.value < 0.05
-## return(c(w = w, t = t))
-## }
-
-## calc <- powCalc(psi, statistic = powFun, n.iter = 99, cluster = TRUE)
-## calc.4 <- powCalc(psi, statistic = powFun, n.iter = 99, cluster = 4)
-## calc.1 <- powCalc(psi, statistic = powFun, n.iter = 99, cluster = 1)
-## calc.niter1 <- powCalc(psi, statistic = powFun, n.iter = 1, cluster = TRUE)
-
-## pow.w <- powEx(calc, theta = 1, drop = 0.1, endpoint = "w")
-
-## test_that("update without any changes", {
-## pow.w.u <- update(pow.w)
-## expect_equal(pow.w, pow.w.u, check.attributes = TRUE)
-## })
-
-## pow.w.rf <- refine(pow.w)
-## pow.w.rfrf <- refine(pow.w.rf)
-
-
-## plot(pow.w, smooth = 0.5, ## FIXME does not work with calc.niter1
-## xlab = expression(paste("Delta, ", delta)),
-## ylab = "Total sample size",
-## main = "Wilcoxon Test")
-
-## pow.t <- powEx(calc, theta = 1, drop = 0.1, endpoint = "t")
-
-## plot(pow.t, smooth = 0.5,
-## xlab = expression(paste("Delta, ", delta)),
-## ylab = "Total sample size",
-## main = "T- Test",
-## ylim = c(30, 40))
-
-## ## parametric resampling:
-## psi.parametric <- powPar(delta = seq(from = 0.5, to = 1.5, by = 0.05),
-## xi = seq(from = 0.5, to = 1.5, by = 0.5),
-## n = seq(from = 20, to = 50, by = 2),
-## theta.name = "delta")
-
-
-## powFun.parametric <- function(psi){
-## a <- rnorm(n(psi), mean = 0, sd = xi(psi))
-## b <- rnorm(n(psi), mean = theta(psi), sd = xi(psi))
-## w <- wilcox.test(a, b)$p.value < 0.05
-## t <- t.test(a, b)$p.value < 0.05
-## return(c(w = w, t = t))
-## }
-
-## calc.parametric <- powCalc(psi.parametric,
-## statistic = powFun.parametric,
-## n.iter = 99)
-
-## pow.t.parametric <- powEx(calc.parametric,
-## xi = 1,
-## theta = 1,
-## drop = 0.1,
-## endpoint = "t")
-
-## pow.t.parametric.xi05 <- powEx(calc.parametric,
-## xi = 0.5,
-## theta = 1,
-## drop = 0.1,
-## endpoint = "t")
-
-## plot(pow.t.parametric)
-
-## ### --------------------------------- TESTS
-## test_that("", {
-## #
-## ## selecting an endpoint that does not exist
-## expect_error(
-## powEx(calc, theta = 1, drop = 0.1, endpoint = "T") ## READ ERROR MESSAGE
-## )
-## })
-
-
-## test_that("powPar with data", {
-## #
-## ## data extracted from psi is like the original
-## expect_equal(pp(psi, "F.hat"), pilot.data)
-## })
-
-## test_that("powCalc", {
-## expect_warning(
-## powCalc(psi, statistic = powFun, n.iter = 99, cluster = c(4, 8))
-## )
-## })
-
-## test_that("powEx", {
-## ## choosing and endpoint for example that is not part of the calc-object
-## expect_error(
-## powEx(calc.power, theta = 2, endpoint = "s") ## READ MESSAGE
-## )
-## })
-
-## test_that("plot", {
-## ## power is constant at 1
-## expect_error(
-## plot(pow.t.parametric.xi05)
-## )
-## })
Deleted: pkg/sse/tests/testthat/test-updatePower.R
===================================================================
--- pkg/sse/tests/testthat/test-updatePower.R 2019-08-16 20:33:44 UTC (rev 31)
+++ pkg/sse/tests/testthat/test-updatePower.R 2019-08-16 20:37:45 UTC (rev 32)
@@ -1,181 +0,0 @@
-context("Update, statistic returns a power")
-
-library(sse)
-library(testthat)
-
-## n
-n.l <- list(
-n0 = seq(from = 50, to = 100, by = 10), # ..XXXX.., corse
-n1 = seq(from = 50, to = 100, by = 5), # ..XXXX.., fine
-n2 = c(seq(from = 50, to = 80, by = 2), # ..XXXX.., mixed
- seq(from = 85, to = 100, by = 5)),
-n3 = seq(from = 70, to = 100, by = 10), # ....XX.., corse subset
-n4 = seq(from = 70, to = 150, by = 10), # ..XXXXXX, corse extendet
-n5 = seq(from = 70, to = 150, by = 10), # ....XXXX, corse subset, extended
-n6 = seq(from = 0, to = 150, by = 10), # XXXXXXXX, corse subset, extended
-n7 = seq(from = 160, to = 200, by = 10), # ........XX, corse
-n8.e = c(seq(from = 50, to = 80, by = 2), # mixed with dublicated element
- seq(from = 80, to = 100, by = 5)),
-n9 = 80) # length 1 and existing element
-
-
-## theta
-theta.l <- n.l
-theta.l <- lapply(theta.l, function(x) {
- x / 100
-})
-names(theta.l) <- sub("n", "theta", names(theta.l))
-
-## xi
-xi.l <- list(
- xi0 = seq(from = 1, to = 3, by = 1), # ..XXXX.., corse
- xi1 = seq(from = 1, to = 3, by = 0.5), # ..XXXX.., fixie
- xi2 = c(seq(from = 1, to = 1, by = 1), # ..XXXX.., mixed
- seq(from = 1.5, to = 3, by = 0.5)),
- xi3 = seq(from = 2, to = 3, by = 1), # ....XX.., corse subset
- xi4 = seq(from = 1, to = 5, by = 1), # ..XXXXXX, corse extendet
- xi5 = seq(from = 2, to = 5, by = 1), # ....XXXX, corse subset, extended
- xi6 = seq(from = 0.5, to = 5, by = 0.5), # XXXXXXXX, corse subset, extended
- xi7 = seq(from = 4, to = 5, by = 1), # ........XX, corse
- xi8.e = c(seq(from = 1, to = 2, by = 1), # mixed with dublicated element
- seq(from = 2, to = 5, by = 0.5)),
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/power -r 32
More information about the Power-commits
mailing list