# Define files to be tested -----------------------------------------------
# ctrl_special <- xpdb_ex_pk %>%
# vpc_data(opt = vpc_opt(n_bins = 3, lloq = 0.1)) %>%
# vpc_data(vpc_type = 'cens', opt = vpc_opt(n_bins = 3, lloq = 0.4))
# save(ctrl_special, file = 'data/ctrl_special.RData',
# compress = 'xz', version = 2)
load(file = 'data/ctrl_special.RData')
# ctrl_psn_vpc_dat <- psn_vpc_parser(xpdb = xpdb_ex_pk, psn_folder = 'data/psn_vpc/',
# psn_bins = TRUE, opt = vpc_opt(), quiet = TRUE)
# save(ctrl_psn_vpc_dat, file = 'data/ctrl_psn_vpc.RData',
# compress = 'xz', version = 2)
load(file = 'data/ctrl_psn_vpc.RData')
test_psn_vpc <- vpc_data(xpdb_ex_pk, psn_folder = 'data/psn_vpc/', quiet = TRUE)
# Tests start here --------------------------------------------------------
test_that('vpc_opt works properly', {
expect_equal(vpc_opt(),
list(bins = 'jenks', n_bins = 'auto', bin_mid = 'mean', pred_corr = FALSE,
pred_corr_lower_bnd = 0, pi = c(0.025, 0.975), ci = c(0.025, 0.975),
lloq = NULL, uloq = NULL, rtte = FALSE, rtte_calc_diff = TRUE,
events = NULL, kmmc = NULL, reverse_prob = FALSE,
as_percentage = TRUE, usr_call = NULL))
})
test_that('vpc_data properly check input', {
expect_error(vpc_data(), regexp = 'argument \"xpdb\" is missing')
expect_error(vpc_data(xpdb_ex_pk, psn_folder = '.', quiet = TRUE),
regexp = 'No table files could be found')
expect_error(vpc_data(xpdb_ex_pk, psn_folder = 'fake', quiet = TRUE),
regexp = 'fake could not be found')
})
test_that('vpc_data works properly with xpdb tables', {
skip_if(condition = utils::packageVersion("dplyr") > "0.8.5" & utils::packageVersion("vpc") < "1.2.1",
message = "Incompatible package versions...")
xpdb_vpc_test <- xpdb_ex_pk %>%
vpc_data(opt = vpc_opt(n_bins = 3, lloq = 0.1), quiet = TRUE) %>%
vpc_data(vpc_type = 'cens', opt = vpc_opt(n_bins = 3, lloq = 0.4), quiet = TRUE)
expect_true(is.xpdb(xpdb_vpc_test))
expect_equivalent(xpdb_vpc_test$special, ctrl_special$special)
})
test_that('vpc_data works properly with psn_folder', {
skip_on_cran() # Skip to avoid issue with no long double
# Check psn_vpc_parser
parsed_psn_vpc <- psn_vpc_parser(xpdb = xpdb_ex_pk, psn_folder = 'data/psn_vpc/',
psn_bins = TRUE, opt = vpc_opt(), quiet = TRUE)
expect_equal(parsed_psn_vpc, ctrl_psn_vpc_dat)
expect_true(is.xpdb(test_psn_vpc))
expect_error(psn_vpc_plot <- test_psn_vpc %>% vpc(), NA)
})
test_that('vpc plot properly check input', {
expect_error(vpc())
expect_error(vpc(xpdb = 1, quiet = FALSE), regexp = 'Bad input')
expect_error(vpc(xpdb_ex_pk, quiet = FALSE), regexp = 'No `special` slot')
expect_error(vpc(ctrl_special, quiet = FALSE), regexp = 'Several VPC data')
expect_error(vpc(ctrl_special, vpc_type = 'unknown', quiet = FALSE),
regexp = 'should be one of')
expect_error(test_psn_vpc %>% vpc(vpc_type = 'cens'),
regexp = 'Change `vpc_type` to continuous')
})
test_that('vpc plot are properly generated', {
skip_if(condition = utils::packageVersion("dplyr") > "0.8.5" & utils::packageVersion("vpc") < "1.2.1",
message = "Incompatible package versions...")
p_cont <- vpc(ctrl_special, vpc_type = 'continuous', type = 'alrpt', quiet = FALSE)
p_cont2 <- vpc(ctrl_special, vpc_type = 'continuous', facets = ~group)
p_cens <- vpc(ctrl_special, vpc_type = 'censored', smooth = FALSE, facets = 'group',
type = 'alr', quiet = FALSE)
expect_true(is.xpose.plot(p_cont))
expect_true(is.xpose.plot(p_cens))
expect_equal(class(p_cont$layers[[1]]$geom)[1], 'GeomRibbon')
expect_equal(class(p_cont$layers[[2]]$geom)[1], 'GeomLine')
expect_equal(class(p_cont$layers[[3]]$geom)[1], 'GeomPoint')
expect_equal(class(p_cont$layers[[4]]$geom)[1], 'GeomText')
expect_equal(class(p_cont$layers[[5]]$geom)[1], 'GeomHline')
expect_equal(class(p_cont$layers[[6]]$geom)[1], 'GeomRug')
expect_equal(class(p_cont$facet)[1], 'FacetNull')
expect_equal(class(p_cont2$facet)[1], 'FacetGrid')
expect_equal(class(p_cens$layers[[1]]$geom)[1], 'GeomRect')
expect_equal(class(p_cens$facet)[1], 'FacetWrap')
expect_equal(p_cont$xpose$fun, 'vpc_continuous')
expect_equal(p_cens$xpose$fun, 'vpc_censored')
expect_equal(p_cont$xpose$problem, 3)
expect_equal(p_cens$xpose$problem, 4)
expect_equal(p_cont$xpose$summary$value[p_cont$xpose$summary$label %in% c('vpcdir', 'vpcnsim', 'vpcci', 'vpcpi')],
c('data', '20', '95', '95'))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.