if (helper_skip()) { context("Test residual function") ctr <- theophylline() #------------------- pmx_plot_iwres_ipred start ------------------------------ test_that("residual: params: x equals IWRES, y equals IPRED; result: identical structure", { x <- "IWRES" y <- "IPRED" aess <- list(x = x, y = y) labels <- list( title = paste(rev(aess), collapse = " versus "), subtitle = "", x = aess[["x"]], y = aess[["y"]] ) expect_identical(residual(x, y), structure( list( ptype = "SCATTER", strat = TRUE, dname = "predictions", aess = aess, point = list( shape = 1, colour = "black", size = 1 ), is.hline = FALSE, hline = list(yintercept = 0), facets = NULL, bloq = NULL, square_plot = TRUE, gp = pmx_gpar(labels = labels) ), class = c("residual", "pmx_gpar") )) }) #------------------- residual start ------------------------------------------ test_that("residual: params: x, y; result: error x, y is missing ", { x <- "IWRES" y <- "IPRED" expect_error(residual(y)) expect_error(residual(x)) }) test_that("residual: params: x, y, ect.; result: error labels, point, hline are not list ot NULL ", { x <- "IWRES" y <- "IPRED" expect_error(residual(x, y, labels = 1)) expect_error(residual(x, y, point = 1)) expect_error(residual(x, y, hline = TRUE)) }) test_that("residual: params: x, y, ect.; result: error dname is not string ot NULL ", { x <- "IWRES" y <- "IPRED" expect_error(residual(x, y, dname = 1)) }) test_that("residual: params: x, y, dname = NULL; result: identical structure", { x <- "IWRES" y <- "IPRED" default_point <- list(shape = 1, colour = "black", size = 1) res <- residual(x, y) expect_identical(res$dname, "predictions") expect_identical(res$point, default_point) }) test_that("residual: params: x, y; result: identical inherits", { x <- "IWRES" y <- "IPRED" res <- residual(x, y) expect_true(inherits(res, c("residual", "pmx_gpar"))) }) test_that("residual: params: x, y; result: identical names", { x <- "IWRES" y <- "IPRED" res <- residual(x, y) resNames <- c( "ptype", "strat", "dname", "aess", "point", "is.hline", "hline", "facets", "bloq", "square_plot", "gp" ) expect_identical(names(res), resNames) }) #------------------- residual end ------------------------------------------ #------------------- extend_range start ------------------------------------ test_that("extend_range: params: x; result: identical range", { dx <- ctr %>% get_data("omega") expect_identical(extend_range(x = dx), c(Inf, -Inf)) }) test_that("extend_range: params: x; result: error 'r' must be a 'range', hence of length 2", { dx <- ctr %>% get_data("omega") expect_error(extend_range(x = dx, r = Inf)) }) test_that("extend_range: params: NULL; result: error missing arguments", { expect_error(extend_range()) }) test_that("extend_range: params: x; result: error data frame should has all numeric variables", { dx <- ctr %>% get_data("eta") dx <- dx[, EFFECT := factor( EFFECT, levels = c("ka", "V", "Cl"), labels = c("Concentration", "Volume", "Clearance") )] expect_error(extend_range(x = dx[, c(aess$x, aess$y), with = FALSE])) }) #------------------- extend_range end -------------------------------------- #------------------- plot_pmx.residual start ------------------------------- test_that("plot_pmx.residual: params: NULL; result: error missing arguments", { expect_error(plot_pmx.residual()) }) test_that("plot_pmx.residual: params: x, dx; result: NULL", { x <- "IWRES" y <- "IPRED" dx <- ctr %>% get_data("eta") dx <- dx[, EFFECT := factor( EFFECT, levels = c("ka", "V", "Cl"), labels = c("Concentration", "Volume", "Clearance") )] res <- residual(x, y) expect_identical(plot_pmx.residual(x = res, dx), NULL) }) test_that("plot_pmx.residual: params: x, dx; result: identical structure", { x <- "STUD" y <- "SEX" dx <- ctr %>% get_data("eta") dx <- dx[, EFFECT := factor( EFFECT, levels = c("ka", "V", "Cl"), labels = c("Concentration", "Volume", "Clearance") )] bloq <- pmx_bloq(cens = "EVID") bloq$show <- NULL res <- residual(x, y, is.hline = TRUE, bloq = bloq) pl_resid <- plot_pmx.residual(x = res, dx) expect_identical(pl_resid$bloq$cens, NULL) expect_identical(pl_resid$bloq$limit, NULL) expect_identical(pl_resid$bloq$cens, NULL) expect_identical(pl_resid$is.hline, NULL) }) test_that("plot_pmx.residual: params: x, dx, res$gp$scale_x_log10, scale_x_log10 are not NULL; result: identical inherits", { x <- "Y" y <- "DV" dx <- ctr %>% get_data("eta") aess <- list(x = "Y", y = "DV") res <- residual(x, y, ranges = list(x = c(0, 500)), is.hline = TRUE) res$aess$y <- "DV" res$gp$scale_x_log10 <- F res$gp$scale_y_log10 <- F res$gp$ranges$x <- NULL res$gp$ranges$y <- NULL pl_resid <- plot_pmx.residual(x = res, dx) expect_true(inherits(pl_resid, "ggplot")) }) test_that("plot_pmx.residual: params: x, dx, res$ranges$x is not NULL; result: identical inherits", { x <- "Y" y <- "DV" dx <- ctr %>% get_data("eta") aess <- list(x = "Y", y = "DV") res <- residual(x, y, ranges = list(x = c(0, 500)), is.hline = TRUE) res$aess$y <- "DV" res$gp$scale_x_log10 <- F res$gp$scale_y_log10 <- F pl_resid <- plot_pmx.residual(x = res, dx) expect_true(inherits(pl_resid, "ggplot")) }) test_that("plot_pmx.residual: params: x, dx, res$strat.facet, res$strat.color; result: identical inherits", { x <- "Y" y <- "DV" dx <- ctr %>% get_data("eta") aess <- list(x = "Y", y = "DV") res <- residual(x, y, ranges = list(x = c(0, 500), y = c(0, 100)), is.hline = TRUE) res$aess$y <- "DV" res$gp$scale_x_log10 <- F res$gp$scale_y_log10 <- F res$strat.color <- "SEX" res$strat.facet <- "STUD" pl_resid <- plot_pmx.residual(x = res, dx) expect_true(inherits(pl_resid, "ggplot")) }) #------------------- plot_pmx.residual end --------------------------------- test_that("pmx_plot_iwres_ipred: params: ctr; result: ggplot", { expect_true(inherits(pmx_plot_iwres_ipred(ctr), "ggplot")) }) test_that("pmx_plot_iwres_ipred: params: ctr; result: list", { p <- pmx_plot_iwres_ipred(ctr) expect_true(inherits(p$scales$scales, "list")) }) test_that( "pmx_plot_iwres_ipred: params: ctr; result: identical structure", { p <- pmx_plot_iwres_ipred(ctr) expect_identical( p$scales$scales[[1]]$limits, c(-3.3237, 3.3237) ) } ) test_that( "pmx_plot_iwres_ipred: params: ctr_mlx; result: identical structure", { mlxpath <- file.path( system.file(package = "ggPMX"), "testdata", "1_popPK_model", "project.mlxtran" ) ctr_mlx <- pmx_mlxtran(mlxpath, config = "standing") p <- pmx_plot_iwres_ipred(ctr_mlx) expect_identical( p$scales$scales[[1]]$limits, c(-3.7749, 3.7749) ) } ) test_that("pmx_plot_iwres_ipred: params: strat.facet as formula/character result: plot panels", { ctr <- theophylline() p_formula <- pmx_plot_iwres_ipred(ctr, strat.facet = "SEX") expect_equal(levels(ggplot_build(p_formula)[[1]][[1]][["PANEL"]]), c("1", "2")) p_char <- pmx_plot_iwres_ipred(ctr, strat.facet = ~SEX) expect_equal(levels(ggplot_build(p_char)[[1]][[1]][["PANEL"]]), c("1", "2")) p_non_ex <- pmx_plot_iwres_ipred(ctr, strat.facet = ~4) expect_equal(levels(ggplot_build(p_non_ex)[[1]][[1]][["PANEL"]]), c("1")) }) test_that( "pmx_plot_iwres_ipred: params: ctr, ylim; result: identical structure", { p <- pmx_plot_iwres_ipred(ctr) + ylim(-5, 5) expect_identical( p$scales$scales[[1]]$limits, c(-5, 5) ) } ) #------------------- pmx_plot_iwres_ipred end -------------------------------- #------------------- pmx_plot_npde_time start -------------------------------- test_that( "pmx_plot_npde_time: params: ctr, explicit filter; result: identical type", { p <- ctr %>% pmx_plot_npde_time(filter = "STUD == 1") expect_true(inherits(p, "ggplot")) } ) test_that( "pmx_plot_npde_time: params: ctr, implicit filter; result: identical type", { filter_string <- "STUD == 1" p <- ctr %>% pmx_plot_npde_time(filter = filter_string) expect_true(inherits(p, "ggplot")) } ) #------------------- pmx_plot_npde_time end ---------------------------------- #------------------- pmx_plot_cats start ------------------------------------- test_that( "pmx_plot_cats: params: ctr; result: identical numbers of columns and rows", { p <- ctr %>% pmx_plot_cats("dv_pred", strat.facet = ~STUD, facets = list(nrow = 2, ncol = 1) ) expect_identical(p[[1]]$facet$params$nrow, 2) expect_identical(p[[1]]$facet$params$ncol, 1) } ) test_that( "pmx_plot_cats: params: ctr; result: identical numbers of columns and rows", { p <- ctr %>% pmx_plot_cats("dv_pred", strat.facet = ~STUD) expect_identical(p[[1]]$facet$params$nrow, NULL) expect_identical(p[[1]]$facet$params$ncol, NULL) } ) test_that( "pmx_plot_cats: params: ctr; result: identical numbers of columns and rows", { p <- ctr %>% pmx_plot_cats("pmx_vpc", strat.facet = ~STUD, facets = list(nrow = 2, ncol = 1)) expect_identical(p[[1]]$facet$params$nrow, 2) expect_identical(p[[1]]$facet$params$ncol, 1) } ) test_that( "pmx_plot_cats: params: ctr; result: identical numbers of columns and rows", { p <- ctr %>% pmx_plot_cats("npde_time", strat.facet = ~STUD, facets = list(nrow = 2, ncol = 1)) expect_identical(p[[1]]$facet$params$nrow, 2) expect_identical(p[[1]]$facet$params$ncol, 1) } ) test_that( "pmx_plot_cats: params: ctr; result: identical numbers of columns and rows", { p <- ctr %>% pmx_plot_cats("iwres_time", strat.facet = ~STUD, facets = list(nrow = 2, ncol = 1)) expect_identical(p[[1]]$facet$params$nrow, 2) expect_identical(p[[1]]$facet$params$ncol, 1) } ) test_that( "pmx_plot_dv_ipred: params: ctr, strat.color, point(...); result: aesthetic params applied along with strat.color", { params <- list(alpha=0.1, size=2, stroke=2, shape=23, fill="red") p <- do.call(pmx_plot_dv_ipred, list(ctr=ctr, strat.color="WT0", point=params)) lapply(names(params), function(a) { value <- p[["plot_env"]][["point"]][[a]] if(inherits(value, "quosure")) {value <- as_label(value)} expect_identical(value, params[[a]]) }) } ) #------------------- pmx_plot_cats end -------------------------------------- #------------------- pmx_plot_dv_pred start ------------------------------------- test_that( "pmx_plot_dv_pred: params: ctr, range; result: squared by default, with applied ranges with square_plot = FALSE", { ctr <- theophylline() p1 <- ctr %>% pmx_plot_dv_pred(ranges = list(x = c(200, 500), y = c(100, 200))) p2 <- ctr %>% pmx_plot_dv_pred( ranges = list(x = c(200, 500), y = c(100, 200)), square_plot = FALSE ) expect_equal( p1[["plot_env"]][["gp"]][["ranges"]][["y"]][[2]], p1[["plot_env"]][["gp"]][["ranges"]][["x"]][[2]] ) expect_equal(p2[["plot_env"]][["gp"]][["ranges"]][["x"]], c(200, 500)) expect_equal(p2[["plot_env"]][["gp"]][["ranges"]][["y"]], c(100, 200)) } ) #------------------- pmx_plot_dv_pred end -------------------------------------- }