test-plot-individual.R
In ggPMX: 'ggplot2' Based Tool to Facilitate Diagnostic Plots for NLME Models

library(ggPMX)
library(ggplot2)

context("Test plot_pmx.individual function")
mlxpath <- file.path(
  system.file(package = "ggPMX"),
  "testdata",
  "1_popPK_model",
  "project.mlxtran"
)
ctr <- pmx_mlxtran(mlxpath, config = "standing")

#------------------- pmx_plot_individual start -------------------------------
test_that("pmx_plot_individual: params: no; result: error ctr is missing", {
  expect_error(pmx_plot_individual())
})

test_that("pmx_plot_individual: params: ctr, point; result: identical names", {
  indiv_plot <- pmx_plot_individual(ctr, point = list(
    colour = c("black", "green")
  ))
  indNames <- c("data", "layers", "scales", "mapping", "theme", "coordinates", "facet", "plot_env", "labels")
  expect_identical(names(indiv_plot), indNames)
})


test_that("pmx_plot_individual: params: no; result: ggplot", {
  expect_true(inherits(pmx_plot_individual(ctr), "ggplot"))
})


test_that("pmx_plot_individual: params: ctr, which_pages; result: error which_pages is not an integer or 'all'", {
  expect_error(pmx_plot_individual(ctr, which_pages = c("all", "plot")))
})

test_that("pmx_plot_individual: params: ctr, which_pages; result: error  class ctr is not pmxclass", {
  ctr <- ""
  expect_error(pmx_plot_individual(ctr))
})

test_that("pmx_plot_individual: params: ctr, which_pages, dname; result: error
          individual is not a valid plot name", {
  expect_error(pmx_plot_individual(ctr, which_pages = "all", dname = "IND1"))
})

test_that("pmx_plot_individual: params: ctr, which_pages, dname; result: warning
          individual is not a valid plot name", {
  expect_warning(pmx_plot_individual(ctr, which_pages = "all", dname = "IND", npage = 1))
})


test_that("pmx_plot_individual: params: point; result: ggplot", {
  expect_true(inherits(pmx_plot_individual(ctr, point = list(
    colour = c("black", "green")
  )), "ggplot"))
})


test_that("pmx_plot_individual : doesn't have NA panels after stratifying", {
  ctr <- theophylline()
  # creating some NA data for testing purposes
  ctr[["data"]][["IND"]][["SEX"]][which(ctr[["data"]][["IND"]][["SEX"]] == 1)] <- NA
  # testing both formula and character class strat.facet arguments
  lapply(
    list(
      pmx_plot_individual(ctr, strat.facet=~SEX),
      pmx_plot_individual(ctr, strat.facet="SEX")
    ),
    function(p) {
      built_plot <- ggplot2::ggplot_build(p)
      expect_equal(0,
        sum(is.na(ggplot2::ggplot_build(p)[["layout"]][["layout"]][["SEX"]]))
      )
    }
  )
})


test_that("pmx_plot_individual: params: point (colour and shape); result: ggplot", {
  expect_true(inherits(pmx_plot_individual(ctr, point = list(
    colour = "blue", shape = 24
  )), "ggplot"))
})

test_that("plot_pmx.individual: params: point and pred_line; result: ggplot", {
  expect_true(inherits(
    pmx_plot_individual(
      ctr,
      bloq = pmx_bloq(cens = "BLOQ"),
      point = list(colour = c("blue", "red")),
      pred_line = list(color = "red", alpha = 0.5),
      which_pages = 1
    ),
    "ggplot"
  ))
})
###
test_that("plot_pmx.individual: params: is.legend is FALSE; result: ggplot", {
  expect_true(inherits(
    pmx_plot_individual(
      ctr,
      is.legend = FALSE
    ),
    "ggplot"
  ))
})


test_that("plot_pmx.individual: params: point, ipred_line and pred_line;
          result: ggplot", {
  expect_true(inherits(
    pmx_plot_individual(
      ctr,
      point = list(colour = "blue", shape = 24),
      ipred_line = list(colour = "red"),
      pred_line = list(colour = "green")
    ),
    "ggplot"
  ))
})

test_that("plot_pmx.individual: params: ctr is theophylline; result: ggplot", {
  ctr <- theophylline()
  expect_true(inherits(
    pmx_plot_individual(
      ctr
    ),
    "ggplot"
  ))
})


test_that("plot_pmx.individual: params: ctr is theophylline,
           point, ipred_line and pred_line; result: ggplot", {
  ctr <- theophylline()
  expect_true(inherits(
    pmx_plot_individual(
      ctr,
      point = list(colour = "blue", shape = 24),
      ipred_line = list(colour = "red"),
      pred_line = list(colour = "green")
    ),
    "ggplot"
  ))
})

test_that("plot_pmx.individual: params: ctr is theophylline,
           passing arguments from parent frame; No Error", {
  ctr <- theophylline()

  expect_error(
    {
      f <- function() {
        for (i in 1:2) {
          print(ctr %>% pmx_plot_individual(which_pages = i, facets = list(nrow = 1, ncol = 1)))
        }
      }

      f()
    },
    NA
  )
})

test_that("pmx_plot_individual: params: ctr is theophylline, point; result: identical names", {
  ctr <- theophylline()
  indiv_plot <- pmx_plot_individual(ctr, point = list(
    colour = c("black", "green")
  ))
  indNames <- c("data", "layers", "scales", "mapping", "theme", "coordinates", "facet", "plot_env", "labels")
  expect_identical(names(indiv_plot), indNames)
})

test_that("pmx_plot_individual: params: ctr is theophylline; result: ggplot", {
  ctr <- theophylline()
  expect_true(inherits(pmx_plot_individual(ctr), "ggplot"))
})

test_that("pmx_plot_individual: params: ctr is theophylline,  point; result: ggplot", {
  ctr <- theophylline()
  expect_true(inherits(pmx_plot_individual(ctr, point = list(
    colour = c("black", "green")
  )), "ggplot"))
})

test_that("pmx_plot_individual: params: ctr is theophylline, point (colour and shape); result: ggplot", {
  ctr <- theophylline()
  expect_true(inherits(pmx_plot_individual(ctr, point = list(
    colour = "blue", shape = 24
  )), "ggplot"))
})

test_that("pmx_plot_individual: params: ctr, point (colour and shape), footnote; result: identical structure ", {
  ctr$footnote <- TRUE
  indiv_plot <- pmx_plot_individual(ctr, which_pages = 1, point = list(
    colour = "blue", shape = 24
  ), ctr$footnote)
  expect_identical(indiv_plot$plot_env$p$plot_env$ptype, "IND")
})

test_that("pmx_plot_individual: params: ctr, which_pages, point (colour and shape), print; result: identical output ", {
  indiv_plot <- pmx_plot_individual(ctr, which_pages = 1, point = list(
    colour = "blue", shape = 24
  ), print = TRUE)
  expect_output(indiv_plot, NA)
})

#------------------- pmx_plot_individual end ---------------------------------

#------------------- individual start -------------------------------
test_that("individual: params: lables, facets, dname etc.; result: individual", {
  dx <- ctr %>% get_data("IND")
  labels <- list("DOSE")
  expect_true(inherits(
    individual(
      labels,
      facets = list(
        ncol = 3,
        nrow = 4,
        scales = "free"
      ),
      dname = "IND",
      is.legend = TRUE,
      use.finegrid = TRUE
    ),
    "individual"
  ))
})

test_that("individual: params: labels, facets, dname etc.; result: pmx_gpar", {
  dx <- ctr %>% get_data("IND")
  labels <- list("DOSE")
  expect_true(inherits(
    individual(
      labels,
      facets = list(
        ncol = 3,
        nrow = 4,
        scales = "free"
      ),
      dname = "IND",
      is.legend = TRUE,
      use.finegrid = TRUE
    ),
    "pmx_gpar"
  ))
})

test_that("individual: params: labels, facets, dname etc.; result: identical structure", {
  labels <- list("DOSE")
  ind <- individual(
    labels,
    facets = list(
      ncol = 3,
      nrow = 4,
      scales = "free"
    ),
    dname = "IND",
    is.legend = TRUE,
    use.finegrid = FALSE
  )
  expect_identical(ind$dname, "predictions")
})

test_that("individual: params: labels, facets, dname etc.; result: error argument facets is not a list", {
  labels <- list("DOSE")
  expect_error(individual(
    labels,
    facets = NULL,
    dname = "IND",
    is.legend = TRUE,
    use.finegrid = FALSE
  ))
})

test_that("individual: params: labels, facets, dname etc.; result: error argument labels is not a list", {
  labels <- "DOSE"
  expect_error(individual(
    labels,
    facets = list(
      ncol = 3,
      nrow = 4,
      scales = "free"
    ),
    dname = "IND",
    is.legend = TRUE,
    use.finegrid = FALSE
  ))
})

test_that("individual: params: labels, facets, dname etc.; result: error argument
          dname is not a string or NULL", {
  labels <- list("DOSE")
  expect_error(individual(
    labels,
    facets = list(
      ncol = 3,
      nrow = 4,
      scales = "free"
    ),
    dname = IND,
    is.legend = TRUE,
    use.finegrid = FALSE
  ))
})



test_that("individual: params: labels, facets, dname etc.; result: identical name", {
  labels <- list("DOSE")
  ind <- individual(
    labels,
    facets = list(
      ncol = 3,
      nrow = 4,
      scales = "free"
    ),
    dname = "IND",
    is.legend = TRUE,
    use.finegrid = FALSE
  )
  indNames <- c(
    "ptype", "strat", "is.legend", "use.finegrid", "dname", "aess", "labels",
    "point", "ipred_line", "pred_line", "facets", "bloq", "gp"
  )
  expect_identical(names(ind), indNames)
})

#------------------- plot_pmx.individual end ---------------------------------

#------------------- add_footnote start --------------------------------------
test_that("add_footnote: params: pp, pname, save_dir; result: identical inherits", {
  pp <- ctr %>% get_plot("individual")
  expect_true(inherits(add_footnote(pp[[1]], pname = "indiv1", save_dir = ctr$save_dir), c("gg", "ggplot")))
})

test_that("add_footnote: params: pp, pname, save_dir; result: identical names", {
  pp <- ctr %>% get_plot("individual")
  add_f <- add_footnote(pp[[1]], pname = "indiv1", save_dir = ctr$save_dir)
  fNames <- c("data", "layers", "scales", "mapping", "theme", "coordinates", "facet", "plot_env", "labels")
  expect_equal(names(add_f), fNames)
})

test_that("add_footnote: params: pp, pname, save_dir; result: identical structure", {
  pp <- ctr %>% get_plot("individual")
  add_f <- add_footnote(pp[[1]], pname = "indiv1", save_dir = ctr$save_dir)
  expect_identical(add_f$plot_env$dname, "IND")
  expect_true(add_f$plot_env$gp$is.draft)
  expect_identical(add_f$plot_env$aess$x, "TIME")
  expect_identical(add_f$labels$colour, "isobserv")
})

test_that("add_footnote: params result: error missing arguments", {
  pp <- ctr %>% get_plot("individual")
  expect_error(add_footnote())
  expect_error(add_footnote(pp[[1]]))
  expect_error(add_footnote(pp[[1]], pname = "indiv1"))
  expect_error(add_footnote(pp[[1]], save_dir = ctr$save_dir))
  expect_error(add_footnote(pname = "indiv1", save_dir = ctr$save_dir))
  expect_error(add_footnote(pname = "indiv1"))
  expect_error(add_footnote(save_dir = ctr$save_dir))
})

#------------------- add_footnote end ----------------------------------------