From ce3633934f0e93e3baa0f23429f80629fb1ab09a Mon Sep 17 00:00:00 2001 From: pratikunterwegs Date: Thu, 11 Apr 2024 12:53:55 +0100 Subject: [PATCH 01/10] Update `epidemic_size()`; WIP #190 --- R/helpers.R | 98 ++++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 78 insertions(+), 20 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index e65a3c47..b00075dc 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -90,11 +90,14 @@ #' #' @param data A table of model output, typically #' the output of [model_default()] or similar functions. -#' @param stage The stage of the epidemic at which to return the epidemic size; -#' here, 0.0 represents the initial conditions of the epidemic (0% of model time -#' ), while 1.0 represents the end of the epidemic model (100% of model time). -#' The values returned at `stage = 1.0` represent the _final size_ of the -#' epidemic. +#' @param stage A numeric vector for the stage of the epidemic at which to +#' return the epidemic size; here, 0.0 represents the initial conditions of the +#' epidemic (0% of model time), while 1.0 represents the end of the epidemic +#' model (100% of model time). Defaults to 1.0, at which stage returned values +#' represent the _final size_ of the epidemic. +#' This value is overridden by any values passed to the `time` argument. +#' @param time An optional numeric vector for the timepoint of the epidemic at +#' which to return the epidemic size. Overrides any values passed to `stage`. #' @param by_group A logical representing whether the epidemic size should be #' returned by demographic group, or whether a single population-wide value is #' returned. Defaults to `TRUE`. @@ -104,9 +107,22 @@ #' in the data. If there is no such column, the function returns #' only the final number of recovered or removed individuals in each demographic #' group. -#' @return A single number when `by_group = FALSE`, or a vector of numbers of -#' the same length as the number of demographic groups when `by_group = TRUE`. -#' Returns the absolute sizes and not proportions. +#' @param simplify A logical determining whether the epidemic size data should +#' be simplified to a vector with one element for each demographic group. +#' If the length of `stage` or `time` is $>$ 1, this argument is overridden and +#' the data are returned as a ``. +#' group. +#' @return +#' If `simplify == TRUE` and a single timepoint is requested, returns a vector +#' of epidemic sizes of the same length as the number of demographic groups. +#' If `by_group == FALSE`, sums the epidemic size to return an overall value for +#' the full population. +#' +#' If multiple timepoints are requested, no simplification to a vector is +#' possible; returns a `` of timepoints and epidemic sizes at each +#' timepoint. +#' +#' All options return the absolute sizes and not proportions. #' @export #' #' @examples @@ -132,8 +148,8 @@ #' # get the epidemic size at the halfway point #' epidemic_size(data, stage = 0.5) epidemic_size <- function( - data, stage = 1.0, by_group = TRUE, - include_deaths = TRUE) { + data, stage = 1.0, time = NULL, by_group = TRUE, + include_deaths = TRUE, simplify = TRUE) { # input checking for data - this allows data.tables as well checkmate::assert_data_frame( data, @@ -145,20 +161,31 @@ epidemic_size <- function( ) checkmate::assert_logical(by_group, len = 1L) checkmate::assert_logical(include_deaths, len = 1L) - checkmate::assert_number(stage, lower = 0.0, upper = 1.0, finite = TRUE) + checkmate::assert_numeric( + stage, + lower = 0.0, upper = 1.0, finite = TRUE, + null.ok = TRUE, any.missing = FALSE + ) + checkmate::assert_integerish( + time, + lower = 0, upper = max(data[["time"]]), # not suitable for Ebola model + null.ok = TRUE, any.missing = FALSE + ) stopifnot( "No 'recovered' or 'removed' compartment in `data`, check compartments" = any(c("removed", "recovered") %in% unique(data$compartment)), "`data` should have only one of 'recovered' or 'removed' compartments" = - !all(c("removed", "recovered") %in% unique(data$compartment)) + !all(c("removed", "recovered") %in% unique(data$compartment)), + "One of `stage` or `time` must be provided; both are NULL!" = + !all(is.null(c(stage, time))) ) # if deaths are requested to be counted, but no "dead" compartment exists # throw a message if (include_deaths && (!"dead" %in% unique(data$compartment))) { message( - "No 'dead' compartment found in `data`; counting only 'recovered'", - " individuals in the epidemic size." + "epidemic_size(): No 'dead' compartment found in `data`; counting only", + " 'recovered' or 'removed' individuals in the epidemic size." ) } # add include_deaths to compartments to search @@ -167,19 +194,50 @@ epidemic_size <- function( "recovered", "removed" ) if (include_deaths) { - size_compartments <- c(size_compartments, "include_deaths") + size_compartments <- c(size_compartments, "dead") + } + + # calculate time to get and override stage if provided + times_to_get <- round(max(data$time) * stage, 2) + if (!is.null(time)) { + message( + "epidemic_size(): `time` provided will override any `stage` provided" + ) + times_to_get <- time + } + + if (length(times_to_get) > 1L) { + message( + "Returning epidemic size by demographic group, cannot simplify to vector" + ) + simplify <- FALSE } # get final numbers recovered - operate on data.table as though data.table epidemic_size_ <- data[data$compartment %in% size_compartments & - data$time == round(max(data$time) * stage, 2), ] + data$time %in% times_to_get, ] + + # set data.table if not already, reove after #211 is merged + data.table::setDT(epidemic_size_) + # NOTE: requires data.table if (by_group) { - epidemic_size_ <- epidemic_size_[["value"]] - names(epidemic_size_) <- unique(data$demography_group) + epidemic_size_ <- epidemic_size_[, + list(value = sum(.SD)), + .SDcols = "value", + by = c("time", "demography_group") + ] + if (simplify) { + epidemic_size_ <- epidemic_size_[["value"]] + } } else { - epidemic_size_ <- sum(epidemic_size_[["value"]]) - names(epidemic_size_) <- "total_population" + epidemic_size_ <- epidemic_size_[, + list(value = sum(.SD)), + by = "time", .SDcols = "value" + ] + if (simplify) { + epidemic_size_ <- epidemic_size_[["value"]] + } } # return epidemic size From 8322ff3c40eb9583d29b3688b296886ef9d41cf4 Mon Sep 17 00:00:00 2001 From: pratikunterwegs Date: Thu, 11 Apr 2024 12:54:24 +0100 Subject: [PATCH 02/10] Update `epidemic_size()` tests and docs; WIP #190 --- DESCRIPTION | 2 +- man/epidemic_size.Rd | 42 ++++++++++++++++++++++------- tests/testthat/test-epidemic_size.R | 27 ++++++++++++++++++- 3 files changed, 60 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7d4f526e..9b826e25 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -67,4 +67,4 @@ Config/testthat/edition: 3 Encoding: UTF-8 Language: en-GB Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 diff --git a/man/epidemic_size.Rd b/man/epidemic_size.Rd index 400f3635..78d2421c 100644 --- a/man/epidemic_size.Rd +++ b/man/epidemic_size.Rd @@ -4,17 +4,28 @@ \alias{epidemic_size} \title{Get the epidemic size} \usage{ -epidemic_size(data, stage = 1, by_group = TRUE, include_deaths = TRUE) +epidemic_size( + data, + stage = 1, + time = NULL, + by_group = TRUE, + include_deaths = TRUE, + simplify = TRUE +) } \arguments{ \item{data}{A table of model output, typically the output of \code{\link[=model_default]{model_default()}} or similar functions.} -\item{stage}{The stage of the epidemic at which to return the epidemic size; -here, 0.0 represents the initial conditions of the epidemic (0\% of model time -), while 1.0 represents the end of the epidemic model (100\% of model time). -The values returned at \code{stage = 1.0} represent the \emph{final size} of the -epidemic.} +\item{stage}{A numeric vector for the stage of the epidemic at which to +return the epidemic size; here, 0.0 represents the initial conditions of the +epidemic (0\% of model time), while 1.0 represents the end of the epidemic +model (100\% of model time). Defaults to 1.0, at which stage returned values +represent the \emph{final size} of the epidemic. +This value is overridden by any values passed to the \code{time} argument.} + +\item{time}{An optional numeric vector for the timepoint of the epidemic at +which to return the epidemic size. Overrides any values passed to \code{stage}.} \item{by_group}{A logical representing whether the epidemic size should be returned by demographic group, or whether a single population-wide value is @@ -26,11 +37,24 @@ Defaults to \code{TRUE}, which makes the function look for a \code{"dead"} compa in the data. If there is no such column, the function returns only the final number of recovered or removed individuals in each demographic group.} + +\item{simplify}{A logical determining whether the epidemic size data should +be simplified to a vector with one element for each demographic group. +If the length of \code{stage} or \code{time} is $>$ 1, this argument is overridden and +the data are returned as a \verb{}. +group.} } \value{ -A single number when \code{by_group = FALSE}, or a vector of numbers of -the same length as the number of demographic groups when \code{by_group = TRUE}. -Returns the absolute sizes and not proportions. +If \code{simplify == TRUE} and a single timepoint is requested, returns a vector +of epidemic sizes of the same length as the number of demographic groups. +If \code{by_group == FALSE}, sums the epidemic size to return an overall value for +the full population. + +If multiple timepoints are requested, no simplification to a vector is +possible; returns a \verb{} of timepoints and epidemic sizes at each +timepoint. + +All options return the absolute sizes and not proportions. } \description{ Get the size of the epidemic at any stage between the start and the end. diff --git a/tests/testthat/test-epidemic_size.R b/tests/testthat/test-epidemic_size.R index fd944699..75122f23 100644 --- a/tests/testthat/test-epidemic_size.R +++ b/tests/testthat/test-epidemic_size.R @@ -19,10 +19,11 @@ uk_population <- population( initial_conditions = initial_conditions ) +time_end <- 200 # run epidemic simulation with no vaccination or intervention data <- model_default( population = uk_population, - time_end = 200, + time_end = time_end, increment = 1 ) @@ -34,6 +35,11 @@ test_that("Epidemic size functions", { initial_conditions[, "infectious"], ignore_attr = TRUE ) + expect_equal( + epidemic_size(data, time = 0), + epidemic_initial_size, + ignore_attr = TRUE + ) # test the final size epidemic_final_size <- epidemic_size(data) @@ -42,6 +48,25 @@ test_that("Epidemic size functions", { data[data$compartment == "recovered" & data$time == max(data$time), ]$value, ignore_attr = TRUE ) + expect_equal( + epidemic_size(data, time = time_end), + epidemic_final_size, + ignore_attr = TRUE + ) + + # expect return types and contents + expect_s3_class( + epidemic_size(data, simplify = FALSE), + "data.table" + ) + expect_s3_class( + epidemic_size(data, by_group = FALSE, simplify = FALSE), + "data.table" + ) + expect_s3_class( + epidemic_size(data, time = c(1, 2), simplify = TRUE), + "data.table" + ) # expect that the final size proportion is the same as the demography prop. expect_equal( From 072821ddbb830f6202948806b6d347dcc4fa7c31 Mon Sep 17 00:00:00 2001 From: pratikunterwegs Date: Fri, 12 Apr 2024 14:59:24 +0100 Subject: [PATCH 03/10] Handle Ebola model replicates in epidemic_size(), see #211 --- R/helpers.R | 46 +++++++++++++++-------------- man/epidemic_size.Rd | 7 +++-- tests/testthat/test-epidemic_size.R | 29 ++++++++++++++++++ 3 files changed, 57 insertions(+), 25 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index b00075dc..4db30e00 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -118,9 +118,10 @@ #' If `by_group == FALSE`, sums the epidemic size to return an overall value for #' the full population. #' -#' If multiple timepoints are requested, no simplification to a vector is -#' possible; returns a `` of timepoints and epidemic sizes at each -#' timepoint. +#' If multiple timepoints are requested, or if multiple replicates are present +#' under a specially named column "replicate" (only from the Ebola model), no +#' simplification to a vector is possible; returns a `` of +#' timepoints and epidemic sizes at each timepoint. #' #' All options return the absolute sizes and not proportions. #' @export @@ -206,9 +207,20 @@ epidemic_size <- function( times_to_get <- time } - if (length(times_to_get) > 1L) { + # determine grouping columns to handle ebola model special case + grouping_cols <- c("time") + if (by_group) { + grouping_cols <- c(grouping_cols, "demography_group") + } + if ("replicate" %in% colnames(data)) { + grouping_cols <- c(grouping_cols, "replicate") + n_replicates <- max(data[["replicate"]]) + } + + if (length(times_to_get) > 1L || n_replicates > 1) { message( - "Returning epidemic size by demographic group, cannot simplify to vector" + "Returning epidemic size at multiple time points, or for multiple", + " replicates; cannot simplify output to vector; returning ``" ) simplify <- FALSE } @@ -221,23 +233,13 @@ epidemic_size <- function( data.table::setDT(epidemic_size_) # NOTE: requires data.table - if (by_group) { - epidemic_size_ <- epidemic_size_[, - list(value = sum(.SD)), - .SDcols = "value", - by = c("time", "demography_group") - ] - if (simplify) { - epidemic_size_ <- epidemic_size_[["value"]] - } - } else { - epidemic_size_ <- epidemic_size_[, - list(value = sum(.SD)), - by = "time", .SDcols = "value" - ] - if (simplify) { - epidemic_size_ <- epidemic_size_[["value"]] - } + epidemic_size_ <- epidemic_size_[, + list(value = sum(.SD)), + .SDcols = "value", + by = grouping_cols + ] + if (simplify) { + epidemic_size_ <- epidemic_size_[["value"]] } # return epidemic size diff --git a/man/epidemic_size.Rd b/man/epidemic_size.Rd index 78d2421c..3e9d7a07 100644 --- a/man/epidemic_size.Rd +++ b/man/epidemic_size.Rd @@ -50,9 +50,10 @@ of epidemic sizes of the same length as the number of demographic groups. If \code{by_group == FALSE}, sums the epidemic size to return an overall value for the full population. -If multiple timepoints are requested, no simplification to a vector is -possible; returns a \verb{} of timepoints and epidemic sizes at each -timepoint. +If multiple timepoints are requested, or if multiple replicates are present +under a specially named column "replicate" (only from the Ebola model), no +simplification to a vector is possible; returns a \verb{} of +timepoints and epidemic sizes at each timepoint. All options return the absolute sizes and not proportions. } diff --git a/tests/testthat/test-epidemic_size.R b/tests/testthat/test-epidemic_size.R index 75122f23..447f2f87 100644 --- a/tests/testthat/test-epidemic_size.R +++ b/tests/testthat/test-epidemic_size.R @@ -121,3 +121,32 @@ test_that("Epidemic size with no deaths is correct", { epidemic_size(data) ) }) + +test_that("Epidemic size for ebola model with replicates", { + # prepare data + demography_vector <- 67000 + replicates <- 100L + + pop <- population( + contact_matrix = matrix(1), + demography_vector = demography_vector, + initial_conditions = matrix( + c(1 - 1e-3, 1e-3 / 2, 1e-3 / 2, 0, 0, 0), + nrow = 1 + ) + ) + + # expect that function returns data.table when replicates > 1 + output <- model_ebola(pop, replicates = replicates) + data <- epidemic_size(output, simplify = TRUE) + + expect_s3_class(data, "data.table") + expect_identical( + nrow(data), replicates + ) + + # expect that output can be simplified when replicates = 1 + output <- model_ebola(pop, replicates = 1L) + data <- epidemic_size(output, simplify = TRUE) + expect_vector(data, numeric()) +}) From 50eed4cd5ca3aa17a6e980649ffb39cb80c4e9fa Mon Sep 17 00:00:00 2001 From: pratikunterwegs Date: Fri, 12 Apr 2024 15:03:30 +0100 Subject: [PATCH 04/10] Add dummy `n_replicate` counter for ODE models --- R/helpers.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/helpers.R b/R/helpers.R index 4db30e00..99b86e9f 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -212,6 +212,7 @@ epidemic_size <- function( if (by_group) { grouping_cols <- c(grouping_cols, "demography_group") } + n_replicates <- 1 # set dummy value if ("replicate" %in% colnames(data)) { grouping_cols <- c(grouping_cols, "replicate") n_replicates <- max(data[["replicate"]]) From 7ee37fb08d79bc16ca13ef4ca756808d4a01d4a2 Mon Sep 17 00:00:00 2001 From: pratikunterwegs Date: Fri, 12 Apr 2024 15:07:34 +0100 Subject: [PATCH 05/10] Remove unnecessary concat --- R/helpers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/helpers.R b/R/helpers.R index 99b86e9f..c1696dea 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -208,7 +208,7 @@ epidemic_size <- function( } # determine grouping columns to handle ebola model special case - grouping_cols <- c("time") + grouping_cols <- "time" if (by_group) { grouping_cols <- c(grouping_cols, "demography_group") } From a0226c5e1628ba6238c3c38d6c1d03a388d86bc8 Mon Sep 17 00:00:00 2001 From: Pratik Gupte Date: Mon, 22 Apr 2024 13:47:29 +0100 Subject: [PATCH 06/10] Correct epidemic_size() documentation Co-authored-by: James Azam --- R/helpers.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index c1696dea..52a821d9 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -91,8 +91,8 @@ #' @param data A table of model output, typically #' the output of [model_default()] or similar functions. #' @param stage A numeric vector for the stage of the epidemic at which to -#' return the epidemic size; here, 0.0 represents the initial conditions of the -#' epidemic (0% of model time), while 1.0 represents the end of the epidemic +#' return the epidemic size; here, 0.0 represents the start time of the epidemic, i.e., the initial conditions of the +#' epidemic simulation, while 1.0 represents the end of the epidemic simulation. #' model (100% of model time). Defaults to 1.0, at which stage returned values #' represent the _final size_ of the epidemic. #' This value is overridden by any values passed to the `time` argument. @@ -111,7 +111,6 @@ #' be simplified to a vector with one element for each demographic group. #' If the length of `stage` or `time` is $>$ 1, this argument is overridden and #' the data are returned as a ``. -#' group. #' @return #' If `simplify == TRUE` and a single timepoint is requested, returns a vector #' of epidemic sizes of the same length as the number of demographic groups. From 686fdfb81e18947c0970c05e1fc929657c74e09a Mon Sep 17 00:00:00 2001 From: pratikunterwegs Date: Mon, 22 Apr 2024 13:39:20 +0100 Subject: [PATCH 07/10] epidemic_size(): deaths default F, update msgs and warnings --- R/helpers.R | 30 +++++++++++++++++------------- man/epidemic_size.Rd | 25 ++++++++++++++----------- 2 files changed, 31 insertions(+), 24 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index 52a821d9..2d509a47 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -89,24 +89,25 @@ #' group as well as the total epidemic size. #' #' @param data A table of model output, typically -#' the output of [model_default()] or similar functions. +#' the output of [model_de ault()] or similar functions. #' @param stage A numeric vector for the stage of the epidemic at which to #' return the epidemic size; here, 0.0 represents the start time of the epidemic, i.e., the initial conditions of the #' epidemic simulation, while 1.0 represents the end of the epidemic simulation. #' model (100% of model time). Defaults to 1.0, at which stage returned values #' represent the _final size_ of the epidemic. #' This value is overridden by any values passed to the `time` argument. -#' @param time An optional numeric vector for the timepoint of the epidemic at -#' which to return the epidemic size. Overrides any values passed to `stage`. +#' @param time Alternative to `stage`, an integer-like vector for the timepoint +#' of the epidemic at which to return the epidemic size. +#' Overrides any values passed to `stage`. #' @param by_group A logical representing whether the epidemic size should be #' returned by demographic group, or whether a single population-wide value is #' returned. Defaults to `TRUE`. #' @param include_deaths A logical value that indicates whether to count dead #' individuals in the epidemic size calculation. -#' Defaults to `TRUE`, which makes the function look for a `"dead"` compartment -#' in the data. If there is no such column, the function returns -#' only the final number of recovered or removed individuals in each demographic -#' group. +#' Defaults to `FALSE`. Setting `include_deaths = TRUE` makes the function look +#' for a `"dead"` compartment in the data. If there is no such column, the +#' function returns only the final number of recovered or removed individuals in +#' each demographic group. #' @param simplify A logical determining whether the epidemic size data should #' be simplified to a vector with one element for each demographic group. #' If the length of `stage` or `time` is $>$ 1, this argument is overridden and @@ -142,14 +143,17 @@ #' population = uk_population #' ) #' -#' # get the final epidemic size +#' # get the final epidemic size if no other arguments are specified #' epidemic_size(data) #' #' # get the epidemic size at the halfway point #' epidemic_size(data, stage = 0.5) +#' +#' # alternatively, get the epidemic size at `time = 50` +#' epidemic_size(data, time = 50) epidemic_size <- function( data, stage = 1.0, time = NULL, by_group = TRUE, - include_deaths = TRUE, simplify = TRUE) { + include_deaths = FALSE, simplify = TRUE) { # input checking for data - this allows data.tables as well checkmate::assert_data_frame( data, @@ -183,7 +187,7 @@ epidemic_size <- function( # if deaths are requested to be counted, but no "dead" compartment exists # throw a message if (include_deaths && (!"dead" %in% unique(data$compartment))) { - message( + warning( "epidemic_size(): No 'dead' compartment found in `data`; counting only", " 'recovered' or 'removed' individuals in the epidemic size." ) @@ -200,7 +204,7 @@ epidemic_size <- function( # calculate time to get and override stage if provided times_to_get <- round(max(data$time) * stage, 2) if (!is.null(time)) { - message( + cli::cli_inform( "epidemic_size(): `time` provided will override any `stage` provided" ) times_to_get <- time @@ -217,8 +221,8 @@ epidemic_size <- function( n_replicates <- max(data[["replicate"]]) } - if (length(times_to_get) > 1L || n_replicates > 1) { - message( + if ((length(times_to_get) > 1L || n_replicates > 1) && simplify) { + warning( "Returning epidemic size at multiple time points, or for multiple", " replicates; cannot simplify output to vector; returning ``" ) diff --git a/man/epidemic_size.Rd b/man/epidemic_size.Rd index 3e9d7a07..6ecb3b1f 100644 --- a/man/epidemic_size.Rd +++ b/man/epidemic_size.Rd @@ -9,13 +9,13 @@ epidemic_size( stage = 1, time = NULL, by_group = TRUE, - include_deaths = TRUE, + include_deaths = FALSE, simplify = TRUE ) } \arguments{ \item{data}{A table of model output, typically -the output of \code{\link[=model_default]{model_default()}} or similar functions.} +the output of \code{\link[=model_de ault]{model_de ault()}} or similar functions.} \item{stage}{A numeric vector for the stage of the epidemic at which to return the epidemic size; here, 0.0 represents the initial conditions of the @@ -24,8 +24,9 @@ model (100\% of model time). Defaults to 1.0, at which stage returned values represent the \emph{final size} of the epidemic. This value is overridden by any values passed to the \code{time} argument.} -\item{time}{An optional numeric vector for the timepoint of the epidemic at -which to return the epidemic size. Overrides any values passed to \code{stage}.} +\item{time}{Alternative to \code{stage}, an integer-like vector for the timepoint +of the epidemic at which to return the epidemic size. +Overrides any values passed to \code{stage}.} \item{by_group}{A logical representing whether the epidemic size should be returned by demographic group, or whether a single population-wide value is @@ -33,16 +34,15 @@ returned. Defaults to \code{TRUE}.} \item{include_deaths}{A logical value that indicates whether to count dead individuals in the epidemic size calculation. -Defaults to \code{TRUE}, which makes the function look for a \code{"dead"} compartment -in the data. If there is no such column, the function returns -only the final number of recovered or removed individuals in each demographic -group.} +Defaults to \code{FALSE}. Setting \code{include_deaths = TRUE} makes the function look +for a \code{"dead"} compartment in the data. If there is no such column, the +function returns only the final number of recovered or removed individuals in +each demographic group.} \item{simplify}{A logical determining whether the epidemic size data should be simplified to a vector with one element for each demographic group. If the length of \code{stage} or \code{time} is $>$ 1, this argument is overridden and -the data are returned as a \verb{}. -group.} +the data are returned as a \verb{}.} } \value{ If \code{simplify == TRUE} and a single timepoint is requested, returns a vector @@ -87,9 +87,12 @@ data <- model_default( population = uk_population ) -# get the final epidemic size +# get the final epidemic size if no other arguments are specified epidemic_size(data) # get the epidemic size at the halfway point epidemic_size(data, stage = 0.5) + +# alternatively, get the epidemic size at `time = 50` +epidemic_size(data, time = 50) } From 2ff2c99a59d206d5119b1a727e7b775cc8541785 Mon Sep 17 00:00:00 2001 From: pratikunterwegs Date: Mon, 22 Apr 2024 13:39:35 +0100 Subject: [PATCH 08/10] Update tests for epidemic_size() --- tests/testthat/test-epidemic_size.R | 44 +++++++++++++++++++++++++++-- 1 file changed, 41 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-epidemic_size.R b/tests/testthat/test-epidemic_size.R index 447f2f87..ebc866b6 100644 --- a/tests/testthat/test-epidemic_size.R +++ b/tests/testthat/test-epidemic_size.R @@ -53,6 +53,10 @@ test_that("Epidemic size functions", { epidemic_final_size, ignore_attr = TRUE ) + expect_equal( + epidemic_size(data, time = time_end), + epidemic_size(data) + ) # expect return types and contents expect_s3_class( @@ -64,7 +68,7 @@ test_that("Epidemic size functions", { "data.table" ) expect_s3_class( - epidemic_size(data, time = c(1, 2), simplify = TRUE), + epidemic_size(data, time = c(1, 2), simplify = FALSE), "data.table" ) @@ -138,8 +142,10 @@ test_that("Epidemic size for ebola model with replicates", { # expect that function returns data.table when replicates > 1 output <- model_ebola(pop, replicates = replicates) - data <- epidemic_size(output, simplify = TRUE) - + # throws a warning as expected + suppressWarnings( + data <- epidemic_size(output, simplify = TRUE) + ) expect_s3_class(data, "data.table") expect_identical( nrow(data), replicates @@ -150,3 +156,35 @@ test_that("Epidemic size for ebola model with replicates", { data <- epidemic_size(output, simplify = TRUE) expect_vector(data, numeric()) }) + +test_that("Epidemic size warnings and messages", { + # expect message when time is specified + expect_message(epidemic_size(data, time = 50)) + + # expect warning when multiple time points are requested and simplify is TRUE + expect_warning(epidemic_size(data, stage = c(0.1, 1.0))) + expect_warning(epidemic_size(data, time = c(10, 50))) + expect_error( + epidemic_size(data, time = NULL, stage = NULL), + regexp = "One of `stage` or `time` must be provided; both are NULL!" + ) + + # expect message when dead are requested but not present + expect_warning(epidemic_size(data, time = 50, include_deaths = TRUE)) + + # expect input checking errors + expect_error(epidemic_size("data")) + expect_error(epidemic_size(data[, c("time")])) + data_test <- data + colnames(data_test) <- letters[1:4] + expect_error( + epidemic_size(data_test), + regexp = "Names must include the elements" + ) + + expect_error(epidemic_size(data, by_group = 1)) + expect_error(epidemic_size(data, include_deaths = 1)) + expect_error(epidemic_size(data, stage = "0.1")) + expect_error(epidemic_size(data, time = "0.1")) + expect_error(epidemic_size(data, time = 0.1)) +}) From 8a5cfdb360ec19fb277c58dbd8e79aaa618083b4 Mon Sep 17 00:00:00 2001 From: pratikunterwegs Date: Mon, 22 Apr 2024 13:39:52 +0100 Subject: [PATCH 09/10] Update news for epidemic_size() --- NEWS.md | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/NEWS.md b/NEWS.md index 4d8ebded..a173c238 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,23 @@ # epidemics (development version) +## Breaking changes + +1. The default behaviour of `epidemic_size()` is to exclude the 'dead' compartment from epidemic size calculations; this has changed from including it by default, as most models don't have a 'dead' compartment (#212); + +## Helper functions + +1. `epidemic_size()` is substantially updated (#212): + + - Added option for `time` which returns epidemic size at a specific time point, overriding the `stage` argument, defaults to `NULL` as the intended use of the function is to return the final size; + + - Added option to return epidemic sizes at multiple stages or time points (`stage` and `time` can be vectors); + + - Added option to simplify the output to a vector, which is `TRUE` by default to keep consistency with previous functionality; + + - Added functionality to handle replicates from the Ebola model; + + - Added tests for new functionality. + # epidemics 0.2.0 This is a second GitHub release of _epidemics_ which makes substantial additions to the functionality in v0.1.0, and introduces significant breaking changes (#176). From dc79d28fb7036a4d8dc36bf4e31851bdf6c78871 Mon Sep 17 00:00:00 2001 From: pratikunterwegs Date: Mon, 22 Apr 2024 14:02:37 +0100 Subject: [PATCH 10/10] Fix formatting --- R/helpers.R | 9 +++++---- man/epidemic_size.Rd | 9 +++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/R/helpers.R b/R/helpers.R index 2d509a47..97f7c300 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -91,10 +91,11 @@ #' @param data A table of model output, typically #' the output of [model_de ault()] or similar functions. #' @param stage A numeric vector for the stage of the epidemic at which to -#' return the epidemic size; here, 0.0 represents the start time of the epidemic, i.e., the initial conditions of the -#' epidemic simulation, while 1.0 represents the end of the epidemic simulation. -#' model (100% of model time). Defaults to 1.0, at which stage returned values -#' represent the _final size_ of the epidemic. +#' return the epidemic size; here 0.0 represents the start time of the epidemic +#' i.e., the initial conditions of the epidemic simulation, while 1.0 represents +#' the end of the epidemic simulation model (100% of model time). +#' Defaults to 1.0, at which stage returned values represent the _final size_ of +#' the epidemic. #' This value is overridden by any values passed to the `time` argument. #' @param time Alternative to `stage`, an integer-like vector for the timepoint #' of the epidemic at which to return the epidemic size. diff --git a/man/epidemic_size.Rd b/man/epidemic_size.Rd index 6ecb3b1f..650c0e60 100644 --- a/man/epidemic_size.Rd +++ b/man/epidemic_size.Rd @@ -18,10 +18,11 @@ epidemic_size( the output of \code{\link[=model_de ault]{model_de ault()}} or similar functions.} \item{stage}{A numeric vector for the stage of the epidemic at which to -return the epidemic size; here, 0.0 represents the initial conditions of the -epidemic (0\% of model time), while 1.0 represents the end of the epidemic -model (100\% of model time). Defaults to 1.0, at which stage returned values -represent the \emph{final size} of the epidemic. +return the epidemic size; here 0.0 represents the start time of the epidemic +i.e., the initial conditions of the epidemic simulation, while 1.0 represents +the end of the epidemic simulation model (100\% of model time). +Defaults to 1.0, at which stage returned values represent the \emph{final size} of +the epidemic. This value is overridden by any values passed to the \code{time} argument.} \item{time}{Alternative to \code{stage}, an integer-like vector for the timepoint