tests/testthat/test-independent-test-gsPP.R

In gsDesign: Group Sequential Design

source('../gsDesign_independent_code.R')
#---------------
### Testing gsPP:
#---------------

# testing TestCase1_gsPP test.type = 2
testthat::test_that(desc = "Test: checking output validation,
                    source: gsDesign_independent_code.R", 
                    code = {
  x <- gsDesign(k = 4, test.type = 2, n.fix = 800)
  zi <- 1
  theta <- c( 0.00, 0.05, 0.10)
  i=2
  wgts = c(0.4,0.5,0.2)
  r <- 18
  total <- TRUE
  PP <- gsPP(x = x, wgts = c(0.4, 0.5, 0.2), i = 2, theta = c(0.00, 0.05, 0.10), 
             r = 18, zi = 1, total = TRUE)
  expected_PP <- validate_gsPP(x, i, zi , theta , wgts , r , total = total)
  local_edition(3)
  expect_equal(PP,expected_PP)
})



# testing TestCase1_gsPP test.type = 1
testthat::test_that(desc = "Test: checking output validation,
                    source: gsDesign_independent_code.R", 
                    code = {
  x <- gsDesign(k = 4, test.type = 1, n.fix = 800)
  zi <- 0
  theta <- c(0.00, 0.5)
  i = 2
  wgts = c(0.4,0.5)
  r <- 18
  total <- TRUE
  
  PP1 <- gsPP(x = x, wgts = c(0.4, 0.5), i = 2,
             theta = c(0.00, 0.5), r = 18, zi = 0, total = TRUE)
  expected_PP1 <- validate_gsPP(x, i, zi , theta , wgts , r , total = total)
  local_edition(3)
  expect_equal(PP1 , expected_PP1)
})



testthat::test_that(desc = "Test: checking out of range i", 
                    code = {
  x <- gsDesign(k = 3, test.type = 1, n.fix = 800)
  local_edition(3)
  expect_error(gsPP(x = x, wgts = c(0.5, 0.5), i = 4, theta = c(0, 3),
                    r = 18, zi = 0, total = TRUE))
})


testthat::test_that(desc = "Test: zi is not a scalar", 
                    code = {
  x <- gsDesign(k = 3, test.type = 1, n.fix = 800)
  local_edition(3)
  expect_error(gsPP(x = x, wgts = c(0.5, 0.5), i = 1, theta = c(0, 3),
                    r = 18, zi = c(2, 3), total = TRUE))
})


testthat::test_that(desc = "Test: checking out of range zi", 
                    code = {
  x <- gsDesign(k = 3, test.type = 1, n.fix = 800)
  local_edition(3)
  expect_error(gsPP(x = x, wgts = c(0.5, 0.5), i = 1, theta = c(0, 3),
                    r = 18, zi = Inf, total = TRUE))
})



testthat::test_that(desc = "Test: checking out of range zi", code = {
  x <- gsDesign(k = 3, test.type = 1, n.fix = 800)
  local_edition(3)
  expect_error(gsPP(x = x, wgts = c(-1, 1), i = 1, theta = c(0, 3),
                    r = 18, zi = 1, total = TRUE))
})



testthat::test_that(desc = "Test: checking input length", code = {
  x <- gsDesign(k = 3, test.type = 1, n.fix = 800)
  local_edition(3)
  expect_error(gsPP(x = x, wgts = c(0.5, 0.5), i = 1, theta = c(0, 1.5, 3),
                    r = 18, zi = 1, total = TRUE))
})



testthat::test_that(desc = "Test: checking out of range i", code = {
  x <- gsDesign(k = 3, test.type = 1, n.fix = 800)
  local_edition(3)
  expect_error(gsPP(x = x, wgts = c(0.5, 0.5), i = 4, theta = c(0, 3),
                    r = 18, zi = 1, total = TRUE))
})



testthat::test_that(desc = "Test: checking out of range R", 
                    code = {
  x <- gsDesign(k = 3, test.type = 1, n.fix = 800)
  local_edition(3)
  expect_error(gsPP(x = x, wgts = c(0.5, 0.5), i = 2, theta = c(0, 3),
                    r = 81, zi = 1, total = TRUE))
})



testthat::test_that(desc = "Test: class object gsProbability or gsDesign", code = {
  x <- seq(1, 2, 0.5)
  local_edition(3)
  expect_error(gsPP(x,wgts = c(0.4, 0.5, 0.2), i = 2,
                    theta = c(0.00, 0.05, 0.10), r = 18, zi = 1, total = TRUE))
})


# gsPP: total = FALSE.
testthat::test_that(desc = "Test: checking output Validation", code = {
  x <- gsDesign(k = 4, test.type = 2, n.fix = 800)
  zi <- 1
  theta <- c(0.00, 0.05, 0.10)
  i=2
  wgts = c(0.4,0.5,0.2)
  r <- 18
  total <- FALSE
  
  PP <- gsPP(x = x, wgts = c(0.4, 0.5, 0.2), i = 2,
             theta = c(0.00, 0.05, 0.10), r = 18, zi = 1, total = FALSE)

  expected_PP <- validate_gsPP(x, i, zi , theta , wgts , r , total = total)
  local_edition(3)
  expect_equal(PP[1],expected_PP[1])
  expect_equal(PP[2],expected_PP[2])
})