tests/testthat/test_tunable.R

In adoptr: Adaptive Optimal Two-Stage Designs in R

context("tunable parameters")

# preliminaries
n1     <- 25
c1f    <-   .0
c1e    <-  2.0
order  <- 5L
n2_piv <- 40.0
c2_piv <- 1.96

initial_design <- TwoStageDesign(n1, c1f, c1e, n2_piv, c2_piv, order)

dist        <- Normal(two_armed = FALSE)
null        <- PointMassPrior(.0, 1)
alternative <- PointMassPrior(.4, 1)

ess  <- ExpectedSampleSize(dist, alternative)
pow  <- Power(dist, alternative)
toer <- Power(dist, null)


test_that("boundary designs respect tunable", {

    n2   <- seq(100, 40, length.out = order)
    c2   <- seq(2.0, 0.0, length.out = order)
    d    <- TwoStageDesign(n1, c1f, c1e, n2, c2, order)
    d    <- make_fixed(d, n1)
    d_lb <- get_lower_boundary_design(d)
    d_ub <- get_upper_boundary_design(d)

    expect_true(all(
        d@tunable == d_lb@tunable))

    expect_true(all(
        d@tunable == d_ub@tunable))

}) # end 'boundary designs respect tunable'



test_that("fixing parameters works", {

    # can change tunability of relevant parameters
    tmp <<- make_fixed(initial_design, n1, c1f, c1e, n2_pivots, c2_pivots)
    for (name in c("n1", "c1f", "c1e", "n2_pivots", "c2_pivots")) {
        expect_true(
            !tmp@tunable[name])
    }

    # did not affect other fields
    for (name in c("x1_norm_pivots", "weights")) {
        expect_true(
            tmp@tunable[name] == initial_design@tunable[name])
    }

})



test_that("fixed params can be made tunable again",{

    # can we make params 'tunable' again?
    tmp <<- make_tunable(initial_design, n1, c2_pivots)
    for (name in c("n1", "c1f", "c1e")) {
        expect_true(
            tmp@tunable[name])
    }

}) # end 'make_tunable works as desired'



test_that("two stage design can be optimized with fixed first stage", {

    initial_design <- make_fixed(initial_design, n1, c1f, c1e)

    res <- suppressWarnings(

        minimize(
            ess,
            subject_to(
                pow  >= 0.8,
                toer <= .05
            ),
            initial_design,
            opts = list(
                xtol_abs  = 1e-5,
                algorithm = "NLOPT_LN_COBYLA",
                maxiter   = 10 # we do not need convergence,
                               # only see if it works technically!
            )
        )
    )

    # check that fixed params did not change
    expect_equal(
        res$design@n1,
        initial_design@n1,
        tolerance = sqrt(.Machine$double.eps), scale = 1)

    expect_equal(
        res$design@c1f,
        initial_design@c1f,
        tolerance = sqrt(.Machine$double.eps), scale = 1)

    expect_equal(
        res$design@c1e,
        initial_design@c1e,
        tolerance = sqrt(.Machine$double.eps), scale = 1)

})



test_that("two stage design can be optimized with fixed sample sizes", {

    initial_design <- make_fixed(initial_design, n1, n2_pivots)

    res <- suppressWarnings(

        minimize(
             ess,
            subject_to(
                pow  >= 0.8,
                toer <= .05
            ),
            initial_design,
            opts = list(
                xtol_abs  = 1e-5,
                algorithm = "NLOPT_LN_COBYLA",
                maxiter   = 10 # we do not need convergence,
                               # only see if it works technically!
            )
        )
    )

    # check that fixed params did not change
    expect_equal(
        res$design@n1,
        initial_design@n1,
        tolerance = sqrt(.Machine$double.eps), scale = 1)

    expect_equal(
        res$design@n2_pivots,
        initial_design@n2_pivots,
        tolerance = sqrt(.Machine$double.eps), scale = 1)

})  # end 'two-stage design can be optimized with fixed sample sizes'




test_that("group-sequential design can be optimized with fixed sample sizes", {

    initial_gs_design <- make_fixed(
        GroupSequentialDesign(25, .0, 2.0, 50.0, 2.0, order),
        n1, n2_pivots)

    res <- suppressWarnings(

        minimize(
            ess,
            subject_to(
                pow  >= 0.8,
                toer <= .05
            ),
            initial_gs_design,
            opts = list(
                algorithm   = "NLOPT_LN_COBYLA",
                xtol_abs    = 1e-5,
                maxiter     = 10
            )
        )
    )

    # check that fixed params did not change
    expect_equal(
        res$design@n1,
        initial_gs_design@n1,
        tolerance = sqrt(.Machine$double.eps), scale = 1)

    expect_equal(
        res$design@n2_pivots,
        initial_gs_design@n2_pivots,
        tolerance = sqrt(.Machine$double.eps), scale = 1)

}) # end 'group-sequential design can be optimized with fixed sample sizes'



test_that("one-stage design can be optimized with fixed sample sizes", {

    initial_os_design <- make_fixed(OneStageDesign(60.0, 2.0), c1f)

    res <- minimize(
        ess,
        subject_to(
            pow >= 0.8,
            toer <= 0.025
            ),
        initial_os_design
    )

    # check that fixed params did not change
    expect_equal(
        res$design@c1f,
        initial_os_design@c1f,
        tolerance = sqrt(.Machine$double.eps), scale = 1)

}) # end 'one-stage design can be optimized with fixed sample sizes'