From 1d3d7d40bc7a1a57bc7ff098d5680f01774da6ff Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Fri, 24 Feb 2023 19:54:56 +0100 Subject: [PATCH] get episode unit tests --- DESCRIPTION | 2 +- NEWS.md | 2 +- R/get_episode.R | 133 +++++++++--------- .../{test-episode.R => test-get_episode.R} | 8 ++ man/get_episode.Rd | 18 +-- 5 files changed, 89 insertions(+), 74 deletions(-) rename inst/tinytest/{test-episode.R => test-get_episode.R} (85%) diff --git a/DESCRIPTION b/DESCRIPTION index 64d368ce..33b1148d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 1.8.2.9145 +Version: 1.8.2.9146 Date: 2023-02-24 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) diff --git a/NEWS.md b/NEWS.md index 246082ba..96b0ab77 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 1.8.2.9145 +# AMR 1.8.2.9146 *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)* diff --git a/R/get_episode.R b/R/get_episode.R index 269b3bc2..d4676849 100755 --- a/R/get_episode.R +++ b/R/get_episode.R @@ -29,50 +29,52 @@ #' Determine (Clinical or Epidemic) Episodes #' -#' These functions determine which items in a vector can be considered (the start of) a new episode, based on the argument `episode_days`. This can be used to determine clinical episodes for any epidemiological analysis. The [get_episode()] function returns the index number of the episode per group, while the [is_new_episode()] function returns `TRUE` for every new [get_episode()] index. Both absolute and relative episode determination are supported. +#' These functions determine which items in a vector can be considered (the start of) a new episode. This can be used to determine clinical episodes for any epidemiological analysis. The [get_episode()] function returns the index number of the episode per group, while the [is_new_episode()] function returns `TRUE` for every new [get_episode()] index. Both absolute and relative episode determination are supported. #' @param x vector of dates (class `Date` or `POSIXt`), will be sorted internally to determine episodes -#' @param episode_days episode length in days, can also be less than a day or `Inf`, see *Details* -#' @param case_free_days length in days after which new episode will start, can also be less than a day or `Inf`, see *Details* +#' @param episode_days episode length in days to specify the time period after which a new episode begins, can also be less than a day or `Inf`, see *Details* +#' @param case_free_days (inter-epidemic) interval length in days after which a new episode will start, can also be less than a day or `Inf`, see *Details* #' @param ... ignored, only in place to allow future extensions #' @details Episodes can be determined in two ways: absolute and relative. -#' +#' #' 1. Absolute -#' +#' #' This method uses `episode_days` to define an episode length in days, after which a new episode will start. A common use case in AMR data analysis is microbial epidemiology: episodes of *S. aureus* bacteraemia in ICU patients for example. The episode length could then be 30 days, so that new *S. aureus* isolates after an ICU episode of 30 days will be considered a different (or new) episode. -#' +#' #' Thus, this method counts **since the start of the previous episode**. -#' +#' #' 2. Relative -#' -#' This method uses `case_free_days` to quantify the duration of (inter-epidemic) intervals, after which a new episode will start. A common use case is infectious disease epidemiology: episodes of norovirus outbreaks in a hospital for example. The case-free period could then be 14 days, so that new norovirus cases after that time will be considered a different (or new) episode. -#' +#' +#' This method uses `case_free_days` to quantify the duration of case-free days (the inter-epidemic interval), after which a new episode will start. A common use case is infectious disease epidemiology: episodes of norovirus outbreaks in a hospital for example. The case-free period could then be 14 days, so that new norovirus cases after that time will be considered a different (or new) episode. +#' #' Thus, this methods counts **since the last case in the previous episode**. -#' +#' #' In a table: -#' +#' #' | Date | Using `episode_days = 7` | Using `case_free_days = 7` | #' |:----------:|:------------------------:|:--------------------------:| #' | 2023-01-01 | 1 | 1 | #' | 2023-01-02 | 1 | 1 | #' | 2023-01-05 | 1 | 1 | -#' | 2023-01-08 | 2\code{*} | 1 | -#' | 2023-02-21 | 3 | 2\code{**} | +#' | 2023-01-08 | 2** | 1 | +#' | 2023-02-21 | 3 | 2*** | #' | 2023-02-22 | 3 | 2 | #' | 2023-02-23 | 3 | 2 | #' | 2023-02-24 | 3 | 2 | #' | 2023-03-01 | 4 | 2 | -#' -#' \code{*} This marks the start of a new episode, because 8 January 2023 is more than 7 days since the start of the previous episode (1 January 2023). \cr -#' \code{**} This marks the start of a new episode, because 21 January 2023 is more than 7 days since the last case in the previous episode (8 January 2023). -#' +#' +#' ** This marks the start of a new episode, because 8 January 2023 is more than 7 days since the start of the previous episode (1 January 2023). \cr +#' *** This marks the start of a new episode, because 21 January 2023 is more than 7 days since the last case in the previous episode (8 January 2023). +#' +#' Either `episode_days` or `case_free_days` must be provided in the function. +#' #' ### Difference between `get_episode()` and `is_new_episode()` -#' -#' The [get_episode()] function returns the index number of the episode, so all cases/patients/isolates in the first episode will have the number 1, all cases/patients/isolates in the second episode will have the number 2, etc. -#' +#' +#' The [get_episode()] function returns the index number of the episode, so all cases/patients/isolates in the first episode will have the number 1, all cases/patients/isolates in the second episode will have the number 2, etc. +#' #' The [is_new_episode()] function returns `TRUE` for every new [get_episode()] index, and is thus equal to `!duplicated(get_episode(...))`. -#' +#' #' To specify, when setting `episode_days = 365` (using method 1 as explained above), this is how the two functions differ: -#' +#' #' | patient | date | `get_episode()` | `is_new_episode()` | #' |:---------:|:----------:|:---------------:|:------------------:| #' | A | 2019-01-01 | 1 | TRUE | @@ -83,7 +85,7 @@ #' | C | 2020-01-01 | 1 | TRUE | #' #' ### Other -#' +#' #' The [first_isolate()] function is a wrapper around the [is_new_episode()] function, but is more efficient for data sets containing microorganism codes or names and allows for different isolate selection methods. #' #' The `dplyr` package is not required for these functions to work, but these episode functions do support [variable grouping][dplyr::group_by()] and work conveniently inside `dplyr` verbs such as [`filter()`][dplyr::filter()], [`mutate()`][dplyr::mutate()] and [`summarise()`][dplyr::summarise()]. @@ -110,8 +112,8 @@ #' x$absolute <- get_episode(x$dates, episode_days = 7) #' x$relative <- get_episode(x$dates, case_free_days = 7) #' x -#' -#' +#' +#' #' # `example_isolates` is a data set available in the AMR package. #' # See ?example_isolates #' df <- example_isolates[sample(seq_len(2000), size = 100), ] @@ -213,51 +215,54 @@ is_new_episode <- function(x, episode_days = NULL, case_free_days = NULL, ...) { exec_episode <- function(x, episode_days, case_free_days, ...) { stop_if((is.null(episode_days) && is.null(case_free_days)) || (!is.null(episode_days) && !is.null(case_free_days)), - "either `episode_days` or `case_free_days` must be set.", call = -2) + "either `episode_days` or `case_free_days` must be set.", + call = -2 + ) - x <- as.double(as.POSIXct(x)) # as.POSIXct() required for Date classes + # running as.double() on a POSIXct object will return its number of seconds since 1970-01-01 + x <- as.double(as.POSIXct(x)) # as.POSIXct() required for Date classes - # since x is now in seconds, get seconds from episode_days as well - episode_seconds <- episode_days * 60 * 60 * 24 - case_free_seconds <- case_free_days * 60 * 60 * 24 + # since x is now in seconds, get seconds from episode_days as well + episode_seconds <- episode_days * 60 * 60 * 24 + case_free_seconds <- case_free_days * 60 * 60 * 24 - if (length(x) == 1) { # this will also match 1 NA, which is fine - return(1) - } else if (length(x) == 2 && all(!is.na(x))) { - if ((length(episode_seconds) > 0 && (max(x) - min(x)) >= episode_seconds) || - (length(case_free_seconds) > 0 && (max(x) - min(x)) >= case_free_seconds)) { - if (x[1] <= x[2]) { - return(c(1, 2)) - } else { - return(c(2, 1)) - } + if (length(x) == 1) { # this will also match 1 NA, which is fine + return(1) + } else if (length(x) == 2 && all(!is.na(x))) { + if ((length(episode_seconds) > 0 && (max(x) - min(x)) >= episode_seconds) || + (length(case_free_seconds) > 0 && (max(x) - min(x)) >= case_free_seconds)) { + if (x[1] <= x[2]) { + return(c(1, 2)) } else { - return(c(1, 1)) + return(c(2, 1)) } + } else { + return(c(1, 1)) } + } - run_episodes <- function(x, episode_seconds, case_free) { - NAs <- which(is.na(x)) - x[NAs] <- 0 - - indices <- integer(length = length(x)) - start <- x[1] - ind <- 1 - indices[ind] <- 1 - for (i in 2:length(x)) { - if ((length(episode_seconds) > 0 && (x[i] - start) >= episode_seconds) || - (length(case_free_seconds) > 0 && (x[i] - x[i - 1]) >= case_free_seconds)) { - ind <- ind + 1 - start <- x[i] - } - indices[i] <- ind + run_episodes <- function(x, episode_seconds, case_free) { + NAs <- which(is.na(x)) + x[NAs] <- 0 + + indices <- integer(length = length(x)) + start <- x[1] + ind <- 1 + indices[ind] <- 1 + for (i in 2:length(x)) { + if ((length(episode_seconds) > 0 && (x[i] - start) >= episode_seconds) || + (length(case_free_seconds) > 0 && (x[i] - x[i - 1]) >= case_free_seconds)) { + ind <- ind + 1 + start <- x[i] } - indices[NAs] <- NA - indices + indices[i] <- ind } - - ord <- order(x) - out <- run_episodes(x[ord], episode_seconds, case_free_seconds)[order(ord)] - out[is.na(x) & ord != 1] <- NA # every NA expect for the first must remain NA - out + indices[NAs] <- NA + indices + } + + ord <- order(x) + out <- run_episodes(x[ord], episode_seconds, case_free_seconds)[order(ord)] + out[is.na(x) & ord != 1] <- NA # every NA expect for the first must remain NA + out } diff --git a/inst/tinytest/test-episode.R b/inst/tinytest/test-get_episode.R similarity index 85% rename from inst/tinytest/test-episode.R rename to inst/tinytest/test-get_episode.R index c3fa1ccb..d1516122 100644 --- a/inst/tinytest/test-episode.R +++ b/inst/tinytest/test-get_episode.R @@ -27,6 +27,14 @@ # how to conduct AMR data analysis: https://msberends.github.io/AMR/ # # ==================================================================== # +x <- data.frame(dates = as.Date(c("2021-01-01", "2021-01-02", "2021-01-05", "2021-01-08", "2021-02-21", "2021-02-22", "2021-02-23", "2021-02-24", "2021-03-01", "2021-03-01"))) +x$absolute <- get_episode(x$dates, episode_days = 7) +x$relative <- get_episode(x$dates, case_free_days = 7) +expect_equal(x$absolute, c(1, 1, 1, 2, 3, 3, 3, 3, 4, 4)) +expect_equal(x$relative, c(1, 1, 1, 1, 2, 2, 2, 2, 2, 2)) +expect_equal(get_episode(as.Date(c("2022-01-01", "2020-01-01")), 365), c(2, 1)) +expect_equal(get_episode(as.Date(c("2020-01-01", "2022-01-01")), 365), c(1, 2)) + test_df <- rbind( data.frame( date = as.Date(c("2015-01-01", "2015-10-01", "2016-02-04", "2016-12-31", "2017-01-01", "2017-02-01", "2017-02-05", "2020-01-01")), diff --git a/man/get_episode.Rd b/man/get_episode.Rd index a70c17e4..b44b60f8 100644 --- a/man/get_episode.Rd +++ b/man/get_episode.Rd @@ -12,9 +12,9 @@ is_new_episode(x, episode_days = NULL, case_free_days = NULL, ...) \arguments{ \item{x}{vector of dates (class \code{Date} or \code{POSIXt}), will be sorted internally to determine episodes} -\item{episode_days}{episode length in days, can also be less than a day or \code{Inf}, see \emph{Details}} +\item{episode_days}{episode length in days to specify the time period after which a new episode begins, can also be less than a day or \code{Inf}, see \emph{Details}} -\item{case_free_days}{length in days after which new episode will start, can also be less than a day or \code{Inf}, see \emph{Details}} +\item{case_free_days}{(inter-epidemic) interval length in days after which a new episode will start, can also be less than a day or \code{Inf}, see \emph{Details}} \item{...}{ignored, only in place to allow future extensions} } @@ -25,7 +25,7 @@ is_new_episode(x, episode_days = NULL, case_free_days = NULL, ...) } } \description{ -These functions determine which items in a vector can be considered (the start of) a new episode, based on the argument \code{episode_days}. This can be used to determine clinical episodes for any epidemiological analysis. The \code{\link[=get_episode]{get_episode()}} function returns the index number of the episode per group, while the \code{\link[=is_new_episode]{is_new_episode()}} function returns \code{TRUE} for every new \code{\link[=get_episode]{get_episode()}} index. Both absolute and relative episode determination are supported. +These functions determine which items in a vector can be considered (the start of) a new episode. This can be used to determine clinical episodes for any epidemiological analysis. The \code{\link[=get_episode]{get_episode()}} function returns the index number of the episode per group, while the \code{\link[=is_new_episode]{is_new_episode()}} function returns \code{TRUE} for every new \code{\link[=get_episode]{get_episode()}} index. Both absolute and relative episode determination are supported. } \details{ Episodes can be determined in two ways: absolute and relative. @@ -37,7 +37,7 @@ This method uses \code{episode_days} to define an episode length in days, after Thus, this method counts \strong{since the start of the previous episode}. \item Relative -This method uses \code{case_free_days} to quantify the duration of (inter-epidemic) intervals, after which a new episode will start. A common use case is infectious disease epidemiology: episodes of norovirus outbreaks in a hospital for example. The case-free period could then be 14 days, so that new norovirus cases after that time will be considered a different (or new) episode. +This method uses \code{case_free_days} to quantify the duration of case-free days (the inter-epidemic interval), after which a new episode will start. A common use case is infectious disease epidemiology: episodes of norovirus outbreaks in a hospital for example. The case-free period could then be 14 days, so that new norovirus cases after that time will be considered a different (or new) episode. Thus, this methods counts \strong{since the last case in the previous episode}. } @@ -47,8 +47,8 @@ In a table:\tabular{ccc}{ 2023-01-01 \tab 1 \tab 1 \cr 2023-01-02 \tab 1 \tab 1 \cr 2023-01-05 \tab 1 \tab 1 \cr - 2023-01-08 \tab 2\code{*} \tab 1 \cr - 2023-02-21 \tab 3 \tab 2\code{**} \cr + 2023-01-08 \tab 2** \tab 1 \cr + 2023-02-21 \tab 3 \tab 2*** \cr 2023-02-22 \tab 3 \tab 2 \cr 2023-02-23 \tab 3 \tab 2 \cr 2023-02-24 \tab 3 \tab 2 \cr @@ -56,8 +56,10 @@ In a table:\tabular{ccc}{ } -\code{*} This marks the start of a new episode, because 8 January 2023 is more than 7 days since the start of the previous episode (1 January 2023). \cr -\code{**} This marks the start of a new episode, because 21 January 2023 is more than 7 days since the last case in the previous episode (8 January 2023). +** This marks the start of a new episode, because 8 January 2023 is more than 7 days since the start of the previous episode (1 January 2023). \cr +*** This marks the start of a new episode, because 21 January 2023 is more than 7 days since the last case in the previous episode (8 January 2023). + +Either \code{episode_days} or \code{case_free_days} must be provided in the function. \subsection{Difference between \code{get_episode()} and \code{is_new_episode()}}{ The \code{\link[=get_episode]{get_episode()}} function returns the index number of the episode, so all cases/patients/isolates in the first episode will have the number 1, all cases/patients/isolates in the second episode will have the number 2, etc.