get episode unit tests

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)

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!)*
 

R/get_episode.R

@@ -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 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 length in days after which new episode will start, 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-01-08 |             2**          |              1             |
-#' | 2023-02-21 |             3            |              2\code{**}    |
+#' | 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
+#' ** 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 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
+  # since x is now in seconds, get seconds from episode_days as well
-    episode_seconds <- episode_days * 60 * 60 * 24
+  episode_seconds <- episode_days * 60 * 60 * 24
-    case_free_seconds <- case_free_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
+  if (length(x) == 1) { # this will also match 1 NA, which is fine
-      return(1)
+    return(1)
-    } else if (length(x) == 2 && all(!is.na(x))) {
+  } else if (length(x) == 2 && all(!is.na(x))) {
-      if ((length(episode_seconds) > 0 && (max(x) - min(x)) >= episode_seconds) ||
+    if ((length(episode_seconds) > 0 && (max(x) - min(x)) >= episode_seconds) ||
-          (length(case_free_seconds) > 0 && (max(x) - min(x)) >= case_free_seconds)) {
+      (length(case_free_seconds) > 0 && (max(x) - min(x)) >= case_free_seconds)) {
-        if (x[1] <= x[2]) {
+      if (x[1] <= x[2]) {
-          return(c(1, 2))
+        return(c(1, 2))
-        } else {
-          return(c(2, 1))
-        }
       } else {
-        return(c(1, 1))
+        return(c(2, 1))
       }
+    } else {
+      return(c(1, 1))
     }
+  }
 
-    run_episodes <- function(x, episode_seconds, case_free) {
+  run_episodes <- function(x, episode_seconds, case_free) {
-      NAs <- which(is.na(x))
+    NAs <- which(is.na(x))
-      x[NAs] <- 0
+    x[NAs] <- 0
 
-      indices <- integer(length = length(x))
+    indices <- integer(length = length(x))
-      start <- x[1]
+    start <- x[1]
-      ind <- 1
+    ind <- 1
-      indices[ind] <- 1
+    indices[ind] <- 1
-      for (i in 2:length(x)) {
+    for (i in 2:length(x)) {
-        if ((length(episode_seconds) > 0 && (x[i] - start) >= episode_seconds) ||
+      if ((length(episode_seconds) > 0 && (x[i] - start) >= episode_seconds) ||
-            (length(case_free_seconds) > 0 && (x[i] - x[i - 1]) >= case_free_seconds)) {
+        (length(case_free_seconds) > 0 && (x[i] - x[i - 1]) >= case_free_seconds)) {
-          ind <- ind + 1
+        ind <- ind + 1
-          start <- x[i]
+        start <- x[i]
-        }
-        indices[i] <- ind
       }
-      indices[NAs] <- NA
+      indices[i] <- ind
-      indices
     }
+    indices[NAs] <- NA
+    indices
+  }
 
-    ord <- order(x)
+  ord <- order(x)
-    out <- run_episodes(x[ord], episode_seconds, case_free_seconds)[order(ord)]
+  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[is.na(x) & ord != 1] <- NA # every NA expect for the first must remain NA
-    out
+  out
 }

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")),

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-01-08 \tab 2** \tab 1 \cr
-   2023-02-21 \tab 3 \tab 2\code{**} \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
+** 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 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.