if (helper_skip()) { context("Test structure of a graphic distribution object") #------------------- distrib start ------------------------------------------ test_that("distrib: params: labels and facets etc. result: identical structure", { labels <- list("EVID", "SEX") facets <- list(nrow = 5, ncol = 5) expect_identical( distrib( labels, is.shrink = FALSE, type = "hist", facets = facets, dname = "predictions" ), structure( list( ptype = "DIS", strat = TRUE, dname = "predictions", aess = list(x = "EFFECT", y = "VAR", z = "FUN"), type = "hist", is.jitter = FALSE, jitter = NULL, facets = facets, histogram = NULL, is.shrink = FALSE, shrink = NULL, gp = pmx_gpar( labels = labels, discrete = TRUE, is.smooth = FALSE ) ), class = c("distrib", "pmx_gpar") ) ) }) test_that("distrib: params: labels and facets etc. result: distrib object", { labels <- list("EVID", "SEX") facets <- list(nrow = 5, ncol = 5) expect_true(inherits( distrib( labels, is.shrink = FALSE, type = "hist", facets = facets, dname = "predictions" ), "distrib" )) }) test_that("distrib: params: labels is Null; result: error", { labels <- NULL facets <- list(nrow = 5, ncol = 5) expect_error( distrib( labels, is.shrink = FALSE, type = "hist", facets = facets, dname = "predictions" ) ) }) test_that("distrib: params: integer facets; result: error", { labels <- list("EVID", "SEX") facets <- 2 expect_error( distrib( labels, is.shrink = FALSE, type = "hist", facets = facets, dname = "predictions" ) ) }) #------------------- distrib end --------------------------------------------- #------------------- wrap_formula start -------------------------------------- test_that("wrap_formula: params: x is a formula result: formula", { x <- ~ a + y + z expect_true(inherits(wrap_formula(x), "formula")) }) test_that("wrap_formula: params: x is integer result: formula", { x <- 10L expect_true(inherits(wrap_formula(x), "formula")) }) test_that("wrap_formula: params: x is NULL result: not formula", { x <- NULL expect_true(inherits(wrap_formula(x), "formula")) }) test_that("wrap_formula: params: x is NA result: not formula", { x <- NA expect_true(inherits(wrap_formula(x), "formula")) }) test_that("wrap_formula: params: x is string result: not formula", { x <- "hello you" expect_error(wrap_formula(x)) }) #------------------- wrap_formula end ---------------------------------------- #------------------- jitter_layer start -------------------------------------- test_that("jitter_layer: params: jitter and strat.color result: LayerInstance", { expect_true(inherits( jitter_layer( jitter = list(alpha = 0.4, color = "red"), strat.color = "SEX" ), "LayerInstance" )) }) test_that("jitter_layer: params: strat.color equals NULL result: LayerInstance", { expect_true(inherits( jitter_layer( jitter = list(alpha = 0.4, color = "red"), strat.color = NULL ), "LayerInstance" )) }) test_that("jitter_layer: params: jitter and strat.color equal NULL result: error", { expect_error(jitter_layer(jitter = NULL, strat.color = NULL)) }) test_that("jitter_layer: params: no result: error", { expect_error(jitter_layer()) }) #------------------- jitter_layer end ---------------------------------------- #------------------- distrib.hist start -------------------------------------- test_that("distrib.hist: params: labels, type and etc. result: ggplot", { ctr <- theophylline() dx <- ctr %>% get_data("eta") labels <- list("EVID", "SEX") x <- distrib( labels, is.shrink = FALSE, type = "hist", facets = NULL, dname = "predictions" ) expect_true(inherits( distrib.hist( dx, strat.facet = dx$ID, strat.color = dx$SEX, x ), "gg" )) }) test_that("distrib.hist: params: x equals NULL result: error", { ctr <- theophylline() dx <- ctr %>% get_data("eta") labels <- list("EVID", "SEX") x <- NULL expect_error(distrib.hist( dx, strat.facet = dx$ID, strat.color = dx$SEX, x )) }) test_that("distrib.hist: params: dx equals NULL result: error", { dx <- NULL labels <- list("EVID", "SEX") x <- distrib( labels, is.shrink = FALSE, type = "hist", facets = NULL, dname = "predictions" ) expect_error(distrib.hist( dx, strat.facet = dx$ID, strat.color = dx$SEX, x )) }) #------------------- distrib.hist end --------------------------------------- #------------------- distrib.box start -------------------------------------- test_that("distrib.box: params: labels, type, etc. result: ggplot", { ctr <- theophylline() dx <- ctr %>% get_data("eta") labels <- list("EVID", "SEX") x <- distrib( labels, is.shrink = FALSE, type = "hist", facets = NULL, dname = "predictions" ) expect_true(inherits( distrib.box(dx, strat.color = dx$SEX, strat.facet = NULL, x), "gg" )) }) test_that("distrib.box: params: x equals NULL result: error", { ctr <- theophylline() dx <- ctr %>% get_data("eta") labels <- list("EVID", "SEX") x <- NULL expect_error(distrib.box( dx, strat.color = dx$SEX, strat.facet = dx$ID, x )) }) test_that("distrib.box: params: dx equals NULL result: gg", { dx <- NULL labels <- list("EVID", "SEX") x <- distrib( labels, is.shrink = FALSE, type = "hist", facets = NULL, dname = "predictions" ) expect_true(inherits( distrib.box(dx, strat.color = dx$SEX, strat.facet = NULL, x), "gg" )) }) test_that("distrib.box: params: strat.facet is not NULL result: gg", { ctr <- theophylline() dx <- ctr %>% get_data("eta") labels <- list("EVID", "SEX") x <- distrib( labels, is.shrink = FALSE, type = "hist", facets = NULL, dname = "predictions" ) expect_true(inherits( distrib.box( dx, strat.color = dx$SEX, strat.facet = ~SEX, x ), "gg" )) }) #------------------- distrib.box end ---------------------------------------- #------------------- shrinkage_layer start ---------------------------------- test_that("shrinkage_layer: params: hist type result: LayerInstance", { ctr <- theophylline() dx <- ctr %>% get_data("estimate") expect_true(inherits( shrinkage_layer( dx, shrink=list(hjust=0.5, fun="var"), type = "hist", strat.color = dx$SEX ), "LayerInstance" )) }) test_that("shrinkage_layer: params: dx contain eta data result: warning", { ctr <- theophylline() dx <- ctr %>% get_data("eta") expect_warning(shrinkage_layer( dx, shrink = list(hjust = 0.5), type = "hist", strat.color = dx$SEX )) }) test_that("shrinkage_layer: params: box type result: LayerInstance", { ctr <- theophylline() dx <- ctr %>% get_data("estimate") expect_true(inherits( shrinkage_layer( dx, shrink=list(hjust=0.5, fun="var"), type = "box", strat.color = dx$SEX ), "LayerInstance" )) }) #------------------- shrinkage_layer end ------------------------------------ #------------------- plot_distribution start -------------------------------- test_that("plot_distribution: params: dx contain eta data, x is distrib object result: error", { ctr <- theophylline() dx <- ctr %>% get_data("eta") labels <- list("EVID", "SEX") x <- distrib( labels, is.shrink = FALSE, type = "hist", facets = list("SEX"), dname = "predictions" ) expect_error(plot_distribution(x, dx)) }) #------------------- plot_distribution end ---------------------------------- #------------------- plot_pmx.distrib start --------------------------------- test_that("plot_pmx.distrib: params: dx contain eta data, x is distrib object result: error", { ctr <- theophylline() dx <- ctr %>% get_data("eta") labels <- list("EVID", "SEX") x <- distrib( labels, is.shrink = FALSE, type = "hist", facets = list("SEX"), dname = "predictions" ) expect_error(plot_pmx.distrib(x, dx)) }) #------------------- plot_pmx.distrib end ------------------------------------ }