tests/testthat/test-pmxClass.R

if (helper_skip()) {

  context("Test pmxClass")
  pmxClassHelpers <- test_pmxClass_helpers()

  #test_that("can create pmx class", {
  #  ctr <- pmxClassHelpers$ctr
  #  expect_is(ctr, "pmxClass")
  #  expect_identical(
  #    sort(ctr %>% plot_names()),
  #    sort(c(
  #      "abs_iwres_ipred", "abs_iwres_time", "iwres_ipred", "npde_time", "iwres_time",
  #      "npde_pred", "dv_pred", "dv_ipred", "eta_hist", "eta_box", "individual",
  #      "eta_matrix", "eta_cats", "eta_conts",
  #      "iwres_qq", "npde_qq", "eta_qq", "iwres_dens"
  #    ))
  #  )
  #})
  #
  #test_that("can print pmx class", {
  #  ctr <- pmxClassHelpers$ctr
  #  expect_output(print(ctr), "pmx object:")
  #})
  #
  #test_that("can remove plot from pnmx class", {
  #  ctr <- pmxClassHelpers$ctr
  #  cplots <- ctr %>% plot_names()
  #  ctr$remove_plot(cplots[1])
  #  res <- setdiff(cplots, ctr %>% plot_names())
  #  expect_identical(res, cplots[1])
  #})
  #
  #test_that("can get pmx class config", {
  #  ctr <- pmxClassHelpers$ctr
  #  cplots <- ctr %>% plot_names()
  #  conf <- ctr$get_config("npde_time")
  #  clabels <- list(
  #    title = "NPDE vs TIME",
  #    subtitle = "",
  #    x = "TIME",
  #    y = "NPDE"
  #  )
  #  expect_identical(conf$gp$labels, clabels)
  #})
  ##------------------- get_data - start ------------------------------------------
  #
  #test_that("get_data: params NULL result: error missing arguments", {
  #  expect_error(get_data())
  #})
  #
  #test_that("get_data: params ctr result: error ctr is not a pmxClass object", {
  #  ctr <- ""
  #  expect_error(get_data(ctr))
  #})
  #
  #test_that("can get data from controller", {
  #  ctr <- pmxClassHelpers$ctr
  #  get_d <- ctr %>% get_data(data_set = "individual")
  #  expect_true(inherits(get_d, c("data.table", "data.frame")))
  #})
  #
  #test_that("can get data from controller", {
  #  ctr <- pmxClassHelpers$ctr
  #  inputData <- ctr %>% get_data("input")
  #  inNames <- c("ID", "DV", "TIME", "SEX", "WT0", "AGE0", "STUD")
  #  expect_true(all(inNames %in% names(inputData)))
  #
  #  peData <- ctr %>% get_data("estimates")
  #  peNames <- c("PARAM", "VALUE", "SE", "RSE", "PVALUE")
  #  expect_identical(names(peData), peNames)
  #
  #  mpData <- ctr %>% get_data("predictions")
  #  mpNames <- c(
  #    "ID", "TIME", "PRED", "NPDE", "IPRED", "IWRES", "DV",
  #    "SEX", "WT0", "AGE0", "STUD"
  #  )
  #  expect_true(all(mpNames %in% names(mpData)))
  #
  #  fgData <- ctr %>% get_data("finegrid")
  #  fgNames <- c("ID", "TIME", "PRED", "IPRED")
  #  expect_true(all(fgNames %in% names(fgData)))
  #})
  #
  ##------------------- get_data - end --------------------------------------------
  #
  ##------------------- set_plot - start ------------------------------------------
  #
  #test_that("set_plot: params NULL result: error missing arguments", {
  #  expect_error(set_plot())
  #})
  #
  #
  #test_that("set_plot: params ctr result: error ctr is not a pmxClass object", {
  #  ctr <- ""
  #  expect_error(set_plot(ctr))
  #})
  #
  #test_that("set_plot: params: ptype, pname, type result: error pname is not a character or NULL", {
  #  ctr <- pmxClassHelpers$ctr
  #  expect_error(ctr %>% set_plot("DIS", pname = 1, type = "box"))
  #})
  #
  #test_that("set_plot: params: ptype, pname result: error strat.color is not a character or NULL", {
  #  ctr <- pmxClassHelpers$ctr
  #  expect_error(ctr %>% set_plot("DIS", pname = "distr2", strat.color = TRUE))
  #})
  #
  #test_that("set_plot: params: ptype, pname result: error strat.facet is not a character or formula or NULL", {
  #  ctr <- pmxClassHelpers$ctr
  #  expect_error(ctr %>% set_plot("DIS", pname = "distr2", strat.facet = TRUE))
  #})
  #
  #
  #test_that("set_plot: params: ptype, pname result: identical names", {
  #  ctr <- pmxClassHelpers$ctr
  #  spl <- ctr %>% set_plot("DIS", pname = "distr1", type = "box")
  #  setNames <- c(
  #    ".__enclos_env__", "sim_blq", "time", "id", "bloq", "sim",
  #    "plot_file_name", "report_n", "report_queue", "save_dir", "footnote", "warnings",
  #    "endpoint", "abbrev", "re", "has_re", "settings", "strats",
  #    "occ", "conts", "cats", "dvid", "dv", "input_file",
  #    "input", "config", "data", "clone", "post_load", "plots",
  #    "get_plot", "set_config", "get_config", "remove_plot", "update_plot", "add_plot",
  #    "dequeue_plot", "enqueue_plot", "print", "initialize"
  #  )
  #  expect_identical(setNames, names(spl))
  #})
  #
  #test_that("can set plot and filter", {
  #  # set new plot
  #  ctr <- pmxClassHelpers$ctr
  #  ctr %>% set_plot("DIS", pname = "distr1", type = "box")
  #  p <- ctr %>% get_plot("distr1")
  #  pconf <- ggplot2::ggplot_build(p)
  #  expect_equal(length(pconf$data), 5)
  #  # set plot and filter
  #  ctr %>% set_plot("DIS", pname = "distr2", filter = ID < 10, type = "box")
  #  p <- ctr %>% get_plot("distr2")
  #  pconf <- ggplot2::ggplot_build(p)
  #  expect_equal(length(pconf$data), 5)
  #})
  #
  ##------------------- set_plot - end --------------------------------------------
  #
  #test_that("can disable draft for all plots", {
  #  theophylline <- file.path(
  #    system.file(package = "ggPMX"), "testdata",
  #    "theophylline"
  #  )
  #  WORK_DIR <- file.path(theophylline, "Monolix")
  #  input_file <- file.path(theophylline, "data_pk.csv")
  #
  #  ctr <-
  #    pmx_mlx(
  #      config = "standing",
  #      directory = WORK_DIR,
  #      input = input_file,
  #      dv = "Y",
  #      dvid = "DVID",
  #      cats = c("SEX"),
  #      conts = c("WT0", "AGE0"),
  #      strats = "STUD",
  #      settings = pmx_settings(is.draft = FALSE)
  #    )
  #
  #  is_draft <- vapply(
  #    ctr %>% plot_names(),
  #    function(p) {
  #      conf <- ctr %>% get_plot_config(p)
  #      conf$gp[["is.draft"]]
  #    }, TRUE
  #  )
  #  expect_false(any(is_draft))
  #})
  #
  #
  #test_that("can set draft to false for a single plot", {
  #  ctr <- pmxClassHelpers$ctr
  #  p <- ctr %>% pmx_plot_dv_pred(is.draft = FALSE)
  #})
  #
  #
  #
  #test_that("can create a controller with data.frame as input", {
  #  theophylline <- file.path(
  #    system.file(package = "ggPMX"), "testdata",
  #    "theophylline"
  #  )
  #  WORK_DIR <- file.path(theophylline, "Monolix")
  #  input_file <- file.path(theophylline, "data_pk.csv")
  #
  #  dat <- read.csv(input_file)
  #  dat$SEX <- factor(dat$SEX, levels = c(0, 1), labels = c("M", "F"))
  #
  #
  #  ctr4 <- pmx(
  #    config = "standing", sys = "mlx",
  #    directory = WORK_DIR,
  #    input = dat,
  #    dv = "Y",
  #    dvid = "DVID",
  #    cats = "SEX"
  #  )
  #
  #  expect_equal(nrow(ctr4 %>% get_data("input")), nrow(dat))
  #})
  #
  ##------------------- pmx_settings - start ---------------------------------------
  #
  #test_that("pmx_settings: params effects result: error effects should be a list", {
  #  effects <- c(
  #    levels = c("ka", "V", "Cl"),
  #    labels = c("Concentration", "Volume", "Clearance")
  #  )
  #  expect_error(pmx_settings(effects = effects))
  #})
  #
  #test_that("pmx_settings: params effects result: error effects should be a list
  #          that contains levels and labels", {
  #  effects <- list(
  #    lev = c("ka", "V", "Cl"),
  #    lab = c("Concentration", "Volume", "Clearance")
  #  )
  #  expect_error(pmx_settings(effects = effects))
  #})
  #
  #test_that("pmx_settings: params effects result: error effects should be a list
  #          that contains levels and labels have the same length", {
  #  effects <- list(
  #    levels = c("ka"),
  #    labels = c("Concentration", "Volume", "Clearance")
  #  )
  #  expect_error(pmx_settings(effects = effects))
  #})
  #
  #
  #test_that("pmx_settings: params is.draft result: identical names", {
  #  setg <- pmx_settings(is.draft = FALSE)
  #  settNames <- c(
  #    "is.draft", "use.abbrev", "color.scales", "use.labels", "cats.labels",
  #    "use.titles", "effects", "covariates"
  #  )
  #  expect_identical(settNames, names(setg))
  #})
  #
  #test_that(
  #  "can create controller global settings",
  #  expect_is(pmx_settings(), "pmxSettingsClass")
  #)
  #
  ##------------------- pmx_settings - start --------------------------------------
  #
  ##------------------- pmx_mlxtran - start ---------------------------------------
  #
  #test_that("pmx_mlxtran: params NULL result: error missing arguments", {
  #  expect_error(pmx_mlxtran())
  #})
  #
  #
  #test_that("pmx_mlxtran: params: file_name, endpoint, ect.;  result: identical structure", {
  #  mlxtran_path <- file.path(system.file(package = "ggPMX"), "testdata", "*_popPK_model", "project.mlxtran")
  #  ep <- pmx_endpoint(
  #    code = "1",
  #    file.code = "2"
  #  )
  #  ctr <- pmx_mlxtran(file_name = mlxtran_path, version = 1, endpoint = ep)
  #  expect_identical(ctr$endpoint$file.code, "2")
  #})
  #
  #test_that("pmx_mlxtran: params: file_name, endpoint, call = TRUE, ect.;  result: identical sturcture", {
  #  mlxtran_path <- file.path(system.file(package = "ggPMX"), "testdata", "*_popPK_model", "project.mlxtran")
  #  ep <- pmx_endpoint(
  #    code = "1",
  #    file.code = "2"
  #  )
  #  ctr <- pmx_mlxtran(file_name = mlxtran_path, version = 1, endpoint = ep, call = TRUE)
  #  expect_identical(ctr$config, "standing")
  #  expect_identical(ctr$dvid, "YTYPE")
  #  expect_identical(ctr$dv, "DV")
  #})
  #
  #
  #test_that("can create a controller from mlxtran with explicit path", {
  #  mlxtran_path <- file.path(system.file(package = "ggPMX"), "testdata", "1_popPK_model", "project.mlxtran")
  #  ctr <- pmx_mlxtran(file_name = mlxtran_path)
  #  expect_is(ctr, "pmxClass")
  #})
  #
  #test_that("can catch absence of version, when wildcard is used in file_name", {
  #  mlxtran_path <- file.path(system.file(package = "ggPMX"), "testdata", "*_popPK_model", "project.mlxtran")
  #  error_msg_wrong_version <- "Using wildcard in file_name assume providing non-negative version"
  #  error_msg_not_exist <- "file do not exist"
  #  expect_error(pmx_mlxtran(file_name = mlxtran_path), error_msg_wrong_version, fixed = TRUE)
  #  expect_error(pmx_mlxtran(file_name = mlxtran_path, version = -5), error_msg_wrong_version, fixed = TRUE)
  #  expect_error(pmx_mlxtran(file_name = mlxtran_path, version = 2), error_msg_not_exist, fixed = TRUE)
  #})
  #
  #test_that("can create a controller from mlxtran with wildcard in path", {
  #  mlxtran_path <- file.path(system.file(package = "ggPMX"), "testdata", "*_popPK_model", "project.mlxtran")
  #  ctr <- pmx_mlxtran(file_name = mlxtran_path, version = 1)
  #  expect_is(ctr, "pmxClass")
  #})
  ##------------------- pmx_mlxtran - end -----------------------------------------
  #
  ##------------------- pmx_sim - start -------------------------------------------
  #
  #test_that("pmx_sim: params result: pmxSimClass, list", {
  #  theo_path <- file.path(
  #    system.file(package = "ggPMX"), "testdata",
  #    "theophylline"
  #  )
  #  vpc_file <- file.path(theo_path, "sim.csv")
  #  sim <- pmx_sim(
  #    file = vpc_file,
  #    irun = "rep",
  #    idv = "TIME"
  #  )
  #
  #  expect_true(inherits(sim, c("pmxSimClass", "list")))
  #  expect_identical(sim$irun, "rep")
  #  simNames <- c("sim", "irun", "idv")
  #  expect_true(all(simNames %in% names(sim)))
  #  expect_error(pmx_sim())
  #})
  #
  #test_that("pmx_sim: params result: default values of the arguments", {
  #  theo_path <- file.path(
  #    system.file(package = "ggPMX"), "testdata",
  #    "theophylline"
  #  )
  #  vpc_file <- file.path(theo_path, "sim.csv")
  #  sim <- pmx_sim(
  #    file = vpc_file,
  #    irun = "rep"
  #  )
  #
  #  expect_identical(sim$data, NULL)
  #  expect_identical(sim$idv, "TIME")
  #  expect_true(inherits(sim$sim, c("data.table", "data.frame")))
  #})
  ##------------------- pmx_sim - end ---------------------------------------------
  #
  ##------------------- check_argument - start ------------------------------------
  #
  #test_that("check_argument: params value, pmxname = 'work_dir' result: identical inherits", {
  #  theophylline <- file.path(
  #    system.file(package = "ggPMX"), "testdata",
  #    "theophylline"
  #  )
  #  WORK_DIR <- file.path(theophylline, "Monolix")
  #  directory <- check_argument(WORK_DIR, "work_dir")
  #  expect_true(inherits(directory, "character"))
  #})
  #test_that("check_argument: params value, pmxname = 'input' result: identical inherits", {
  #  theophylline <- file.path(
  #    system.file(package = "ggPMX"), "testdata",
  #    "theophylline"
  #  )
  #
  #  input_file <- file.path(theophylline, "data_pk.csv")
  #  input <- check_argument(input_file, "input")
  #  expect_true(inherits(input, "character"))
  #})
  #
  #test_that("check_argument: params NULL result: error missing arguments", {
  #  expect_error(check_argument())
  #})
  #
  #test_that("check_argument: params value = NULL, pmxname  result: error set a NULL argument", {
  #  expect_error(check_argument(value = NULL, pmxname = "work_dir"))
  #})
  #
  ##------------------- check_argument - end --------------------------------------
  #
  ##------------------- pmx - start -----------------------------------------------
  #test_that("pmx: params NULL result: error missing arguments", {
  #  expect_error(pmx())
  #})
  #
  #test_that("pmx: params: fit result: default values of the arguments ", {
  #  theophylline <- file.path(
  #    system.file(package = "ggPMX"), "testdata",
  #    "theophylline"
  #  )
  #  WORK_DIR <- file.path(theophylline, "Monolix")
  #  input_file <- file.path(theophylline, "data_pk.csv")
  #  pm <- pmx(directory = WORK_DIR, input = input_file, dv = "EVID")
  #  settings <- pmx_settings()
  #
  #  expect_identical(pm$cats, "")
  #  expect_identical(pm$conts, "")
  #  expect_identical(pm$occ, "")
  #  expect_identical(pm$strats, "")
  #  expect_false(pm$sim_blq)
  #  expect_identical(pm$dvid, "DVID")
  #  expect_identical(pm$endpoint, NULL)
  #  expect_identical(pm$settings, settings)
  #  expect_identical(pm$bloq, NULL)
  #  expect_identical(pm$sim, NULL)
  #})
  #
  #test_that("pmx: params; result:  error class cat, conts, occ, strats, bloq
  #          are not valid character vectors", {
  #  theophylline <- file.path(
  #    system.file(package = "ggPMX"), "testdata",
  #    "theophylline"
  #  )
  #  WORK_DIR <- file.path(theophylline, "Monolix")
  #  input_file <- file.path(theophylline, "data_pk.csv")
  #  expect_error(pmx(directory = WORK_DIR, input = input_file, dv = "EVID", cats = 1))
  #  expect_error(pmx(directory = WORK_DIR, input = input_file, dv = "EVID", conts = 1))
  #  expect_error(pmx(directory = WORK_DIR, input = input_file, dv = "EVID", occ = 1))
  #  expect_error(pmx(directory = WORK_DIR, input = input_file, dv = "EVID", strats = 1))
  #  expect_error(pmx(directory = WORK_DIR, input = input_file, dv = "EVID", bloq = 1))
  #})
  #
  ##------------------- pmx - end -------------------------------------------------
  #
  #------------------- pmx_mlx - end ---------------------------------------------

  test_that("pmx_mlx: params NULL result: error missing arguments", {
    expect_error(pmx_mlx())
  })

  test_that("pmx_mlx: params; result: identical inherits", {
    theophylline <- file.path(
      system.file(package = "ggPMX"), "testdata",
      "theophylline"
    )
    WORK_DIR <- file.path(theophylline, "Monolix")
    input_file <- file.path(theophylline, "data_pk.csv")

    ctr <-
      pmx_mlx(
        config = "standing",
        directory = WORK_DIR,
        input = input_file,
        dv = "Y",
        dvid = "DVID",
        cats = c("SEX"),
        conts = c("WT0", "AGE0"),
        strats = "STUD",
        settings = pmx_settings(is.draft = FALSE)
      )
    expect_true(inherits(ctr, c("pmxClass", "R6")))
  })
  #------------------- pmx_mlx - end ---------------------------------------------

  #------------------- formula_to_text - end -------------------------------------

  test_that("formula_to_text: params NULL result: error missing arguments", {
    expect_error(formula_to_text())
  })

  test_that("formula_to_text: params form result: identical inherits", {
    f1 <- formula_to_text("strat.facet")
    f2 <- formula_to_text(EFFECT ~ variable)
    f3 <- formula_to_text(1)
    expect_true(inherits(f1, "character"))
    expect_true(inherits(f2, "character"))
    expect_true(inherits(f3, "numeric"))
  })

  test_that("pmx_settings are applied to the plot", {
    my_settings <- pmx_settings(
      effects=list(
        levels=c("Cl","ka","V"),
        labels=c("Clearance", "Absorption_rate", "Volume")
      ),
      covariates=pmx_cov(values=list("SEX"), labels=list("Sex"))
    )

    theophylline <- file.path(
      system.file(package="ggPMX"),
      "testdata",
      "theophylline"
    )

    WORK_DIR <- file.path(theophylline, "Monolix")
    input_file <- file.path(theophylline, "data_pk.csv")

    ctr <- pmx_mlx(
      directory=WORK_DIR,
      input=input_file,
      dv="Y",
      dvid="DVID",
      conts=c("WT0", "AGE0"),
      settings=my_settings,
      cats=c("SEX"),
      config="standing", strats=c("STUD")
    )

    p <- ctr %>% pmx_plot_eta_cats()
    expect_identical(levels(p[["data"]][["variable"]]), c("Sex"))
    expect_identical(
      levels(p[["data"]][["EFFECT"]]),
      c("Clearance", "Absorption_rate", "Volume")
    )
  })


  #------------------- formula_to_text - end -------------------------------------

  #------------------- pmx_endpoint - start --------------------------------------

  test_that("pmx_endpoint: params NULL result: error missing arguments", {
    expect_error(pmx_endpoint())
  })

  test_that("pmx_endpoint: params: code, file.code, ect.; result: error code is not a character vector ", {
    expect_error(pmx_endpoint(
      code = 3,
      file.code = "1"
    ))
  })

  test_that("pmx_endpoint: params: code, file.code, ect.; result: error file.code is not a character vector ", {
    expect_error(pmx_endpoint(
      code = "3",
      file.code = 1
    ))
  })

  test_that("pmx_endpoint: params: code, file.code, ect.; result: error label is not a character vector ", {
    expect_error(pmx_endpoint(
      label = 1,
      code = "3",
      file.code = "1"
    ))
  })

  test_that("pmx_endpoint: params: code, file.code, ect.; result: error trans is not a character vector ", {
    expect_error(pmx_endpoint(
      trans = NA,
      code = "3",
      file.code = "1"
    ))
  })

  test_that("pmx_endpoint: params: code, file.code, ect.; result: error unit is not a character vector ", {
    expect_error(pmx_endpoint(
      unit = TRUE,
      code = "3",
      file.code = "1"
    ))
  })

  test_that("pmx_endpoint: params: code, file.code, ect.; result: identical inherits ", {
    ep <- pmx_endpoint(
      code = "3",
      file.code = "1"
    )
    expect_true(inherits(ep, "pmxEndpointClass"))
  })

  test_that("pmx_endpoint: params: code, file.code, ect.; result: identical names ", {
    ep <- pmx_endpoint(
      code = "3",
      file.code = "1"
    )
    epNames <- c("code", "label", "unit", "file.code", "trans")
    expect_identical(names(ep), epNames)
  })

  #------------------- pmx_endpoint - end ----------------------------------------

  #------------------- pmx_bloq - start ------------------------------------------

  test_that("pmx_bloq: params NULL result: identical inherits", {
    expect_true(inherits(pmx_bloq(), "pmxBLOQClass"))
  })

  test_that("pmx_bloq: params: cens, limit; result: identical names ", {
    bloq <- pmx_bloq(cens = "BLOQ_name", limit = "LIMIT_name")
    blNames <- c("cens", "limit", "show", "colour", "size", "linewidth", "alpha")
    expect_identical(names(bloq), blNames)
  })

  test_that("pmx_bloq: params: cens, limit; result: identical structure ", {
    bloq <- pmx_bloq(cens = "BLOQ_name", limit = "LIMIT_name")
    expect_true(bloq$show)
    expect_identical(bloq$cens, "BLOQ_name")
    expect_identical(bloq$colour, "pink")
  })

  #------------------- pmx_bloq - end --------------------------------------------

  #------------------- print.abbreviation - start --------------------------------

  test_that("print.abbreviation: params x result: x is not an abbreviation ", {
    expect_error(print.abbreviation(x = ""))
  })

  test_that("print.abbreviation: params NULL result: error missing arguments", {
    expect_error(print.abbreviation())
  })

  #------------------- print.abbreviation - end ----------------------------------

  #------------------- get_abbrev - start ----------------------------------------

  test_that("get_abbrev: params NULL result: error missing arguments", {
    expect_error(get_abbrev())
  })

  #------------------- get_abbrev - end ------------------------------------------

  #------------------- set_abbrev - start ----------------------------------------

  test_that("set_abbrev: params ctr result: ctr is not a pmxClass", {
    ctr <- ""
    expect_error(ctr %>% set_abbrev())
  })

  test_that("set_abbrev: params NULL result: error missing arguments", {
    expect_error(set_abbrev())
  })

  test_that("set_abbrev: params ctr result: error attempt to set an attribute on NULL", {
    ctr <- pmxClassHelpers$ctr
    ctr$abbrev <- NULL
    expect_error(ctr %>% set_abbrev())
  })
  #------------------- set_abbrev - end ------------------------------------------

  #------------------- get_plot - start ------------------------------------------

  test_that("get_plot: params NULL result: error missing arguments", {
    expect_error(get_plot())
  })

  test_that("get_plot: params: ctr, nplot, which_pages  result: identical inherits", {
    ctr <- pmxClassHelpers$ctr
    get_p <- get_plot(ctr, nplot = "individual", which_pages = 1)
    expect_true(inherits(get_p, c("gg", "ggplot")))
  })

  test_that("get_plot: params: ctr, nplot, which_pages  result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(get_plot(ctr, nplot = "individual", which_pages = 1))
  })

  test_that("get_plot: params: ctr, nplot, which_pages  result: error nplot is not a character", {
    ctr <- pmxClassHelpers$ctr
    expect_error(get_plot(ctr, nplot = list("individual", "eta_hist"), which_pages = 1))
  })

  test_that("get_plot: params: ctr, nplot, which_pages  result: error which_pages
          is not an integer or 'all' or 1L", {
            ctr <- pmxClassHelpers$ctr
            expect_error(get_plot(ctr, nplot = "individual", which_pages = "one"))
          })

  test_that("get_plot: params: ctr, nplot, which_pages  result: error nplot is not valid plot name", {
    ctr <- pmxClassHelpers$ctr
    expect_error(get_plot(ctr, nplot = "indiv", which_pages = 1L))
  })

  test_that("get_plot: params: ctr, nplot, which_pages  result: identical structure", {
    ctr <- pmxClassHelpers$ctr
    get_p <- get_plot(ctr, nplot = "individual", which_pages = 1L)
    expect_equal(get_p$facet$params$nrow, 4)
  })

  test_that("get_plot: params: ctr, nplot, which_pages  result: identical names", {
    ctr <- pmxClassHelpers$ctr
    get_p <- get_plot(ctr, nplot = "individual", which_pages = 1L)
    gplNames <- c(
      "data", "layers", "scales", "mapping", "theme", "coordinates",
      "facet", "plot_env", "labels"
    )
    expect_identical(gplNames, names(get_p))
  })

  #------------------- get_plot - end --------------------------------------------

  #------------------- plot_names - start ----------------------------------------

  test_that("plot_names: params NULL result: error missing arguments", {
    expect_error(plot_names())
  })

  test_that("plot_names: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(plot_names(ctr))
  })

  #------------------- plot_names - end ------------------------------------------

  #------------------- plots - start ---------------------------------------------

  test_that("plots: params NULL result: error missing arguments", {
    expect_error(plots())
  })

  test_that("plots: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(plots(ctr))
  })

  test_that("plots: params: ctr result: identical inherits", {
    ctr <- pmxClassHelpers$ctr
    pp <- plots(ctr)
    expect_true(inherits(pp, c("data.table", "data.frame")))
    expect_true(inherits(pp[[1]], "character"))
  })

  test_that("plots: params: ctr result: identical names", {
    ctr <- pmxClassHelpers$ctr
    pp <- plots(ctr)
    pNames <- c("plot_name", "plot_type", "plot_function")
    expect_identical(pNames, names(pp))
  })

  #------------------- plots - end -----------------------------------------------

  #------------------- get_plot_config - start -----------------------------------

  test_that("get_plot_config: params NULL result: error missing arguments", {
    expect_error(get_plot_config())
  })

  test_that("get_plot_config: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(get_plot_config(ctr))
  })

  test_that("get_plot_config: params: ctr, pname result: identical inherits", {
    ctr <- pmxClassHelpers$ctr
    get_pconf <- get_plot_config(ctr, "individual")
    expect_true(inherits(get_pconf, c("individual", "pmx_gpar")))
  })

  test_that("get_plot_config: params: ctr, pname result: identical structure", {
    ctr <- pmxClassHelpers$ctr
    get_pconf <- get_plot_config(ctr, "individual")
    expect_identical(get_pconf$ptype, "IND")
  })

  #------------------- get_plot_config - end -------------------------------------

  #------------------- set_data - start ------------------------------------------

  test_that("set_data: params NULL result: error missing arguments", {
    expect_error(set_data())
  })

  test_that("set_data: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(set_data(ctr))
  })

  test_that("set_data: params: ctr result: error each data set should be well named", {
    ctr <- pmxClassHelpers$ctr
    expect_error(set_data(ctr, "eta"))
  })

  test_that("set_data: params: ctr result: error arguments is of length zero", {
    ctr <- pmxClassHelpers$ctr
    expect_error(set_data(ctr))
  })

  test_that("set_data: params: ctr, eta result: identical names, inherits", {
    ctr <- theophylline()
    sd <- set_data(ctr, eta = get_data(ctr, "eta")[, EFFECT := factor(
      EFFECT,
      levels = c("ka", "V", "Cl"),
      labels = c("Concentration", "Volume", "Clearance")
    )])
    expect_identical(names(sd), "eta")
    expect_true(inherits(sd, "list"))
    expect_true(inherits(sd$eta, c("data.table", "data.frame")))
  })

  #------------------- set_data - end --------------------------------------------

  #------------------- get_cats - start ------------------------------------------

  test_that("get_cats: params NULL result: error missing arguments", {
    expect_error(get_cats())
  })

  test_that("get_cats: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(get_cats(ctr))
  })

  test_that("get_cats: params: ctr result: identical inherits", {
    ctr <- theophylline()
    gcats <- get_cats(ctr)
    expect_true(inherits(gcats, "character"))
  })

  test_that("Can get cats: params: ctr", {
    ctr <- theophylline()
    gcats <- get_cats(ctr)
    expect_identical(gcats, "SEX")
  })
  #------------------- get_cats - end --------------------------------------------

  #------------------- get_strats - start ----------------------------------------
  test_that("get_strats: params NULL result: error missing arguments", {
    expect_error(get_strats())
  })

  test_that("get_strats: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(get_strats(ctr))
  })

  test_that("get_strats: params: ctr result: identical inherits", {
    ctr <- theophylline()
    gstrats <- get_strats(ctr)
    expect_true(inherits(gstrats, "character"))
  })

  test_that("Can get strats: params: ctr ", {
    ctr <- theophylline()
    gstrats <- get_strats(ctr)
    expect_identical(gstrats, "STUD")
  })
  #------------------- get_strats - end ------------------------------------------

  #------------------- get_covariates - start ------------------------------------
  test_that("get_covariates: params NULL result: error missing arguments", {
    expect_error(get_covariates())
  })

  test_that("get_covariates: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(get_covariates(ctr))
  })

  test_that("get_covariates: params: ctr result: identical inherits", {
    ctr <- theophylline()
    gcov <- get_covariates(ctr)
    expect_true(inherits(gcov, "character"))
  })

  test_that("Can get covariates: params: ctr", {
    ctr <- theophylline()
    gcov <- get_covariates(ctr)
    expect_identical(gcov, c("SEX", "WT0", "AGE0"))
  })
  #------------------- get_covariates - end --------------------------------------

  #------------------- get_conts - start -----------------------------------------

  test_that("get_conts: params NULL result: error missing arguments", {
    expect_error(get_conts())
  })

  test_that("get_conts: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(get_conts(ctr))
  })

  test_that("get_conts: params: ctr result: identical inherits", {
    ctr <- theophylline()
    gconst <- get_conts(ctr)
    expect_true(inherits(gconst, "character"))
  })

  test_that("Can get conts: params: ctr", {
    ctr <- theophylline()
    gconst <- get_conts(ctr)
    expect_identical(gconst, c("WT0", "AGE0"))
  })
  #------------------- get_conts - end -------------------------------------------

  #------------------- get_occ - start -------------------------------------------

  test_that("get_occ: params NULL result: error missing arguments", {
    expect_error(get_occ())
  })

  test_that("get_occ: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(get_occ(ctr))
  })

  test_that("get_occ: params: ctr result: identical inherits", {
    ctr <- theophylline()
    g_occ <- get_occ(ctr)
    expect_true(inherits(g_occ, "character"))
  })

  test_that("Can get occ: params: ctr", {
    ctr <- theophylline()
    g_occ <- get_occ(ctr)
    expect_identical(g_occ, "")
  })
  #------------------- get_occ - end ---------------------------------------------

  #------------------- pmx_print - start -----------------------------------------
  ctr <- pmxClassHelpers$ctr
  theophylline <- file.path(
    system.file(package = "ggPMX"), "testdata",
    "theophylline"
  )
  private <- list(
    .data_path = "",
    .input_path = "",
    .covariates = NULL,
    .plots = list(),
    .plots_configs = list()
  )
  WORK_DIR <- file.path(theophylline, "Monolix")
  input_file <- file.path(theophylline, "data_pk.csv")
  self <- pmx(
    sys = "mlx",
    config = "standing",
    directory = WORK_DIR,
    input = input_file,
    dv = "Y",
    dvid = "DVID"
  )

  test_that("pmx_print: params NULL result: error missing arguments", {
    expect_error(pmx_print())
  })

  test_that("pmx_print can print pmx class", {
    expect_output(pmx_print(self, private), "pmx object:")
  })

  test_that("pmx_print  params: self, private; result: identical inherits", {
    expect_true(inherits(pmx_print(self, private), "pmxConfig"))
  })


  test_that("pmx_shrink: params NULL result: list, pmxShrinkClass", {
    expect_true(inherits(pmx_shrink(), c("list", "pmxShrinkClass")))
  })


  test_that(
    "pmx_shrink: params: fun, size, color, vjust, hjust
  result: list, pmxShrinkClass", {
    expect_true(
      inherits(
        pmx_shrink(fun="sd", size=1, color="red", vjust=1, hjust=1),
        c("list", "pmxShrinkClass")
      )
    )}
  )


  test_that("pmx_shrink: params result: elements in the list", {
    sh_names <- c("fun", "size", "color", "vjust", "hjust")
    expect_true(all(sh_names %in% names(pmx_shrink())))
  })


  test_that("check_shrink: shrink_list result: logical ", {
    expect_true(
      inherits(
        check_shrink(list(fun="sd", size=1, color="red", vjust=1, hjust=1)),
        "logical"
      )
    )
  })


  test_that("check_shrink: shrink_list result: character ", {
    expect_true(
      inherits(
        check_shrink(list(fun="sd", size=1, color="red")), "character"
      )
    )
  })

  test_that("pmx_print params: self, private; result: identical structure", {
    pmx_pr <- pmx_print(self, private)
    expect_identical(pmx_pr$sys, "mlx")
    expect_identical(pmx_pr$plots$ABS_IWRES_IPRED$ptype, "SCATTER")
  })

  #------------------- pmx_print - end -------------------------------------------

  #------------------- pmx_transform - start -------------------------------------

  test_that("pmx_transform: params NULL result: error missing arguments", {
    expect_error(pmx_transform())
  })

  #------------------- pmx_transform - end ---------------------------------------

  #------------------- pmx_copy - end --------------------------------------------

  test_that("pmx_copy: params NULL result: error missing arguments", {
    expect_error(pmx_copy())
  })

  test_that("pmx_copy: params: ctr result: error ctr is not a pmxClass", {
    ctr <- ""
    expect_error(pmx_copy(ctr))
  })


  test_that("pmx_copy: params: ctr result: Creates a deep copy of the controller", {
    ctr <- pmxClassHelpers$ctr
    pmxNames <- c(
      "warnings", "update_plot", "time", "strats", "sim_blq",
      "sim", "settings", "set_config", "save_dir", "report_queue",
      "report_n", "remove_plot", "re", "print", "post_load",
      "plots", "plot_file_name", "occ", "input_file", "input",
      "initialize", "id", "has_re", "get_plot", "get_config",
      "footnote", "enqueue_plot", "endpoint", "dvid", "dv",
      "dequeue_plot", "data", "conts", "config", "clone",
      "cats", "bloq", "add_plot", "abbrev", ".__enclos_env__"
    )
    p_copy <- pmx_copy(ctr, is.draft = FALSE)
    expect_identical(names(p_copy), pmxNames)
    expect_identical(p_copy$conts, c("WT0", "AGE0"))
    expect_true(inherits(p_copy, c("pmxClass", "R6")))
  })

  #------------------- pmx_copy - end --------------------------------------------

  #------------------- print.pmxClass - start ------------------------------------

  test_that("print.pmxClass: params NULL result: error missing arguments", {
    expect_error(print.pmxClass())
  })

  test_that("Can print pmxClass: params ctr", {
    ctr <- pmxClassHelpers$ctr
    expect_output(print.pmxClass(ctr), "pmx object:")
  })

  test_that("print.pmxClass: params ctr is a pmxClass obj; result: identical inherits", {
    ctr <- theophylline()
    expect_true(inherits(print.pmxClass(ctr), "pmxConfig"))
  })
  #------------------- print.pmxClass - end --------------------------------------

  #------------------- pmx_fig_process_wrapup - start ----------------------------

  test_that("pmx_fig_process_wrapup: params NULL result: error missing arguments", {
    expect_error(pmx_fig_process_wrapup())
  })

  test_that("pmx_fig_process_wrapup can wrap up process: params self", {
    expect_true(pmx_fig_process_wrapup(self))
    expect_true(inherits(pmx_fig_process_wrapup(self), "logical"))
  })

  test_that("pmx_fig_process_wrapup params: self result: error queue is not empty", {
    expect_true(pmx_fig_process_wrapup(self))
    self$report_queue <- TRUE
    expect_error(pmx_fig_process_wrapup(self))
    self$report_queue <- list()
  })

  #------------------- pmx_fig_process_wrapup - end ------------------------------

  #------------------- pmx_fig_process_init - start ------------------------------

  test_that("pmx_fig_process_init: params: NULL result: identical inherits", {
    expect_true(inherits(pmx_fig_process_init(), "numeric"))
  })

  test_that("pmx_fig_process_init: params: self result: identical values", {
    pmx_f <- pmx_fig_process_init(self)
    expect_identical(pmx_f, 0)
  })

  #------------------- pmx_fig_process_init - end --------------------------------

  #------------------- pmx_dequeue_plot - start ----------------------------------

  test_that("pmx_dequeue_plot: params: NULL result: error missing arguments", {
    expect_error(pmx_dequeue_plot())
  })

  test_that("pmx_dequeue_plot: params: self result: warning: ... Footnotes may be wrong", {
    expect_message(pmx_dequeue_plot(self))
  })
  test_that("pmx_dequeue_plot: params: self result: identical inherits", {
    self$report_queue <- list(1, 2)
    expect_true(inherits(pmx_dequeue_plot(self), "numeric"))
  })

  test_that("pmx_dequeue_plot can dequeue plot: params: self", {
    self$report_queue <- TRUE
    expect_true(pmx_dequeue_plot(self))
    self$report_queue <- list()
  })

  #------------------- pmx_dequeue_plot - end ------------------------------------

  #------------------- pmx_get_config - start ------------------------------------

  test_that("pmx_get_config: params: NULL result: error missing arguments", {
    expect_error(pmx_get_config())
  })

  #------------------- pmx_get_config - end --------------------------------------

  #------------------- pmx_initialize - start ------------------------------------
  test_that("pmx_initialize: params NULL result: error expecting source path", {
    expect_error(pmx_initialize())
  })
  #------------------- pmx_initialize - start ------------------------------------
}
ggPMXdevelopment/ggPMX documentation built on Dec. 11, 2023, 5:24 a.m.