tests/testthat/test-xplot_helpers.R

In guiastrennec/xpose: Diagnostics for Pharmacometric Models

xpdb_NULL       <- xpdb_ex_pk
xpdb_NULL$data  <- NULL
xpdb_NULL$files <- NULL
xpdb_NULL       <- as.xpdb(xpdb_NULL)

# Tests start here --------------------------------------------------------
# test_that('Check check_vars', {
#   expect_null(check_vars(NULL, xpdb_ex_pk))
#   expect_null(check_vars(c('problem', 'simtab', 'index', 'data'), xpdb_ex_pk))
# })

test_that('Check check_scales', {
  expect_equal(check_scales('x', NULL), 'continuous')
  expect_equal(check_scales('x', 'y'), 'continuous')
  expect_equal(check_scales('x', 'xy'), 'log10')
})

test_that('Check parse_title', {
  expect_equal(parse_title('OFV: @ofv', xpdb_ex_pk, problem = 1, quiet = TRUE), 'OFV: -1403.905')
  expect_warning(tmp_title1 <- parse_title('OFV: @fake', xpdb_ex_pk, problem = 1, quiet = FALSE), 
                 regexp = 'not part of')
  expect_equal(tmp_title1, 'OFV: @fake')
  expect_equal(parse_title('OFV: @fake', xpdb_ex_pk, problem = 1, quiet = TRUE, extra_key = 'fake', 
                           extra_value = '1987'), 'OFV: 1987')
  expect_warning(tmp_title2 <- parse_title('OFV: @ofv, @ignored', xpdb_ex_pk, problem = 1, quiet = TRUE, 
                                           ignore_key = 'ignored'), NA)
  expect_equal(tmp_title2, 'OFV: -1403.905, @ignored')
})

test_that('Check filter_xp_theme', {
  # Keep matches
  expect_equal(filter_xp_theme(xpdb_ex_pk$xp_theme, 'point_', action = 'keep'),
               xpdb_ex_pk$xp_theme[grepl('point_', names(xpdb_ex_pk$xp_theme))])
  # Drop matches
  expect_equal(filter_xp_theme(xpdb_ex_pk$xp_theme, 'point_', action = 'drop'),
               xpdb_ex_pk$xp_theme[!grepl('point_', names(xpdb_ex_pk$xp_theme))])
})

test_that('Check all_data_problem', {
  expect_equal(all_data_problem(xpdb_NULL), NA_integer_)
  expect_equal(all_data_problem(xpdb_ex_pk), 1:2)
})

test_that('Check last_data_problem', {
  expect_error(last_data_problem(xpdb_NULL))
  expect_equal(last_data_problem(xpdb_ex_pk, simtab = FALSE), 1)
  expect_equal(last_data_problem(xpdb_ex_pk, simtab = TRUE), 2)
})

test_that('Check all_file_problem', {
  expect_error(all_file_problem(xpdb_NULL))
  expect_equal(all_file_problem(xpdb_ex_pk, ext = 'ext'), 1)
  expect_equal(all_file_problem(xpdb_ex_pk, ext = 'fake'), NA_integer_)
})

test_that('Check last_file_problem', {
  expect_equal(last_file_problem(xpdb_ex_pk, ext = 'ext'), 1)
})

test_that('Check last_file_subprob', {
  expect_equal(last_file_subprob(xpdb_ex_pk, ext = 'ext', .problem = 1), 1)
  expect_equal(last_file_subprob(xpdb_ex_pk, ext = 'fake', .problem = 1), NA_integer_)
})

test_that('Check xp_var', {
  expect_equal(xp_var(xpdb_ex_pk, 1, col = 'TIME')$type, 'idv')
  expect_equal(xp_var(xpdb_ex_pk, 1, type = 'idv')$col, 'TIME')
  expect_null(xp_var(xpdb_ex_pk, 1, col = 'FAKE_COL', silent = TRUE))
  expect_error(xp_var(xpdb_ex_pk, 1, col = 'FAKE_COL', silent = FALSE),
               regexp = 'Column `FAKE_COL` not available')
})

test_that('Check append_aes', {
  expect_equal(aes_c(aes(x = .data[["IPRED"]], y = .data[["DV"]]), NULL), 
               aes(x = .data[["IPRED"]], y = .data[["DV"]]))
  expect_equal(aes_c(aes(x = .data[["IPRED"]], y = .data[["DV"]]), 
                     aes(y = .data[["PRED"]])), 
               aes(x = .data[["IPRED"]], y = .data[["PRED"]]))
})

test_that('Check check_xpdb', {
  expect_error(check_xpdb(xpdb = '1', check = 'data'), regexp = 'Bad input')
  expect_error(check_xpdb(xpdb_NULL, check = 'data'), regexp = 'No `data` slot could be found in this xpdb')
  expect_null(check_xpdb(xpdb_NULL, check = FALSE))
  expect_null(check_xpdb(xpdb_ex_pk, check = 'data'))
})

test_that('Check check_plot_type', {
  expect_silent(check_plot_type('pls', allowed = c('p', 'l', 's', 't')))
  expect_warning(check_plot_type('prlst', allowed = c('p', 'l', 's', 't')), 
                 regexp = 'Plot type \"r\" not recognized')
  expect_warning(check_plot_type('prsz', allowed = c('p', 'l', 's', 't')), 
                 regexp = 'Plot type \"r\", \"z\" not recognized')
})

test_that('Check drop_fixed', {
  expect_message(variable_cols <- drop_fixed_cols(xpdb_ex_pk, .problem = 1, quiet = FALSE,
                                                  cols = c('CL', 'V', 'KA', 'ALAG1')), 
                 regexp = 'Dropped fixed variables ALAG1')
  expect_equal(variable_cols, c('CL', 'V', 'KA'))
})

test_that('Check add_facets_var', {
  expect_equal(add_facet_var(facets = c('OCC', 'SEX'), variable = 'variable'),
               c('variable', 'OCC', 'SEX'))
  expect_equal(add_facet_var(facets = as.formula('OCC~SEX'), variable = 'variable'),
               as.formula('OCC~SEX+variable'))
})