tests/testthat/test-xplot_boxplot.R

In xpose.xtras: Extra Functionality for the 'xpose' Package

test_that("xplot_boxplot", {

  data("xpdb_ex_pk", package = "xpose", envir = environment())

  # test both xpdb_x xpdb_ex_pk produce the same plot (d/t filling theme)
  wo_xpx <- xpdb_ex_pk %>% xplot_boxplot(aes(MED1,ETA1), quiet = TRUE)
  w_xpx <- xpdb_ex_pk %>% as_xpdb_x() %>% xplot_boxplot(aes(MED1,ETA1), quiet = TRUE)

  # test desired geoms are included
  # wrapper function to get geom type and outliers
  geoms_lists <- function(gg) purrr::map_chr(gg$layers, ~class(.x$geom)[1])
  has_outliers <- function(gg) any(purrr::map_lgl(gg$layers, ~"outlier.shape" %in% names(.x$geom_params) &&
                                                   !is.na(.x$geom_params$outlier.shape)))

  # bo is default
  def_bp <- xplot_boxplot(xpdb_x, aes(MED1,ETA1), quiet = TRUE)
  expect_setequal(
    geoms_lists(def_bp),
    "GeomBoxplot"
  )
  expect_true(
    has_outliers(def_bp)
  )
  expect_identical(
    def_bp,
    xplot_boxplot(xpdb_x, aes(MED1,ETA1), type= "bo", quiet = TRUE)
  )

  # b should not have outliers
  expect_false(
    has_outliers(xplot_boxplot(xpdb_x, aes(MED1,ETA1), type= "b", quiet = TRUE))
  )

  # bvl should have violin and hline
  expect_setequal(
    geoms_lists(xplot_boxplot(xpdb_x, aes(MED1,ETA1), type= "bvl", quiet = TRUE)),
    c("GeomBoxplot","GeomViolin","GeomHline")
  )
  # vl should have violin and hline
  expect_setequal(
    geoms_lists(xplot_boxplot(xpdb_x, aes(MED1,ETA1), type= "vl", quiet = TRUE)),
    c("GeomViolin","GeomHline")
  )
  # p should have dotplot
  expect_setequal(
    geoms_lists(xplot_boxplot(xpdb_x, aes(MED1,ETA1), type= "p", quiet = TRUE)),
    c("GeomDotplot")
  )
  # s should have smooth
  expect_setequal(
    geoms_lists(xplot_boxplot(xpdb_x, aes(MED1,ETA1), type= "s", quiet = TRUE)),
    c("GeomSmooth")
  )
  # j should have jitter
  expect_setequal(
    geoms_lists(xplot_boxplot(xpdb_x, aes(MED1,ETA1), type= "j", quiet = TRUE)),
    c("GeomPoint")
  )
  # c should have connecting lines for jitter
  expect_setequal(
    geoms_lists(xplot_boxplot(xpdb_x, aes(MED1,ETA1), type= "c", quiet = TRUE)),
    c("GeomPath")
  )


  # test orientation effects
  # orientation should affect line
  expect_setequal(
    geoms_lists(xplot_boxplot(xpdb_x, aes(ETA1,MED1), type= "bl", orientation = "y", quiet = TRUE)),
    c("GeomBoxplot","GeomVline")
  )
  # Should affect dotplot binaxis
  expect_equal(
    xplot_boxplot(xpdb_x, aes(ETA1,MED1),
                  type= "p",
                  #orientation = "y", # use default
                  quiet = TRUE)$layers[[1]]$geom_params$binaxis,
    "y"
  )
  expect_equal(
    xplot_boxplot(xpdb_x, aes(MED1,ETA1), # <- this did not need to change here, but would throw an error if actually plotted
                  type= "p",
                  orientation = "y",
                  quiet = TRUE)$layers[[1]]$geom_params$binaxis,
    "x"
  )


  # test quiet effects
  suppressMessages(expect_equal(
    xpdb_x$options$quiet,
    xplot_boxplot(xpdb_x, aes(MED1,ETA1))$plot_env$quiet
  ))
  expect_message(
    xplot_boxplot(xpdb_x, aes(MED1,ETA1)),
    "Using data from"
  )
  suppressMessages(expect_warning(
    xplot_boxplot(xpdb_x, aes(ETA1,MED1), orientation = "y"),
    "yscale is not discrete"
  ))
  expect_error(
    print(xplot_boxplot(xpdb_x, aes(MED1,ETA1), orientation = "y", quiet=TRUE)),
    "Discrete value(s)? supplied to continuous scale"
  )

  # test facet effects
  fct <- xplot_boxplot(xpdb_x, aes(MED1,ETA1), facets="SEX", quiet=TRUE)
  expect_true(
    "facets" %in% names(fct$facet$params) &&
      names(fct$facet$params$facets)=="SEX"
  )
  expect_false(
    "facets" %in% names(def_bp$facet$params) &&
      names(def_bp$facet$params$facets)=="SEX"
  )

  # test ggtheme
  expect_contains(
    xplot_boxplot(xpdb_x,
                  aes(MED1,ETA1),
                  gg_theme = xpose::theme_bw2(),
                  quiet=TRUE)$theme,
    xpose::theme_bw2()
    )
  expect_failure(
    expect_contains(
      def_bp$theme,
      xpose::theme_bw2()
    ))

  # xp-theme basic check
  expect_failure(expect_identical(
    def_bp,
    xplot_boxplot(xpdb_x, aes(MED1,ETA1), quiet = TRUE, xp_theme = xpose::theme_xp_xpose4())
  ))


  # No data error
  expect_error(
    xplot_boxplot(xpdb_x,
                  aes(MED1,ETA1),
                  quiet=TRUE,
                  opt = xpose::data_opt(filter = \(x) x[x$ETA1 >999,])),
    "No data available"
  )


  #### vdiffr tests to skip on CRAN
  skip_on_cran()
  skip_on_covr()
  skip()
  library(vdiffr)
  expect_doppelganger("from xpose_data", wo_xpx) # expect same as snapshot
  expect_doppelganger("from xp_xtra", w_xpx) # expect same as snapshot
  expect_doppelganger("from xpose_data", w_xpx) # expect same as xpose_data snapshot

})