tests/testthat/test_cs1.R

In multiDoE: Multi-Criteria Design of Experiments for Optimal Design

# instance 2 paper 2016
options(digits = 10)

# setting
facts <- list(c(), 1:3)
units <- list(7, 4)
levels <- 3
etas <- list(1)
criteria <- c('I', 'D', 'A')
model <- "quadratic"

# M ####
k <- length(unlist(facts))
k2 <- k * (k - 1) / 2
Mq <- rbind(
  cbind(1, t(integer(k)), t(rep(1, k)) / 3, t(integer(k2))),
  cbind(integer(k), diag(k) / 3, matrix(0, k, k), matrix(0, k, k2)),
  cbind(rep(1, k) / 3, matrix(0, k, k),
        (4 * diag(k) + 5 * matrix(1, k, k)) / 45, matrix(0, k, k2)),
  cbind(integer(k2), matrix(0, k2, k), matrix(0, k2, k), diag(k2) / 9)
)


# test: MSOpt works ####
test_that("MSOpt works", {
  expect_equal(MSOpt(facts, units, levels, etas, criteria, model),
               structure(
                 list(
                   "facts" = list(c(), 1:3),
                   "nfacts" = 3,
                   "nstrat" = 2,
                   "units" = list(7, 4),
                   "runs" = 28,
                   "etas" = list(1),
                   "avlev" = list(c(-1, 0 , 1), c(-1, 0, 1), c(-1, 0, 1)),
                   "levs" = c(3, 3, 3),
                   "Vinv" = t(solve(diag(28) + 1 * kronecker(diag(7), matrix(1, 4, 4)))),
                   "model"  = 'quadratic',
                   "crit" = c('I', 'D', 'A'),
                   "ncrit" = 3,
                   "M" = Mq
                 ),
                 class = c("MSOpt", "list")
               )
  )
})

# test: Score works ####

file_name <- test_path("tests_data/ex_score_cs1.Rds")
print(file_name)
# saveRDS(design_A, file = file_name)
example <- readRDS(file_name)
msopt <- MSOpt(facts, units, levels, etas, criteria, model)

test_that("Score works",{

    # skip_on_cran()
    expect_equal(
    Score(msopt, example),
    data.frame(
      criteria = c("I", "D", "A"),
      score = c(0.3471977990, 0.1038650765, 0.1290310631)
    ),
    tolerance = 0.000000001
  )
})



# test: MSSearch x I-optimality (CE) ####
set.seed(2)
msopt_I <- MSOpt(facts, units, levels, etas, c("I"), model)
#mssearch_I <- MSSearch(msopt_I, 1)
file_name <- test_path("tests_data/mss_I_cs1.Rds")
#saveRDS(mssearch_I, file = file_name)
mss_I_cs1 <- readRDS(file_name)

set.seed(2)
test_that("MSSearch works 1", {
  expect_equal(
    MSSearch(msopt_I, 1),
    structure(
      list(
        "optsol" = mss_I_cs1$optsol,
        "optsc" = data.frame(
            "criteria" = c("I"),
            "score" = mss_I_cs1$optsc
          ),
        "feval" = mss_I_cs1$feval,
        "trend" = mss_I_cs1$trend
      ),
      class = c("MSSearch", "list")
    )
  )
})

# test: MSSearch x I-optimality (CE) + parametri opz. ####
set.seed(2)
#mssearch_I2 <- MSSearch(msopt_I, 1, "Restarts", 50, "Start", example)
file_name <- test_path("tests_data/mss_I2_cs1.Rds")
#saveRDS(mssearch_I2, file = file_name)
mss_I2_cs1 <- readRDS(file_name)

set.seed(2)
test_that("MSSearch works 2", {
  expect_equal(
    MSSearch(msopt_I, 1, "Restarts", 50, "Start", example),
    structure(
      list(
        "optsol" = mss_I2_cs1$optsol,
        "optsc" = data.frame(
          "criteria" = "I",
          "score" = mss_I2_cs1$optsc
        ),
        "feval" = mss_I2_cs1$feval,
        "trend" = mss_I2_cs1$trend
      ),
      class = c("MSSearch", "list")
    )
  )
})

# test: MSSearch x I,D,A-optimality + parametri opz. ####
set.seed(2)
# mssearch3 <- MSSearch(msopt, c(2/4, 1/4, 1/4),
#                         "Restarts", 50,
#                         "Start", example,
#                         "Normalize", c(rep(0.5, 3), rep(1, 3)))
file_name <- test_path("tests_data/mss_3_cs1.Rds")
mss_3_cs1 <- readRDS(file_name)

set.seed(2)
test_that("MSSearch works 3", {
  expect_equal(
    MSSearch(
      msopt, c(2/4, 1/4, 1/4),
        "Restarts", 50,
        "Start", example,
        "Normalize", c(rep(0.5, 3), rep(1, 3))
    ),
    structure(
      list(
        "optsol" = mss_3_cs1$optsol,
        "optsc" = data.frame(
          "criteria" = c("I", "D", "A"),
          "score" = mss_3_cs1$optsc
        ),
        "feval" = mss_3_cs1$feval,
        "trend" = mss_3_cs1$trend
      ),
      class = c("MSSearch", "list")
    )
  )
})



# test: runTPLS ####

lCrit <- length(criteria)
iters <- 3 * lCrit
restarts <- 30
restInit <- 2

file_name <- test_path("tests_data/tpls_cs1.Rds")
#saveRDS(tpls, file = file_name)
tpls_cs1 <- readRDS(file_name)


# test: optMultiCrit ####
file_name <- test_path("tests_data/opt_cs1.Rds")
#saveRDS(tpls1, file = file_name)
tpls1 <- readRDS(file_name)

#res <- optMultiCrit(tpls1$megaAR)
file_name <- test_path("tests_data/res_cs1.Rds")
#saveRDS(res, file = file_name)
res1 <- readRDS(file_name)

test_that("optMultiCrit works",
          {expect_equal(optMultiCrit(tpls1$megaAR),
                        list("solution" = res1$solution, "scores" = res1$scores)
                        )
            }
          )

# test: OptSingleCrit ####

#res2 <- optSingleCrit(tpls1$megaAR)
file_name <- test_path("tests_data/res2_cs1.Rds")
#saveRDS(res2, file = file_name)
res2 <- readRDS(file_name)

test_that("optSingleCrit works",
          {expect_equal(optSingleCrit(tpls1$megaAR),
                        list("I" = res2$I, "D" = res2$D, "A" = res2$A)
          )
          }
)