context("constraint specifications ") design <- TwoStageDesign(25, 0, 2, 40.5, 1.96, 5L) test_that("UnconditionalConstraints", { pow <- Power(Normal(two_armed = FALSE), PointMassPrior(.4, 1)) toer <- Power(Normal(two_armed = FALSE), PointMassPrior(.0, 1)) cnstr <- pow >= 0.8 pow_true <- mean(adoptr::simulate (design, nsim = 10^6, dist = Normal(two_armed = FALSE), theta = .4, seed = 42)$reject) # see if it evaluates to the right value expect_equal( evaluate(cnstr, design), (.8 - pow_true), tolerance = 1e-3, scale = 1) # compute true value toer_true <- mean(adoptr::simulate (design, nsim = 10^6, dist = Normal(two_armed = FALSE), theta = .0, seed = 142)$reject) expect_equal( evaluate(toer <= .05, design), (toer_true - .05), tolerance = 1e-3, scale = 1) # Check syntax expect_true( evaluate(subject_to(pow >= .8), design) == evaluate(subject_to(.8 <= pow), design)) expect_true( evaluate(subject_to(.05 >= toer), design) == evaluate(subject_to(toer <= .05), design)) }) test_that("ConditionalConstraints", { # create conditional power cp <- ConditionalPower(Normal(two_armed = FALSE), PointMassPrior(.4, 1)) cnstr <- cp >= 0.8 expect_equal( evaluate(cnstr, design, .8), 0.0844, tolerance = 1e-3, scale = 1) # check other direction ctoer <- ConditionalPower(Normal(two_armed = FALSE), PointMassPrior(.0, 1)) expect_equal( evaluate(ctoer <= .05, design, .8), -.0250, tolerance = 1e-3, scale = 1) }) test_that("ConditionalConstraints", { cp <- ConditionalPower(Normal(two_armed = FALSE), PointMassPrior(.4, 1)) css <- ConditionalSampleSize() # construct a constraint set and see if it is at least of the right length expect_true( length(evaluate(subject_to(cp >= .6, cp >= .5), design)) == 10) # Use non-rounded values expect_equal( evaluate(css, design, 1, optimization = TRUE), 65.5, tolerance = 1e-3, scale = 1) # Use rounded values expect_equal( evaluate(css, design, 1), 65.0, tolerance = 1e-3, scale = 1) # Check syntax expect_true(all( evaluate(subject_to(cp >= .8), design) == evaluate(subject_to(.8 <= cp), design))) expect_true(all( evaluate(subject_to(css <= 500), design) == evaluate(subject_to(500 >= css), design))) }) test_that("subject_to throws correct error", { expect_error(subject_to(1)) }) # end 'subject_to throws correct error' test_that("score vs score inequalities", { cp <- ConditionalPower(Normal(), PointMassPrior(.28, 1)) ctoer <- ConditionalPower(Normal(), PointMassPrior(.0, 1)) pow <- expected(cp, Normal(), PointMassPrior(.28, 1)) toer <- expected(ctoer, Normal(), PointMassPrior(.0, 1)) expect_true(all( evaluate(subject_to(ctoer <= cp), design) == evaluate(subject_to(cp >= ctoer), design))) expect_true( evaluate(subject_to(toer <= pow), design) == evaluate(subject_to(pow >= toer), design)) }) # end 'score vs score inequalities' test_that("output of constraints can be of different length", { toer <- Power(Normal(), PointMassPrior(0, 1)) setClass("C2Difference", contains = "UnconditionalScore") C2Difference <- function() new("C2Difference") setMethod("evaluate", signature("C2Difference", "TwoStageDesign"), function(s, design, optimization = FALSE, ...) diff(c2(design, scaled_integration_pivots(design))) ) c2d <- C2Difference() cnstrs <- subject_to(toer <= .025, c2d <= 0) expect_equal(length(evaluate(cnstrs, design)), length(design@c2_pivots)) })