diff --git a/DESCRIPTION b/DESCRIPTION index 84be4f91..5fd6dcd9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: stoner Title: Support for Building VIMC Montagu Touchstones, using Dettl -Version: 0.1.6 +Version: 0.1.7 Authors@R: c(person("Wes", "Hinsley",role = c("aut", "cre", "cst", "dnc", "elg", "itr", "sng"), email = "w.hinsley@imperial.ac.uk"), @@ -25,7 +25,7 @@ Imports: withr, jsonlite Language: en-GB -RoxygenNote: 7.1.1 +RoxygenNote: 7.1.2 Roxygen: list(markdown = TRUE) Suggests: knitr, diff --git a/R/stochastic_process.R b/R/stochastic_process.R index bc71660e..5e9450e9 100644 --- a/R/stochastic_process.R +++ b/R/stochastic_process.R @@ -61,6 +61,9 @@ ##' @param bypass_cert_check If TRUE, then no checks are carried out on the ##' parameter certificate (if provided). ##' @param testing For internal use only. +##' @param lines Number of lines to read from each file, Inf by default to +##' read all lines. Set a lower number for testing subset of process before +##' doing the full run. stone_stochastic_process <- function(con, modelling_group, disease, touchstone, scenarios, in_path, files, cert, index_start, index_end, out_path, @@ -72,7 +75,8 @@ stone_stochastic_process <- function(con, modelling_group, disease, annex = NULL, allow_new_database = FALSE, bypass_cert_check = FALSE, - testing = FALSE) { + testing = FALSE, + lines = Inf) { ## Setup life table cache cache$life_table <- NULL @@ -102,13 +106,15 @@ stone_stochastic_process <- function(con, modelling_group, disease, upload_to_annex = upload_to_annex, annex = annex, cert = cert, - bypass_cert_check = bypass_cert_check) + bypass_cert_check = bypass_cert_check, + lines = lines) read_params <- list( in_path = in_path, files = files, runid_from_file = runid_from_file, - allow_missing_disease = allow_missing_disease + allow_missing_disease = allow_missing_disease, + lines = lines ) all_aggregated <- all_scenarios(con, touchpoint = touchpoint, @@ -216,6 +222,7 @@ bind_scenarios <- function(all_aggregated, scen_aggregated) { process_scenario <- function(con, scenario, files, touchpoint, read_params, outcomes, countries) { scenario_data <- list() + lines <- read_params$lines ################################################################ @@ -226,7 +233,8 @@ process_scenario <- function(con, scenario, files, touchpoint, read_xz_csv(con, the_file, outcomes, read_params$allow_missing_disease, read_params$runid_from_file, i, - touchpoint$touchstone, countries) + touchpoint$touchstone, countries, + lines = lines) } # We now have a full scenario. Eliminate age, splitting into @@ -310,7 +318,8 @@ calc_outcomes <- function(csv, outcomes, single_outcome) { } read_xz_csv <- function(con, the_file, outcomes, allow_missing_disease, - runid_from_file, run_id, touchstone, countries) { + runid_from_file, run_id, touchstone, countries, + lines) { if (is.data.frame(outcomes$dalys)) { dalys_cols <- unique(outcomes$dalys$outcome) @@ -346,7 +355,8 @@ read_xz_csv <- function(con, the_file, outcomes, allow_missing_disease, csv <- suppressMessages(as.data.table( read_large_file(the_file, col_types = columns, - progress = FALSE, na = "NA") + progress = FALSE, na = "NA", + n_max = lines) )) for (n in names(csv)) { @@ -452,7 +462,9 @@ stochastic_process_validate <- function(con, touchpoint, scenarios, in_path, runid_from_file, upload_to_annex, annex, - cert, bypass_cert_check) { + cert, + bypass_cert_check, + lines) { assert_connection(con) if (upload_to_annex) { assert_connection(annex) @@ -549,6 +561,8 @@ stochastic_process_validate <- function(con, touchpoint, scenarios, in_path, } } + assert_scalar_numeric(lines) + for (scenario in scenarios) { stochastic_validate_scenario(con, touchpoint, scenario) } diff --git a/R/util_assert.R b/R/util_assert.R index c2e584eb..312fcb1c 100644 --- a/R/util_assert.R +++ b/R/util_assert.R @@ -22,6 +22,12 @@ assert_character <- function(x, name = deparse(substitute(x))) { } } +assert_numeric <- function(x, name = deparse(substitute(x))) { + if (!is.numeric(x)) { + stop(sprintf("'%s' must be a number", name), call. = FALSE) + } +} + assert_scalar_character <- function(x, name = deparse(substitute(x))) { assert_character(x, name) assert_scalar(x, name) @@ -43,6 +49,12 @@ assert_scalar_logical <- function(x, name = deparse(substitute(x))) { assert_nonmissing(x, name) } +assert_scalar_numeric <- function(x, name = deparse(substitute(x))) { + assert_numeric(x, name) + assert_scalar(x, name) + assert_nonmissing(x, name) +} + assert_connection <- function(x, name = deparse(substitute(x))) { if (!inherits(x, "PqConnection")) { stop(sprintf("'%s' must be a PqConnection object", name), call. = FALSE) diff --git a/man/stone_stochastic_process.Rd b/man/stone_stochastic_process.Rd index d5e588b7..d1a1696e 100644 --- a/man/stone_stochastic_process.Rd +++ b/man/stone_stochastic_process.Rd @@ -25,7 +25,8 @@ stone_stochastic_process( annex = NULL, allow_new_database = FALSE, bypass_cert_check = FALSE, - testing = FALSE + testing = FALSE, + lines = Inf ) } \arguments{ @@ -102,6 +103,10 @@ creating the stochastic_file table if it is not found.} parameter certificate (if provided).} \item{testing}{For internal use only.} + +\item{lines}{Number of lines to read from each file, Inf by default to +read all lines. Set a lower number for testing subset of process before +doing the full run.} } \description{ Convert a modelling group's stochastic files into the summary format, diff --git a/tests/testthat/helper-tests.R b/tests/testthat/helper-tests.R index e143a8b2..92a5b0ce 100644 --- a/tests/testthat/helper-tests.R +++ b/tests/testthat/helper-tests.R @@ -417,3 +417,7 @@ empty_dump <- function() { dir.create(tmp, showWarnings = FALSE) tmp } + +expect_no_error <- function(object) { + expect_error(object, NA) +} diff --git a/tests/testthat/test_stochastic_process.R b/tests/testthat/test_stochastic_process.R index 806dbb93..d27c70cc 100644 --- a/tests/testthat/test_stochastic_process.R +++ b/tests/testthat/test_stochastic_process.R @@ -341,7 +341,8 @@ stochastic_runner <- function(same_countries = TRUE, allow_new_database = TRUE, bypass_cert_check = TRUE, dalys_df = NULL, - cert = "") { + cert = "", + lines = Inf) { test <- new_test() @@ -388,7 +389,8 @@ stochastic_runner <- function(same_countries = TRUE, upload_to_annex = upload, annex = test$con, allow_new_database = allow_new_database, bypass_cert_check = bypass_cert_check, - testing = TRUE) + testing = TRUE, + lines = lines) list( test = test, raw = res$raw, @@ -781,3 +783,12 @@ test_that("Stochastic - with DALYs", { expect_equal(dat$data$dalys, dalys_pies$dalys_pies) }) + + +test_that("Stochastic - can run with subset of data", { + out <- stochastic_runner(lines = 10) + expect_equal(nrow(out$cal), 10) + expect_equal(nrow(out$cal_u5), 10) + expect_equal(nrow(out$coh), 10) + expect_equal(nrow(out$coh_u5), 10) +}) diff --git a/tests/testthat/test_utils.R b/tests/testthat/test_utils.R index 2a4869e8..182e20ed 100644 --- a/tests/testthat/test_utils.R +++ b/tests/testthat/test_utils.R @@ -62,3 +62,12 @@ test_that("Asserts", { expect_invisible(assert_scalar_logical(FALSE)) }) + +test_that("assert_scalar_numeric works as expected", { + expect_no_error(assert_scalar_numeric(Inf)) + expect_no_error(assert_scalar_numeric(10)) + expect_error(assert_scalar_numeric(c(2, 10)), "'c(2, 10)' must be a scalar", + fixed = TRUE) + expect_error(assert_scalar_numeric("test"), "'\"test\"' must be a number", + fixed = TRUE) +})