# Define files to be tested -----------------------------------------------
software <- 'nonmem'
model <- xpdb_ex_pk$code
model2 <- model[0, ]
file <- 'pk/model/run001.lst'
rounding <- 2
sum_out <- function(sum_fun, prob = 1) {
as.character(sum_fun[prob, c('label', 'value')])
}
# Handle differences across R versions
eta_shk_string <- ifelse(getRversion() >= "4.0.0",
yes = "9.33 [1], 28.72 [2], 23.65 [3]",
no = "9.33 [1], 28.71 [2], 23.65 [3]")
# Tests start here --------------------------------------------------------
test_that('summary is properly created with the appropriate information', {
expect_equal(sum_out(sum_software(software)), c('software', 'nonmem'))
expect_equal(sum_out(sum_version(model, software)), c('version', '7.3.0'))
expect_equal(sum_out(sum_file(file)), c('file', 'run001.lst'))
expect_equal(sum_out(sum_run(file)), c('run', 'run001'))
expect_equal(sum_out(sum_directory(file)), c('dir', 'pk/model'))
expect_equal(sum_out(sum_reference(model, software)), c('ref', '000'))
expect_equal(sum_out(sum_probn(model, software), 1), c('probn', '1'))
expect_equal(sum_out(sum_probn(model, software), 2), c('probn', '2'))
expect_equal(sum_out(sum_timestart(model, software)), c('timestart', 'Mon Oct 16 13:34:28 CEST 2017'))
expect_equal(sum_out(sum_timestop(model, software)), c('timestop', 'Mon Oct 16 13:34:35 CEST 2017'))
expect_equal(sum_out(sum_description(model, software)), c('descr', 'NONMEM PK example for xpose'))
expect_equal(sum_out(sum_label(model, software), 1), c('label', 'Parameter estimation'))
expect_equal(sum_out(sum_label(model, software), 2), c('label', 'Model simulations'))
expect_equal(sum_out(sum_input_data(model, software), 1), c('data', '../../mx19_2.csv'))
expect_equal(sum_out(sum_input_data(model, software), 2), c('data', '../../mx19_2.csv'))
expect_equal(sum_out(sum_nobs(model, software), 1), c('nobs', '476'))
expect_equal(sum_out(sum_nobs(model, software), 2), c('nobs', '476'))
expect_equal(sum_out(sum_nind(model, software), 1), c('nind', '74'))
expect_equal(sum_out(sum_nind(model, software), 2), c('nind', '74'))
expect_equal(sum_out(sum_nsim(model, software)), c('nsim', '20'))
expect_equal(sum_out(sum_simseed(model, software)), c('simseed', '221287'))
expect_equal(sum_out(sum_subroutine(model, software)), c('subroutine', '2'))
expect_equal(sum_out(sum_runtime(model, software)), c('runtime', '00:00:02'))
expect_equal(sum_out(sum_covtime(model, software)), c('covtime', '00:00:03'))
expect_equal(sum_out(sum_term(model, software)), c('term', 'MINIMIZATION SUCCESSFUL'))
expect_equal(sum_out(sum_warnings(model, software), 1), c('warnings', '(WARNING 2) NM-TRAN INFERS THAT THE DATA ARE POPULATION.'))
expect_equal(sum_out(sum_warnings(model, software), 2), c('warnings', '(WARNING 2) NM-TRAN INFERS THAT THE DATA ARE POPULATION.\n(WARNING 22) WITH $MSFI AND \"SUBPROBS\", \"TRUE=FINAL\" ...'))
#expect_equal(sum_out(sum_errors(model, software)), c('errors', 'na'))
expect_equal(sum_out(sum_nsig(model, software)), c('nsig', '3.3'))
expect_equal(sum_out(sum_condn(model, software, rounding)), c('condn', '21.5'))
#expect_equal(sum_out(sum_nesample(model, software)), c('nesample', 'na'))
#expect_equal(sum_out(sum_esampleseed(model, software)), c('esampleseed', 'na'))
expect_equal(sum_out(sum_ofv(model, software)), c('ofv', '-1403.905'))
expect_equal(sum_out(sum_method(model, software), 1), c('method', 'foce-i'))
expect_equal(sum_out(sum_method(model = dplyr::tibble(problem = 1L, level = 1L, subroutine = 'est',
code = 'METH=0', comment = ''), software), 1), c('method', 'fo'))
expect_equal(sum_out(sum_method(model, software), 2), c('method', 'sim'))
expect_equal(sum_out(sum_shk(model, software, 'eps', rounding)), c('epsshk', '14.86 [1]'))
skip_on_cran() # Let's wait and see how R 4.0.0 rounding behaves once it's released
expect_equal(sum_out(sum_shk(model, software, 'eta', rounding)), c('etashk', eta_shk_string))
})
test_that('summary default summary is returned for missing information', {
expect_equal(sum_out(sum_version(model2, software)), c('version', 'na'))
expect_equal(sum_out(sum_reference(model2, software)), c('ref', 'na'))
expect_equal(sum_out(sum_probn(model2, software)), c('probn', 'na'))
expect_equal(sum_out(sum_timestart(model2, software)), c('timestart', 'na'))
expect_equal(sum_out(sum_timestop(model2, software)), c('timestop', 'na'))
expect_equal(sum_out(sum_description(model2, software)), c('descr', 'na'))
expect_equal(sum_out(sum_label(model2, software)), c('label', 'na'))
expect_equal(sum_out(sum_input_data(model2, software)), c('data', 'na'))
expect_equal(sum_out(sum_nobs(model2, software)), c('nobs', 'na'))
expect_equal(sum_out(sum_nind(model2, software)), c('nind', 'na'))
expect_equal(sum_out(sum_nsim(model2, software)), c('nsim', 'na'))
expect_equal(sum_out(sum_simseed(model2, software)), c('simseed', 'na'))
expect_equal(sum_out(sum_subroutine(model2, software)), c('subroutine', 'na'))
expect_equal(sum_out(sum_runtime(model2, software)), c('runtime', 'na'))
expect_equal(sum_out(sum_covtime(model2, software)), c('covtime', 'na'))
expect_equal(sum_out(sum_covtime(model = dplyr::tibble(problem = 1L, level = 1L, subroutine = 'lst',
code = 'Elapsed covariance time in seconds: ********',
comment = ''), software), 1), c('covtime', 'na'))
expect_equal(sum_out(sum_term(model2, software)), c('term', 'na'))
expect_equal(sum_out(sum_warnings(model2, software)), c('warnings', 'na'))
expect_equal(sum_out(sum_errors(model2, software)), c('errors', 'na'))
expect_equal(sum_out(sum_nsig(model2, software)), c('nsig', 'na'))
expect_equal(sum_out(sum_condn(model2, software, rounding)), c('condn', 'na'))
expect_equal(sum_out(sum_nesample(model2, software)), c('nesample', 'na'))
expect_equal(sum_out(sum_esampleseed(model2, software)), c('esampleseed', 'na'))
expect_equal(sum_out(sum_ofv(model2, software)), c('ofv', 'na'))
expect_equal(sum_out(sum_method(model2, software)), c('method', 'na'))
expect_equal(sum_out(sum_shk(model2, software, 'eps', rounding)), c('epsshk', 'na'))
expect_equal(sum_out(sum_shk(model2, software, 'eta', rounding)), c('etashk', 'na'))
})
test_that("Termination messages are parsed when minimization is terminated",{
relevant_lst_part <- "#TERM:
0MINIMIZATION TERMINATED
DUE TO PROXIMITY OF NEXT ITERATION EST. TO A VALUE
AT WHICH THE OBJ. FUNC. IS INFINITE
0AT THE LAST COMPUTED INFINITE VALUE OF THE OBJ. FUNCT.:
ERROR IN NCONTR WITH INDIVIDUAL 1 ID= 1.00000000000000E+00
NUMERICAL HESSIAN OF OBJ. FUNC. FOR COMPUTING CONDITIONAL ESTIMATE
IS NON POSITIVE DEFINITE
THETA=
2.79E+00 1.04E-02 4.38E-02 1.90E-01 1.69E+00 1.02E+00 0.00E+00 0.00E+00 0.00E+00 0.00E+00
0.00E+00 0.00E+00 0.00E+00 0.00E+00 -1.00E+00 0.00E+00 -7.84E-01 -1.13E+00 1.57E+00 -9.40E-01
-9.05E-01 -7.71E-01 -8.34E-01 -1.43E+00 7.66E-01 -6.55E-01 -8.89E-01 5.02E-01 -9.12E-01 -9.84E-01
-2.27E+00 -7.53E-01 -8.85E-01 -1.04E+00 -7.16E-01 -4.04E-01 -6.25E+00 -1.15E+00
NO. OF FUNCTION EVALUATIONS USED: 5329
NO. OF SIG. DIGITS UNREPORTABLE
ETABAR IS THE ARITHMETIC MEAN OF THE ETA-ESTIMATES,
AND THE P-VALUE IS GIVEN FOR THE NULL HYPOTHESIS THAT THE TRUE MEAN IS 0.
"
expected_result <- tibble::tibble(problem = 1, subprob = 0, label = 'term', value = "MINIMIZATION TERMINATED\nDUE TO PROXIMITY OF NEXT ITERATION EST. TO A VALUE\nAT WHICH THE OBJ. FUNC. IS INFINITE\n0AT THE LAST COMPUTED INFINITE VALUE OF THE OBJ. FUNCT.:\nERROR IN NCONTR WITH INDIVIDUAL 1 ID= 1.00000...\nNUMERICAL HESSIAN OF OBJ. FUNC. FOR COMPUTING CONDITI...\nIS NON POSITIVE DEFINITE\nTHETA=\n2.79E+00 1.04E-02 4.38E-02 1.90E-01 1.69E+00 ...\n0.00E+00 0.00E+00 0.00E+00 0.00E+00 -1.00E+00 ...\n-9.05E-01 -7.71E-01 -8.34E-01 -1.43E+00 7.66E-01...\n-2.27E+00 -7.53E-01 -8.85E-01 -1.04E+00 -7.16E-01...\n")
model <- tibble::tibble(problem = 1, level = 60, subroutine = 'lst', code = unlist(stringr::str_split(relevant_lst_part, "\\n")), comment = "")
expect_equal(sum_term(model, "nonmem"), expected_result)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.