mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 06:46:11 +01:00
get episode unit tests
This commit is contained in:
parent
2c5a9bb622
commit
1d3d7d40bc
@ -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)
|
||||
|
||||
2
NEWS.md
2
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!)*
|
||||
|
||||
|
||||
@ -29,10 +29,10 @@
|
||||
|
||||
#' 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.
|
||||
#'
|
||||
@ -44,7 +44,7 @@
|
||||
#'
|
||||
#' 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**.
|
||||
#'
|
||||
@ -55,15 +55,17 @@
|
||||
#' | 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()`
|
||||
#'
|
||||
@ -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
|
||||
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
|
||||
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
|
||||
}
|
||||
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
|
||||
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
|
||||
}
|
||||
|
||||
@ -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")),
|
||||
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user