Merge pull request #20 from vimc/vimc-6489

vimc-6489: Add arg to stone_stochastic_process to run with a subset of rows

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,

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)
   }

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)

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)
+}

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)
+})

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)
+})