diff --git a/DESCRIPTION b/DESCRIPTION index 191b2b5..315f87d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: daedalus Title: Model health, social, and economic costs of a pandemic using _DAEDALUS_ -Version: 0.0.16 +Version: 0.0.17 Authors@R: c( person("Pratik", "Gupte", , "p.gupte24@imperial.ac.uk", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-5294-7819")), diff --git a/NEWS.md b/NEWS.md index f5bb1f9..75cb8f6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,12 @@ -# daedalus 0.0.18 +# daedalus 0.0.17 + +This patch removes dual implementation levels for response strategies. The "elimination" strategy has a "high" implementation level, while all other strategies keep their "light" implementation level. + +- The `daedalus()` argument `implementation_level` has been removed. + +- Tests and documentation have been updated to remove references to implementation levels. + +# daedalus 0.0.16 This patch fixes an issue where vaccination start was tied to the `response_time`; it is now correctly controlled by the vaccine investment level passed to `daedalus()`. diff --git a/R/class_infection.R b/R/class_infection.R index 459eacd..e2e7f15 100644 --- a/R/class_infection.R +++ b/R/class_infection.R @@ -316,7 +316,6 @@ print.daedalus_infection <- function(x, ...) { format.daedalus_infection <- function(x, ...) { chkDots(...) - # NOTE: rough implementations, better scaling e.g. to millions could be added cli::cli_text("{.cls {class(x)}}") divid <- cli::cli_div(theme = list(.val = list(digits = 3))) cli::cli_bullets( diff --git a/R/class_output.R b/R/class_output.R index 54f388f..151ee83 100644 --- a/R/class_output.R +++ b/R/class_output.R @@ -28,7 +28,7 @@ validate_daedalus_output <- function(x) { "model_data", # NOTE: reserving 'parameters' for values fixed before model run "country_parameters", "infection_parameters", - "response_data" # includes response strategy and implementation level + "response_data" # includes response strategy ) stopifnot( diff --git a/R/class_vaccination.R b/R/class_vaccination.R index 0e1d4c2..d18ce42 100644 --- a/R/class_vaccination.R +++ b/R/class_vaccination.R @@ -190,7 +190,6 @@ print.daedalus_vaccination <- function(x, ...) { format.daedalus_vaccination <- function(x, ...) { chkDots(...) - # NOTE: rough implementations, better scaling e.g. to millions could be added cli::cli_text("{.cls {class(x)}}") cli::cli_text( "Advance vaccine investment: {cli::style_bold(x$name)}" diff --git a/R/closure_data.R b/R/closure_data.R index fa4491e..025d8e5 100644 --- a/R/closure_data.R +++ b/R/closure_data.R @@ -1,14 +1,13 @@ #' @title Pandemic response strategy data for DAEDALUS #' #' @description Coefficients of openness of economic sectors under different -#' pandemic response strategies. -#' There are four strategies (including no response), with two levels of -#' implementation ("heavy" and "light"). +#' pandemic response strategies. There are four strategies (including no +#' response, identified as `"none"`). #' #' @format ## `closure_data` #' A list with 4 elements, each corresponding to a pandemic response strategy, -#' and each with 2 elements ("heavy" or "light") giving the coefficients of -#' sector openness under different levels of implementation. +#' each a vector `N_ECONOMIC_SECTORS` (45) giving the coefficients of +#' sector openness. #' \describe{ #' \item{none}{All economic sectors are fully open and there is no pandemic #' response.} diff --git a/R/daedalus.R b/R/daedalus.R index 00d8307..d716ce3 100644 --- a/R/daedalus.R +++ b/R/daedalus.R @@ -28,9 +28,6 @@ #' While the response strategy is active, economic contacts are scaled using the #' package data object `daedalus::closure_data`. #' -#' @param implementation_level A string for the level at which the strategy is -#' implemented; defaults to "light". -#' #' @param response_time A single numeric value for the time in days #' at which the selected response is activated. This is ignored if the response #' has already been activated by the hospitalisation threshold being reached. @@ -113,7 +110,6 @@ daedalus <- function(country, "none", "elimination", "economic_closures", "school_closures" ), - implementation_level = c("light", "heavy"), vaccine_investment = c( "none", "low", "medium", "high" ), @@ -136,7 +132,6 @@ daedalus <- function(country, } response_strategy <- rlang::arg_match(response_strategy) - implementation_level <- rlang::arg_match(implementation_level) is_good_time_end <- checkmate::test_count(time_end, positive = TRUE) if (!is_good_time_end) { @@ -215,9 +210,7 @@ daedalus <- function(country, mutables <- prepare_mutable_parameters() # add the appropriate economic openness vectors to parameters - openness <- daedalus::closure_data[[ - response_strategy - ]][[implementation_level]] + openness <- daedalus::closure_data[[response_strategy]] # NOTE: psi (vax waning rate), tau (vax reduction in suscept.), and dims of nu # are hard-coded until vaccination scenarios are decided @@ -351,7 +344,6 @@ daedalus <- function(country, infection_parameters = unclass(infection), response_data = list( response_strategy = response_strategy, - implementation_level = implementation_level, openness = openness, # easier to include here closure_info = get_closure_info(mutables) ) diff --git a/data-raw/closure_data.R b/data-raw/closure_data.R index 2c6de32..de7a0c4 100644 --- a/data-raw/closure_data.R +++ b/data-raw/closure_data.R @@ -57,4 +57,16 @@ closure_data[["none"]] <- list( heavy = rep(1.0, N_ECON_SECTORS) ) +# JIDEA-132: pick a single implementation level for each response strategy +# elimination: heavy; all others: light +levels_to_keep <- c("heavy", rep("light", 3L)) +strategies <- c(strategies, "none") + +closure_data <- Map( + closure_data[strategies], levels_to_keep, + f = function(s, l) { + s[[l]] + } +) + usethis::use_data(closure_data, overwrite = TRUE) diff --git a/data/closure_data.rda b/data/closure_data.rda index 272def6..1cf82af 100644 Binary files a/data/closure_data.rda and b/data/closure_data.rda differ diff --git a/man/closure_data.Rd b/man/closure_data.Rd index 1a12622..902d19b 100644 --- a/man/closure_data.Rd +++ b/man/closure_data.Rd @@ -8,8 +8,8 @@ \subsection{\code{closure_data}}{ A list with 4 elements, each corresponding to a pandemic response strategy, -and each with 2 elements ("heavy" or "light") giving the coefficients of -sector openness under different levels of implementation. +each a vector \code{N_ECONOMIC_SECTORS} (45) giving the coefficients of +sector openness. \describe{ \item{none}{All economic sectors are fully open and there is no pandemic response.} @@ -30,8 +30,7 @@ closure_data } \description{ Coefficients of openness of economic sectors under different -pandemic response strategies. -There are four strategies (including no response), with two levels of -implementation ("heavy" and "light"). +pandemic response strategies. There are four strategies (including no +response, identified as \code{"none"}). } \keyword{datasets} diff --git a/man/daedalus.Rd b/man/daedalus.Rd index ee49f29..ca3b276 100644 --- a/man/daedalus.Rd +++ b/man/daedalus.Rd @@ -8,7 +8,6 @@ daedalus( country, infection, response_strategy = c("none", "elimination", "economic_closures", "school_closures"), - implementation_level = c("light", "heavy"), vaccine_investment = c("none", "low", "medium", "high"), response_time = 30, response_threshold = NULL, @@ -44,9 +43,6 @@ response threshold following which the response is activated. See While the response strategy is active, economic contacts are scaled using the package data object \code{daedalus::closure_data}.} -\item{implementation_level}{A string for the level at which the strategy is -implemented; defaults to "light".} - \item{vaccine_investment}{Either a single string or a \verb{} object specifying the vaccination parameters associated with an advance vaccine-investment scenario. Defaults to \code{"none"}, diff --git a/tests/testthat/test-closures.R b/tests/testthat/test-closures.R index e35cfb6..5f7756a 100644 --- a/tests/testthat/test-closures.R +++ b/tests/testthat/test-closures.R @@ -3,7 +3,6 @@ response_names <- c( "none", "elimination", "economic_closures", "school_closures" ) -response_level <- c("light", "heavy") country_x <- daedalus_country("Thailand") test_that("Closures: basic expectations: runs without errors", { @@ -14,106 +13,36 @@ test_that("Closures: basic expectations: runs without errors", { }) }) - # test some combinations of responses and implementation levels - expect_no_condition({ - output_list <- Map( - response_names, response_level, - f = function(x, y) { - daedalus( - country_x, "sars_cov_1", - response_strategy = x, implementation_level = y + # test combinations of responses and some countries + invisible({ + Map( + response_names, daedalus::country_names[seq_along(response_names)], + f = function(response, country) { + expect_no_condition( + daedalus( + country, "sars_cov_1", + response_strategy = response + ) ) } ) }) }) -# expectation that response strategy 'none' has little to no effect -test_that("Closures: no response leads to similar epidemic sizes", { - # both implementation levels have identical epidemic sizes - levels <- c("light", "heavy") - output_list <- lapply(levels, function(x) { - daedalus( - country_x, "sars_cov_1", - response_strategy = "none", implementation_level = x - ) - }) - - epidemic_sizes <- vapply( - output_list, function(x) { - x <- get_data(x) - sum(x[x$compartment == "recovered" & x$time == max(x$time), ]$value) - }, numeric(1) - ) - - expect_identical( - epidemic_sizes[1], epidemic_sizes[2] - ) - - # response time has no effect when strategy is 'none' - response_times <- c(10, 100) - response_threshold <- 1e7 # artificially large - output_list <- lapply(response_times, function(x) { - daedalus( - country_x, "sars_cov_1", - response_strategy = "none", response_time = x, - response_threshold = response_threshold - ) - }) - - epidemic_sizes <- vapply( - output_list, function(x) { - x <- get_data(x) - sum(x[x$compartment == "recovered" & x$time == max(x$time), ]$value) - }, numeric(1) - ) - # NOTE high tolerance as the two have just slightly different final sizes - expect_identical( - epidemic_sizes[1], epidemic_sizes[2], - tolerance = 1L - ) - - # response threshold has no effect when strategy is 'none' - response_thresholds <- c(10, 1000) - time_end <- 300 - response_time <- time_end - 2L # artificially long response time - output_list <- lapply(response_thresholds, function(x) { - daedalus( - country_x, "sars_cov_1", - response_strategy = "none", response_time = response_time, - response_threshold = x - ) - }) - - epidemic_sizes <- vapply( - output_list, function(x) { - x <- get_data(x) - sum(x[x$compartment == "recovered" & x$time == max(x$time), ]$value) - }, numeric(1) - ) - - # NOTE high tolerance as the two have just slightly different final sizes - expect_identical( - epidemic_sizes[1], epidemic_sizes[2], - tolerance = 1L - ) -}) - # expect that applying closures reduces epidemic size test_that("Closures: basic statistical correctness: reduces epidemic size", { output_list <- lapply(response_names, function(x) { daedalus( country_x, daedalus_infection("sars_cov_1", rho = 0.0), - response_strategy = x, - implementation_level = "light" # test on light as this differs b/w strats + response_strategy = x ) }) epidemic_sizes <- vapply( output_list, function(x) { - x <- get_data(x) - sum(x[x$compartment == "recovered" & x$time == max(x$time), ]$value) - }, numeric(1) + get_epidemic_summary(x, "infections")[["value"]] + }, + FUN.VALUE = numeric(1L) ) expect_true( @@ -130,16 +59,15 @@ test_that("Closures: earlier closures reduce epidemic size", { country_x, daedalus_infection("sars_cov_1", rho = 0.0), response_strategy = "elimination", response_time = x, - response_threshold = response_threshold, - implementation_level = "light" + response_threshold = response_threshold ) }) epidemic_sizes <- vapply( output_list, function(x) { - x <- get_data(x) - sum(x[x$compartment == "recovered" & x$time == max(x$time), ]$value) - }, numeric(1) + get_epidemic_summary(x, "infections")[["value"]] + }, + FUN.VALUE = numeric(1L) ) expect_lt( @@ -156,7 +84,6 @@ test_that("Closures: lower threshold reduces epidemic size", { daedalus( country_x, daedalus_infection("sars_cov_1", rho = 0.0), response_strategy = "elimination", - implementation_level = "heavy", response_threshold = x, response_time = 200 # artificially high ) @@ -164,9 +91,9 @@ test_that("Closures: lower threshold reduces epidemic size", { epidemic_sizes <- vapply( output_list, function(x) { - x <- get_data(x) - sum(x[x$compartment == "recovered" & x$time == max(x$time), ]$value) - }, numeric(1) + get_epidemic_summary(x, "infections")[["value"]] + }, + FUN.VALUE = numeric(1L) ) expect_lt(