Version 2.0 on CRAN

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 1.8.2
-Date: 2022-09-27 12:18:42 UTC
-SHA: ccb09706e4f168ab6133de3d2294bcaeed0d3fc8
+Version: 2.0.0
+Date: 2023-03-12 12:42:08 UTC
+SHA: 80cfc503c29ad48806e526b97d4570600bbd5420

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 1.8.2.9138
-Date: 2023-02-22
+Version: 2.0.0
+Date: 2023-03-12
 Title: Antimicrobial Resistance Data Analysis
 Description: Functions to simplify and standardise antimicrobial resistance (AMR)
   data analysis and to work with microbial and antimicrobial properties by

NAMESPACE

@@ -131,7 +131,6 @@ S3method(plot,resistance_predict)
 S3method(plot,rsi)
 S3method(plot,sir)
 S3method(print,ab)
-S3method(print,antibiogram)
 S3method(print,av)
 S3method(print,bug_drug_combinations)
 S3method(print,custom_eucast_rules)

NEWS.md

@@ -1,6 +1,4 @@
-# AMR 1.8.2.9138
-
-*(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*
+# AMR 2.0.0
 
 This is a new major release of the AMR package, with great new additions but also some breaking changes for current users. These are all listed below.
 
@@ -48,6 +46,12 @@ We added support for the following ten languages: Chinese (simplified), Czech, F
 
 We are very grateful for the valuable input by our colleagues from other countries. The `AMR` package is now available in 20 languages in total, and according to download stats used in almost all countries in the world!
 
+### Outbreak management
+
+For analysis in outbreak management, we updated the `get_episode()` and `is_new_episode()` functions: they now contain an argument `case_free_days`. This argument can be used to quantify the duration of case-free days (the inter-epidemic interval), after which a new episode will start. 
+
+This is common requirement in outbreak management, e.g. when determining the number of norovirus outbreaks in a hospital. The case-free period could then be 14 or 28 days, so that new norovirus cases after that time will be considered a different (or new) episode.
+
 ### Microbiological taxonomy
 
 The `microorganisms` data set no longer relies on the Catalogue of Life, but on the List of Prokaryotic names with Standing in Nomenclature (LPSN) and is supplemented with the 'backbone taxonomy' from the Global Biodiversity Information Facility (GBIF). The structure of this data set has changed to include separate LPSN and GBIF identifiers. Almost all previous MO codes were retained. It contains over 1,400 taxonomic names from 2022.
@@ -59,6 +63,7 @@ The new function `add_custom_microorganisms()` allows users to add custom microo
 We also made the following changes regarding the included taxonomy or microorganisms functions:
 
 * Updated full microbiological taxonomy according to the latest daily LPSN data set (December 2022) and latest yearly GBIF taxonomy backbone (November 2022)
+* Added function `mo_current()` to get the currently valid taxonomic name of a microorganism
 * Support for all 1,516 city-like serovars of *Salmonella*, such as *Salmonella* Goldcoast. Formally, these are serovars belonging to the *S. enterica* species, but they are reported with only the name of the genus and the city. For this reason, the serovars are in the `subspecies` column of the `microorganisms` data set and "enterica" is in the `species` column, but the full name does not contain the species name (*enterica*).
 * All new algorithm for `as.mo()` (and thus all `mo_*()` functions) while still following our original set-up as described in our recently published JSS paper (DOI [10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)).
   * A new argument `keep_synonyms` allows to *not* correct for updated taxonomy, in favour of the now deleted argument `allow_uncertain`
@@ -100,11 +105,14 @@ We now added extensive support for antiviral agents! For the first time, the `AM
 * Function `sir_confidence_interval()` to add confidence intervals in AMR calculation. This is now also included in `sir_df()` and `proportion_df()`.
 * Function `mean_amr_distance()` to calculate the mean AMR distance. The mean AMR distance is a normalised numeric value to compare AMR test results and can help to identify similar isolates, without comparing antibiograms by hand.
 * Function `sir_interpretation_history()` to view the history of previous runs of `as.sir()` (previously `as.rsi()`). This returns a 'logbook' with the selected guideline, reference table and specific interpretation of each row in a data set on which `as.sir()` was run.
-* Function `mo_current()` to get the currently valid taxonomic name of a microorganism
-* Function `add_custom_antimicrobials()` to add custom antimicrobial codes and names to the `AMR` package
+
 
 ## Changes
 
+* `get_episode()` (and its wrapper `is_new_episode()`):
+  * Fix for working with `NA` values
+  * Fix for unsorted dates of length 2
+  * Now returns class `integer` instead of `numeric` since they are always whole numbers
 * Argument `combine_IR` has been removed from this package (affecting functions `count_df()`, `proportion_df()`, and `sir_df()` and some plotting functions), since it was replaced with `combine_SI` three years ago
 * Using `units` in `ab_ddd(..., units = "...")` had been deprecated for some time and is now not supported anymore. Use `ab_ddd_units()` instead.
 * Support for `data.frame`-enhancing R packages, more specifically: `data.table::data.table`, `janitor::tabyl`, `tibble::tibble`, and `tsibble::tsibble`. AMR package functions that have a data set as output (such as `sir_df()` and `bug_drug_combinations()`), will now return the same data type as the input.
@@ -134,7 +142,6 @@ We now added extensive support for antiviral agents! For the first time, the `AM
 * Fix for `mo_shortname()` in case of higher taxonomic ranks (order, class, phylum)
 * Cleaning columns with `as.sir()`, `as.mic()`, or `as.disk()` will now show the column name in the warning for invalid results
 * Fix for using `g.test()` with zeroes in a 2x2 table
-* `get_episode()` now returns class `integer` instead of `numeric` since they are always whole numbers
 * `mo_synonyns()` now contains the scientific reference as names
 
 ## Other

R/aa_amr-package.R

@@ -34,11 +34,11 @@
 #'
 #' The `AMR` package is a [free and open-source](https://msberends.github.io/AMR/#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. [Many different researchers](https://msberends.github.io/AMR/authors.html) from around the globe are continually helping us to make this a successful and durable project!
 #'
-#' This work was published in the Journal of Statistical Software (Volume 104(3); [DOI 10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)) and formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.192486375](https://doi.org/10.33612/diss.192486375)).
+#' This work was published in the Journal of Statistical Software (Volume 104(3); \doi{jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
 #'
-#' After installing this package, R knows [**`r format_included_data_number(AMR::microorganisms)`**](https://msberends.github.io/AMR/reference/microorganisms.html) (updated December 2022) and all [**~600 antibiotic, antimycotic and antiviral drugs**](https://msberends.github.io/AMR/reference/antibiotics.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral breakpoint guidelines from CLSI and EUCAST are included from the last 10 years. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl).
+#' After installing this package, R knows [**`r format_included_data_number(AMR::microorganisms)` microorganisms**](https://msberends.github.io/AMR/reference/microorganisms.html) (updated `r format(TAXONOMY_VERSION$GBIF$accessed_date, "%B %Y")`) and all [**`r format_included_data_number(nrow(AMR::antibiotics) + nrow(AMR::antivirals))` antibiotic, antimycotic and antiviral drugs**](https://msberends.github.io/AMR/reference/antibiotics.html) by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral breakpoint guidelines from CLSI and EUCAST are included from the last 10 years. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl).
 #'
-#' The `AMR` package is available in English, Chinese, Danish, Dutch, French, German, Greek, Italian, Japanese, Polish, Portuguese, Russian, Spanish, Swedish, Turkish and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
+#' The `AMR` package is available in `r vector_and(vapply(FUN.VALUE = character(1), LANGUAGES_SUPPORTED_NAMES, function(x) x$exonym), quotes = FALSE, sort = FALSE)`. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
 #' @section Reference Data Publicly Available:
 #' All data sets in this `AMR` package (about microorganisms, antibiotics, SIR interpretation, EUCAST rules, etc.) are publicly and freely available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. We also provide tab-separated plain text files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please visit [our website for the download links](https://msberends.github.io/AMR/articles/datasets.html). The actual files are of course available on [our GitHub repository](https://github.com/msberends/AMR/tree/main/data-raw).
 #' @source

R/aa_helper_functions.R

@@ -63,9 +63,9 @@ pm_left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) {
   merged
 }
 
-# support where() like tidyverse:
+# support where() like tidyverse (this function will also be used when running `antibiogram()`):
 where <- function(fn) {
-  # adapted from https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
+  # based on https://github.com/nathaneastwood/poorman/blob/52eb6947e0b4430cd588976ed8820013eddf955f/R/where.R#L17-L32
   if (!is.function(fn)) {
     stop_("`", deparse(substitute(fn)), "()` is not a valid predicate function.")
   }
@@ -90,7 +90,7 @@ where <- function(fn) {
 
 # copied and slightly rewritten from {poorman} under permissive license (2021-10-15)
 # https://github.com/nathaneastwood/poorman, MIT licensed, Nathan Eastwood, 2020
-quick_case_when <- function(...) {
+case_when_AMR <- function(...) {
   fs <- list(...)
   lapply(fs, function(x) {
     if (!inherits(x, "formula")) {
@@ -163,8 +163,8 @@ quick_case_when <- function(...) {
   out
 }
 
-rbind2 <- function(...) {
-  # this is just rbind(), but then with the functionality of dplyr::bind_rows(),
+rbind_AMR <- function(...) {
+  # this is just rbind(), but with the functionality of dplyr::bind_rows(),
   # to allow differences in available columns
   l <- list(...)
   l_names <- unique(unlist(lapply(l, names)))
@@ -633,7 +633,9 @@ documentation_date <- function(d) {
 }
 
 format_included_data_number <- function(data) {
-  if (is.data.frame(data)) {
+  if (is.numeric(data) && length(data) == 1) {
+    n <- data
+  } else if (is.data.frame(data)) {
     n <- nrow(data)
   } else {
     n <- length(unique(data))
@@ -757,7 +759,7 @@ format_class <- function(class, plural = FALSE) {
 }
 
 # a check for every single argument in all functions
-meet_criteria <- function(object,
+meet_criteria <- function(object, # can be literally `list(...)` for `allow_arguments_from`
                           allow_class = NULL,
                           has_length = NULL,
                           looks_like = NULL,
@@ -769,6 +771,7 @@ meet_criteria <- function(object,
                           allow_NULL = FALSE,
                           allow_NA = FALSE,
                           ignore.case = FALSE,
+                          allow_arguments_from = NULL, # 1 function, or a list of functions
                           .call_depth = 0) { # depth in calling
 
   obj_name <- deparse(substitute(object))
@@ -886,6 +889,24 @@ meet_criteria <- function(object,
       call = call_depth
     )
   }
+  if (!is.null(allow_arguments_from) && !is.null(names(object))) {
+    args_given <- names(object)
+    if (is.function(allow_arguments_from)) {
+      allow_arguments_from <- list(allow_arguments_from)
+    }
+    args_allowed <- sort(unique(unlist(lapply(allow_arguments_from, function(x) names(formals(x))))))
+    args_allowed <- args_allowed[args_allowed != "..."]
+    disallowed <- args_given[!args_given %in% args_allowed]
+    stop_if(length(disallowed) > 0,
+      ifelse(length(disallowed) == 1,
+        paste("the argument", vector_and(disallowed), "is"),
+        paste("the arguments", vector_and(disallowed), "are")
+      ),
+      " not valid. Valid arguments are: ",
+      vector_and(args_allowed), ".",
+      call = call_depth
+    )
+  }
   return(invisible())
 }
 
@@ -915,7 +936,7 @@ get_current_data <- function(arg_name, call) {
     }
   }
 
-  # now go over all underlying environments looking for other dplyr and base R selection environments
+  # now go over all underlying environments looking for other dplyr, data.table and base R selection environments
   with_generic <- vapply(FUN.VALUE = logical(1), frms, function(e) !is.null(e$`.Generic`))
   for (env in frms[which(with_generic)]) {
     if (valid_df(env$`.data`)) {
@@ -926,6 +947,7 @@ get_current_data <- function(arg_name, call) {
       return(env$xx)
     } else if (valid_df(env$x)) {
       # an element `x` will be in the environment for only cols in base R, e.g. `example_isolates[, carbapenems()]`
+      # this element will also be present in data.table environments where there's a .Generic available
       return(env$x)
     }
   }
@@ -1482,7 +1504,7 @@ trimws2 <- function(..., whitespace = "[\u0009\u000A\u000B\u000C\u000D\u0020\u00
   trimws(..., whitespace = whitespace)
 }
 
-readRDS2 <- function(file, refhook = NULL) {
+readRDS_AMR <- function(file, refhook = NULL) {
   # this is readRDS with remote file support
   con <- file(file)
   on.exit(close(con))

R/aa_helper_pm_functions.R

@@ -988,7 +988,7 @@ pm_summarise.default <- function(.data, ...) {
       if (is.list(x_res)) I(x_res) else x_res
     }
   )
-  res <- as.data.frame(res)
+  res <- as.data.frame(res, stringsAsFactors = FALSE)
   fn_names <- names(fns)
   colnames(res) <- if (is.null(fn_names)) fns else fn_names
   if (pm_groups_exist) res <- cbind(group, res, row.names = NULL)

R/ab.R

@@ -249,8 +249,6 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
       next
     }
 
-    print("here")
-
     # length of input is quite long, and Levenshtein distance is only max 2
     if (nchar(x[i]) >= 10) {
       levenshtein <- as.double(utils::adist(x[i], AMR_env$AB_lookup$generalised_name))
@@ -497,7 +495,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
   # save to package env to save time for next time
   if (isTRUE(initial_search)) {
     AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$x %in% x), , drop = FALSE]
-    AMR_env$ab_previously_coerced <- unique(rbind2(
+    AMR_env$ab_previously_coerced <- unique(rbind_AMR(
       AMR_env$ab_previously_coerced,
       data.frame(
         x = x,

R/ab_selectors.R

@@ -29,14 +29,16 @@
 
 #' Antibiotic Selectors
 #'
-#' These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group, without the need to define the columns or antibiotic abbreviations. In short, if you have a column name that resembles an antimicrobial drug, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "CZO" and "J01DB04" will all be picked up by [cephalosporins()].
+#' @description These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group (according to the [antibiotics] data set), without the need to define the columns or antibiotic abbreviations.
+#'
+#' In short, if you have a column name that resembles an antimicrobial drug, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "kefzol", "CZO" and "J01DB04" will all be picked up by [cephalosporins()].
 #' @param ab_class an antimicrobial class or a part of it, such as `"carba"` and `"carbapenems"`. The columns `group`, `atc_group1` and `atc_group2` of the [antibiotics] data set will be searched (case-insensitive) for this value.
 #' @param filter an [expression] to be evaluated in the [antibiotics] data set, such as `name %like% "trim"`
 #' @param only_sir_columns a [logical] to indicate whether only columns of class `sir` must be selected (default is `FALSE`), see [as.sir()]
 #' @param only_treatable a [logical] to indicate whether antimicrobial drugs should be excluded that are only for laboratory tests (default is `TRUE`), such as gentamicin-high (`GEH`) and imipenem/EDTA (`IPE`)
 #' @param ... ignored, only in place to allow future extensions
 #' @details
-#' These functions can be used in data set calls for selecting columns and filtering rows. They are heavily inspired by the [Tidyverse selection helpers][tidyselect::language] such as [`everything()`][tidyselect::everything()], but also work in base \R and not only in `dplyr` verbs. Nonetheless, they are very convenient to use with `dplyr` functions such as [`select()`][dplyr::select()], [`filter()`][dplyr::filter()] and [`summarise()`][dplyr::summarise()], see *Examples*.
+#' These functions can be used in data set calls for selecting columns and filtering rows. They work with base \R, the Tidyverse, and `data.table`. They are heavily inspired by the [Tidyverse selection helpers][tidyselect::language] such as [`everything()`][tidyselect::everything()], but are not limited to `dplyr` verbs. Nonetheless, they are very convenient to use with `dplyr` functions such as [`select()`][dplyr::select()], [`filter()`][dplyr::filter()] and [`summarise()`][dplyr::summarise()], see *Examples*.
 #'
 #' All columns in the data in which these functions are called will be searched for known antibiotic names, abbreviations, brand names, and codes (ATC, EARS-Net, WHO, etc.) according to the [antibiotics] data set. This means that a selector such as [aminoglycosides()] will pick up column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
 #'
@@ -54,6 +56,10 @@
 #' # See ?example_isolates.
 #' example_isolates
 #'
+#'
+#' # Examples sections below are split into 'base R', 'dplyr', and 'data.table':
+#'
+#'
 #' # base R ------------------------------------------------------------------
 #'
 #' # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
@@ -76,7 +82,7 @@
 #' # filter with multiple antibiotic selectors using c()
 #' example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
 #'
-#' # filter + select in one go: get penicillins in carbapenems-resistant strains
+#' # filter + select in one go: get penicillins in carbapenem-resistant strains
 #' example_isolates[any(carbapenems() == "R"), penicillins()]
 #'
 #' # You can combine selectors with '&' to be more specific. For example,
@@ -86,13 +92,19 @@
 #' # and erythromycin is not a penicillin:
 #' example_isolates[, penicillins() & administrable_per_os()]
 #'
-#' # ab_selector() applies a filter in the `antibiotics` data set and is thus very
-#' # flexible. For instance, to select antibiotic columns with an oral DDD of at
-#' # least 1 gram:
+#' # ab_selector() applies a filter in the `antibiotics` data set and is thus
+#' # very flexible. For instance, to select antibiotic columns with an oral DDD
+#' # of at least 1 gram:
 #' example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
 #'
-#' # dplyr -------------------------------------------------------------------
 #' \donttest{
+#' # dplyr -------------------------------------------------------------------
+#'
+#' if (require("dplyr")) {
+#'   tibble(kefzol = random_sir(5)) %>%
+#'     select(cephalosporins())
+#' }
+#'
 #' if (require("dplyr")) {
 #'   # get AMR for all aminoglycosides e.g., per ward:
 #'   example_isolates %>%
@@ -167,12 +179,45 @@
 #'     select(penicillins()) # only the 'J01CA01' column will be selected
 #' }
 #' if (require("dplyr")) {
-#'   # with recent versions of dplyr this is all equal:
+#'   # with recent versions of dplyr, this is all equal:
 #'   x <- example_isolates[carbapenems() == "R", ]
 #'   y <- example_isolates %>% filter(carbapenems() == "R")
 #'   z <- example_isolates %>% filter(if_all(carbapenems(), ~ .x == "R"))
 #'   identical(x, y) && identical(y, z)
 #' }
+#'
+#'
+#' # data.table --------------------------------------------------------------
+#'
+#' # data.table is supported as well, just use it in the same way as with
+#' # base R, but add `with = FALSE` if using a single AB selector.
+#'
+#' if (require("data.table")) {
+#'   dt <- as.data.table(example_isolates)
+#'
+#'   # this does not work, it returns column *names*
+#'   dt[, carbapenems()]
+#' }
+#' if (require("data.table")) {
+#'   # so `with = FALSE` is required
+#'   dt[, carbapenems(), with = FALSE]
+#' }
+#'
+#' # for multiple selections or AB selectors, `with = FALSE` is not needed:
+#' if (require("data.table")) {
+#'   dt[, c("mo", aminoglycosides())]
+#' }
+#' if (require("data.table")) {
+#'   dt[, c(carbapenems(), aminoglycosides())]
+#' }
+#'
+#' # row filters are also supported:
+#' if (require("data.table")) {
+#'   dt[any(carbapenems() == "S"), ]
+#' }
+#' if (require("data.table")) {
+#'   dt[any(carbapenems() == "S"), penicillins(), with = FALSE]
+#' }
 #' }
 ab_class <- function(ab_class,
                      only_sir_columns = FALSE,
@@ -181,6 +226,10 @@ ab_class <- function(ab_class,
   meet_criteria(ab_class, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec(NULL, only_sir_columns = only_sir_columns, ab_class_args = ab_class, only_treatable = only_treatable)
 }
 
@@ -193,6 +242,10 @@ ab_selector <- function(filter,
                         ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
 
   # get_current_data() has to run each time, for cases where e.g., filter() and select() are used in same call
   # but it only takes a couple of milliseconds
@@ -224,6 +277,10 @@ ab_selector <- function(filter,
 aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("aminoglycosides", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
 }
 
@@ -231,6 +288,10 @@ aminoglycosides <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...
 #' @export
 aminopenicillins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("aminopenicillins", only_sir_columns = only_sir_columns)
 }
 
@@ -238,6 +299,10 @@ aminopenicillins <- function(only_sir_columns = FALSE, ...) {
 #' @export
 antifungals <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("antifungals", only_sir_columns = only_sir_columns)
 }
 
@@ -245,6 +310,10 @@ antifungals <- function(only_sir_columns = FALSE, ...) {
 #' @export
 antimycobacterials <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("antimycobacterials", only_sir_columns = only_sir_columns)
 }
 
@@ -253,6 +322,10 @@ antimycobacterials <- function(only_sir_columns = FALSE, ...) {
 betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("betalactams", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
 }
 
@@ -261,6 +334,10 @@ betalactams <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
 carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("carbapenems", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
 }
 
@@ -268,6 +345,10 @@ carbapenems <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
 #' @export
 cephalosporins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins", only_sir_columns = only_sir_columns)
 }
 
@@ -275,6 +356,10 @@ cephalosporins <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_1st <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_1st", only_sir_columns = only_sir_columns)
 }
 
@@ -282,6 +367,10 @@ cephalosporins_1st <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_2nd <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_2nd", only_sir_columns = only_sir_columns)
 }
 
@@ -289,6 +378,10 @@ cephalosporins_2nd <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_3rd <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_3rd", only_sir_columns = only_sir_columns)
 }
 
@@ -296,6 +389,10 @@ cephalosporins_3rd <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_4th <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_4th", only_sir_columns = only_sir_columns)
 }
 
@@ -303,6 +400,10 @@ cephalosporins_4th <- function(only_sir_columns = FALSE, ...) {
 #' @export
 cephalosporins_5th <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("cephalosporins_5th", only_sir_columns = only_sir_columns)
 }
 
@@ -310,6 +411,10 @@ cephalosporins_5th <- function(only_sir_columns = FALSE, ...) {
 #' @export
 fluoroquinolones <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("fluoroquinolones", only_sir_columns = only_sir_columns)
 }
 
@@ -317,6 +422,10 @@ fluoroquinolones <- function(only_sir_columns = FALSE, ...) {
 #' @export
 glycopeptides <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("glycopeptides", only_sir_columns = only_sir_columns)
 }
 
@@ -324,6 +433,10 @@ glycopeptides <- function(only_sir_columns = FALSE, ...) {
 #' @export
 lincosamides <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("lincosamides", only_sir_columns = only_sir_columns)
 }
 
@@ -331,6 +444,10 @@ lincosamides <- function(only_sir_columns = FALSE, ...) {
 #' @export
 lipoglycopeptides <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("lipoglycopeptides", only_sir_columns = only_sir_columns)
 }
 
@@ -338,6 +455,10 @@ lipoglycopeptides <- function(only_sir_columns = FALSE, ...) {
 #' @export
 macrolides <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("macrolides", only_sir_columns = only_sir_columns)
 }
 
@@ -345,6 +466,10 @@ macrolides <- function(only_sir_columns = FALSE, ...) {
 #' @export
 oxazolidinones <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("oxazolidinones", only_sir_columns = only_sir_columns)
 }
 
@@ -352,6 +477,10 @@ oxazolidinones <- function(only_sir_columns = FALSE, ...) {
 #' @export
 penicillins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("penicillins", only_sir_columns = only_sir_columns)
 }
 
@@ -360,6 +489,10 @@ penicillins <- function(only_sir_columns = FALSE, ...) {
 polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(only_treatable, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("polymyxins", only_sir_columns = only_sir_columns, only_treatable = only_treatable)
 }
 
@@ -367,6 +500,10 @@ polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, ...) {
 #' @export
 streptogramins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("streptogramins", only_sir_columns = only_sir_columns)
 }
 
@@ -374,6 +511,10 @@ streptogramins <- function(only_sir_columns = FALSE, ...) {
 #' @export
 quinolones <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("quinolones", only_sir_columns = only_sir_columns)
 }
 
@@ -381,6 +522,10 @@ quinolones <- function(only_sir_columns = FALSE, ...) {
 #' @export
 tetracyclines <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("tetracyclines", only_sir_columns = only_sir_columns)
 }
 
@@ -388,6 +533,10 @@ tetracyclines <- function(only_sir_columns = FALSE, ...) {
 #' @export
 trimethoprims <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("trimethoprims", only_sir_columns = only_sir_columns)
 }
 
@@ -395,6 +544,10 @@ trimethoprims <- function(only_sir_columns = FALSE, ...) {
 #' @export
 ureidopenicillins <- function(only_sir_columns = FALSE, ...) {
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   ab_select_exec("ureidopenicillins", only_sir_columns = only_sir_columns)
 }
 

R/antibiogram.R

@@ -31,7 +31,7 @@
 #'
 #' Generate an antibiogram, and communicate the results in plots or tables. These functions follow the logic of Klinker *et al.* and Barbieri *et al.* (see *Source*), and allow reporting in e.g. R Markdown and Quarto as well.
 #' @param x a [data.frame] containing at least a column with microorganisms and columns with antibiotic results (class 'sir', see [as.sir()])
-#' @param antibiotics vector of column names, or (any combinations of) [antibiotic selectors][antibiotic_class_selectors] such as [aminoglycosides()] or [carbapenems()]. For combination antibiograms, this can also be column names separated with `"+"`, such as "TZP+TOB" given that the data set contains columns "TZP" and "TOB". See *Examples*.
+#' @param antibiotics vector of any antibiotic name or code (will be evaluated with [as.ab()], column name of `x`, or (any combinations of) [antibiotic selectors][antibiotic_class_selectors] such as [aminoglycosides()] or [carbapenems()]. For combination antibiograms, this can also be set to values separated with `"+"`, such as "TZP+TOB" or "cipro + genta", given that columns resembling such antibiotics exist in `x`. See *Examples*.
 #' @param mo_transform a character to transform microorganism input - must be "name", "shortname", "gramstain", or one of the column names of the [microorganisms] data set: `r vector_or(colnames(microorganisms), sort = FALSE, quotes = TRUE)`. Can also be `NULL` to not transform the input.
 #' @param ab_transform a character to transform antibiotic input - must be one of the column names of the [antibiotics] data set: `r vector_or(colnames(antibiotics), sort = FALSE, quotes = TRUE)`. Can also be `NULL` to not transform the input.
 #' @param syndromic_group a column name of `x`, or values calculated to split rows of `x`, e.g. by using [ifelse()] or [`case_when()`][dplyr::case_when()]. See *Examples*.
@@ -45,11 +45,15 @@
 #' @param sep a separating character for antibiotic columns in combination antibiograms
 #' @param info 	a [logical] to indicate info should be printed - the default is `TRUE` only in interactive mode
 #' @param object an [antibiogram()] object
-#' @param ... when used in [print()]: arguments passed on to [knitr::kable()] (otherwise, has no use)
+#' @param ... when used in [R Markdown or Quarto][knitr::kable()]: arguments passed on to [knitr::kable()] (otherwise, has no use)
 #' @details This function returns a table with values between 0 and 100 for *susceptibility*, not resistance.
 #'
 #' **Remember that you should filter your data to let it contain only first isolates!** This is needed to exclude duplicates and to reduce selection bias. Use [first_isolate()] to determine them in your data set with one of the four available algorithms.
 #'
+#' All types of antibiograms as listed below can be plotted (using [ggplot2::autoplot()] or base \R [plot()]/[barplot()]). The `antibiogram` object can also be used directly in R Markdown / Quarto (i.e., `knitr`) for reports. In this case, [knitr::kable()] will be applied automatically and microorganism names will even be printed in italics at default (see argument `italicise`). You can also use functions from specific 'table reporting' packages to transform the output of [antibiogram()] to your needs, e.g. with `flextable::as_flextable()` or `gt::gt()`.
+#'
+#' ### Antibiogram Types
+#'
 #' There are four antibiogram types, as proposed by Klinker *et al.* (2021, \doi{10.1177/20499361211011373}), and they are all supported by [antibiogram()]:
 #'
 #' 1. **Traditional Antibiogram**
@@ -103,8 +107,6 @@
 #'                                           "Study Group", "Control Group"))
 #'    ```
 #'
-#' All types of antibiograms can be generated with the functions as described on this page, and can be plotted (using [ggplot2::autoplot()] or base \R [plot()]/[barplot()]) or printed into R Markdown / Quarto formats for reports using `print()`. Use functions from specific 'table reporting' packages to transform the output of [antibiogram()] to your needs, e.g. `flextable::as_flextable()` or `gt::gt()`.
-#'
 #' Note that for combination antibiograms, it is important to realise that susceptibility can be calculated in two ways, which can be set with the `only_all_tested` argument (default is `FALSE`). See this example for two antibiotics, Drug A and Drug B, about how [antibiogram()] works to calculate the %SI:
 #'
 #' ```
@@ -125,6 +127,7 @@
 #'   <NA>      <NA>        -            -            -            -
 #' --------------------------------------------------------------------
 #' ```
+#'
 #' @source
 #' * Klinker KP *et al.* (2021). **Antimicrobial stewardship and antibiograms: importance of moving beyond traditional antibiograms**. *Therapeutic Advances in Infectious Disease*, May 5;8:20499361211011373; \doi{10.1177/20499361211011373}
 #' * Barbieri E *et al.* (2021). **Development of a Weighted-Incidence Syndromic Combination Antibiogram (WISCA) to guide the choice of the empiric antibiotic treatment for urinary tract infection in paediatric patients: a Bayesian approach** *Antimicrobial Resistance & Infection Control* May 1;10(1):74; \doi{10.1186/s13756-021-00939-2}
@@ -165,8 +168,9 @@
 #'   mo_transform = "gramstain"
 #' )
 #'
+#' # names of antibiotics do not need to resemble columns exactly:
 #' antibiogram(example_isolates,
-#'   antibiotics = c("TZP", "TZP+TOB"),
+#'   antibiotics = c("Cipro", "cipro + genta"),
 #'   mo_transform = "gramstain",
 #'   ab_transform = "name",
 #'   sep = " & "
@@ -209,14 +213,19 @@
 #'   )
 #' )
 #'
+#'
 #' # Print the output for R Markdown / Quarto -----------------------------
 #'
 #' ureido <- antibiogram(example_isolates,
 #'   antibiotics = ureidopenicillins(),
-#'                       ab_transform = "name")
+#'   ab_transform = "name"
+#' )
 #'
-#' # in an Rmd file, you would just need print(ureido), but to be explicit:
-#' print(ureido, as_kable = TRUE, format = "markdown", italicise = TRUE)
+#' # in an Rmd file, you would just need to return `ureido` in a chunk,
+#' # but to be explicit here:
+#' if (requireNamespace("knitr")) {
+#'   knitr::knit_print(ureido)
+#' }
 #'
 #'
 #' # Generate plots with ggplot2 or base R --------------------------------
@@ -240,7 +249,6 @@
 #'
 #' plot(ab1)
 #' plot(ab2)
-#'
 #' }
 antibiogram <- function(x,
                         antibiotics = where(is.sir),
@@ -312,26 +320,21 @@ antibiogram <- function(x,
     df_ab <- get_column_abx(x, verbose = FALSE, info = FALSE)
     # get antibiotics from user
     user_ab <- suppressMessages(suppressWarnings(lapply(antibiotics, as.ab, flag_multiple_results = FALSE, info = FALSE)))
-    user_ab <- lapply(user_ab, function(x) unname(df_ab[match(x, names(df_ab))]))
-    # 
-    # names(user_ab) <- antibiotics.bak
-    # user_ab <- user_ab
-    return(1)
-    # cols <- 
-    # convert antibiotics to valid AB codes
-    abx_ab <- suppressMessages(suppressWarnings(lapply(antibiotics, as.ab, flag_multiple_results = FALSE, info = FALSE)))
-    # match them to existing column names
-    abx_user <- lapply(abx_ab, function(a) unname(names(cols)[match(a, names(cols))]))
-    
+    non_existing <- character(0)
+    user_ab <- lapply(user_ab, function(x) {
+      out <- unname(df_ab[match(x, names(df_ab))])
+      non_existing <<- c(non_existing, x[is.na(out) & !is.na(x)])
       # remove non-existing columns
-    non_existing <- unlist(antibiotics)[is.na(unlist(abx_ab))]
+      out[!is.na(out)]
+    })
+    user_ab <- user_ab[unlist(lapply(user_ab, length)) > 0]
+
     if (length(non_existing) > 0) {
-      warning_("The following antibiotics were not available and ignored: ", vector_and(non_existing, sort = FALSE))
-      abx_user <- Map(antibiotics, abx_user, f = function(input, ab) input[!is.na(ab)])
+      warning_("The following antibiotics were not available and ignored: ", vector_and(ab_name(non_existing, language = NULL, tolower = TRUE), quotes = FALSE))
     }
+
     # make list unique
-    antibiotics <- unique(abx_user)
-    print(antibiotics)
+    antibiotics <- unique(user_ab)
     # go through list to set AMR in combinations
     for (i in seq_len(length(antibiotics))) {
       abx <- antibiotics[[i]]
@@ -455,7 +458,7 @@ antibiogram <- function(x,
       if (i == 1) {
         new_df <- long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
       } else {
-        new_df <- rbind2(
+        new_df <- rbind_AMR(
           new_df,
           long_to_wide(out[which(out$syndromic_group == grp), , drop = FALSE], digs = digits)
         )
@@ -492,13 +495,21 @@ antibiogram <- function(x,
       count_group <- n_per_mo$count[match(new_df[[1]], n_per_mo$mo)]
       edit_col <- 1
     }
+    if (NCOL(new_df) == edit_col + 1) {
+      # only 1 antibiotic
+      new_df[[edit_col]] <- paste0(new_df[[edit_col]], " (", unlist(lapply(strsplit(x = count_group, split = "-", fixed = TRUE), function(x) x[1])), ")")
+      colnames(new_df)[edit_col] <- paste(colnames(new_df)[edit_col], "(N)")
+    } else {
+      # more than 1 antibiotic
       new_df[[edit_col]] <- paste0(new_df[[edit_col]], " (", count_group, ")")
       colnames(new_df)[edit_col] <- paste(colnames(new_df)[edit_col], "(N min-max)")
     }
+  }
 
   out <- as_original_data_class(new_df, class(x), extra_class = "antibiogram")
   rownames(out) <- NULL
   structure(out,
+    has_syndromic_group = has_syndromic_group,
     long = long,
     combine_SI = combine_SI
   )
@@ -572,48 +583,26 @@ autoplot.antibiogram <- function(object, ...) {
     )
 }
 
-#' @export
-#' @param as_kable a [logical] to indicate whether the printing should be done using [knitr::kable()] (which is the default in non-interactive sessions)
-#' @param italicise (only when `as_kable = TRUE`) a [logical] to indicate whether the microorganism names in the output table should be made italic, using [italicise_taxonomy()]. This only works when the output format is markdown, such as in HTML output.
-#' @param na (only when `as_kable = TRUE`) character to use for showing `NA` values
-#' @details Printing the antibiogram in non-interactive sessions will be done by [knitr::kable()], with support for [all their implemented formats][knitr::kable()], such as "markdown". The knitr format will be automatically determined if printed inside a knitr document (LaTeX, HTML, etc.).
+# will be exported in zzz.R
+#' @method knit_print antibiogram
+#' @param italicise a [logical] to indicate whether the microorganism names in the [knitr][knitr::kable()] table should be made italic, using [italicise_taxonomy()].
+#' @param na character to use for showing `NA` values
 #' @rdname antibiogram
-print.antibiogram <- function(x, as_kable = !interactive(), italicise = TRUE, na = getOption("knitr.kable.NA", default = ""), ...) {
-  meet_criteria(as_kable, allow_class = "logical", has_length = 1)
+knit_print.antibiogram <- function(x, italicise = TRUE, na = getOption("knitr.kable.NA", default = ""), ...) {
+  stop_ifnot_installed("knitr")
   meet_criteria(italicise, allow_class = "logical", has_length = 1)
   meet_criteria(na, allow_class = "character", has_length = 1, allow_NA = TRUE)
 
-  if (isTRUE(as_kable) &&
-      pkg_is_available("knitr") &&
-      # be sure not to run kable in pkgdown for our website generation
-      !(missing(as_kable) && identical(Sys.getenv("IN_PKGDOWN"), "true"))) {
+  if (isTRUE(italicise)) {
+    # make all microorganism names italic, according to nomenclature
+    names_col <- ifelse(isTRUE(attributes(x)$has_syndromic_group), 2, 1)
+    x[[names_col]] <- italicise_taxonomy(x[[names_col]], type = "markdown")
+  }
+
   old_option <- getOption("knitr.kable.NA")
   options(knitr.kable.NA = na)
   on.exit(options(knitr.kable.NA = old_option))
-    out <- knitr::kable(x, ...)
-    format <- attributes(out)$format
-    if (!is.null(format) && format %in% c("markdown", "pipe")) {
-      # try to italicise the output
-      rows_with_txt <- which(out %like% "[a-z]")
-      rows_without_txt <- setdiff(seq_len(length(out)), rows_with_txt)
-      out[rows_with_txt] <- gsub("^[|]", "| ", out[rows_with_txt])
-      # put hyphen directly after second character
-      out[rows_without_txt] <- gsub("^[|](.)", "|\\1-", out[rows_without_txt])
-      out_ita <- italicise_taxonomy(as.character(out), type = "markdown")
-      if (length(unique(nchar(out_ita))) != 1) {
-        # so there has been alterations done by italicise_taxonomy()
-        to_fill <- which(nchar(out_ita) < max(nchar(out_ita)))
-        out_ita[intersect(to_fill, rows_with_txt)] <- gsub("(^[|].*?)([|])(.*)", "\\1  \\2\\3", out_ita[intersect(to_fill, rows_with_txt)], perl = TRUE)
-        out_ita[intersect(to_fill, rows_without_txt)] <- gsub("(^[|].*?)([|])(.*)", "\\1--\\2\\3", out_ita[intersect(to_fill, rows_without_txt)], perl = TRUE)
-      }
-      attributes(out_ita) <- attributes(out)
-      out <- out_ita
-    }
-    out
 
-  } else {
-    # remove 'antibiogram' class and print with default method
-    class(x) <- class(x)[class(x) != "antibiogram"]
-    print(x, ...)
-  }
+  out <- paste(c("", "", knitr::kable(x, ..., output = FALSE)), collapse = "\n")
+  knitr::asis_output(out)
 }

R/av.R

@@ -461,7 +461,7 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
   # save to package env to save time for next time
   if (isTRUE(initial_search)) {
     AMR_env$av_previously_coerced <- AMR_env$av_previously_coerced[which(!AMR_env$av_previously_coerced$x %in% x), , drop = FALSE]
-    AMR_env$av_previously_coerced <- unique(rbind2(
+    AMR_env$av_previously_coerced <- unique(rbind_AMR(
       AMR_env$av_previously_coerced,
       data.frame(
         x = x,

R/bug_drug_combinations.R

@@ -39,7 +39,7 @@
 #' @param ... arguments passed on to `FUN`
 #' @inheritParams sir_df
 #' @inheritParams base::formatC
-#' @details The function [format()] calculates the resistance per bug-drug combination. Use `combine_SI = TRUE` (default) to test R vs. S+I and `combine_SI = FALSE` to test R+I vs. S.
+#' @details The function [format()] calculates the resistance per bug-drug combination and returns a table ready for reporting/publishing. Use `combine_SI = TRUE` (default) to test R vs. S+I and `combine_SI = FALSE` to test R+I vs. S. This table can also directly be used in R Markdown / Quarto without the need for e.g. [knitr::kable()].
 #' @export
 #' @rdname bug_drug_combinations
 #' @return The function [bug_drug_combinations()] returns a [data.frame] with columns "mo", "ab", "S", "I", "R" and "total".
@@ -124,7 +124,7 @@ bug_drug_combinations <- function(x,
         m <- as.matrix(table(x))
         data.frame(S = m["S", ], I = m["I", ], R = m["R", ], stringsAsFactors = FALSE)
       })
-      merged <- do.call(rbind2, pivot)
+      merged <- do.call(rbind_AMR, pivot)
       out_group <- data.frame(
         mo = rep(unique_mo[i], NROW(merged)),
         ab = rownames(merged),
@@ -144,14 +144,14 @@ bug_drug_combinations <- function(x,
         }
         out_group <- cbind(group_values, out_group)
       }
-      out <- rbind2(out, out_group)
+      out <- rbind_AMR(out, out_group)
     }
     out
   }
   # based on pm_apply_grouped_function
   apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
     grouped <- pm_split_into_groups(.data, groups, drop)
-    res <- do.call(rbind2, unname(lapply(grouped, fn, ...)))
+    res <- do.call(rbind_AMR, unname(lapply(grouped, fn, ...)))
     if (any(groups %in% colnames(res))) {
       class(res) <- c("grouped_data", class(res))
       res <- pm_set_groups(res, groups[groups %in% colnames(res)])
@@ -327,7 +327,15 @@ format.bug_drug_combinations <- function(x,
   }
 
   rownames(y) <- NULL
-  as_original_data_class(y, class(x.bak)) # will remove tibble groups
+  as_original_data_class(y, class(x.bak), extra_class = "formatted_bug_drug_combinations") # will remove tibble groups
+}
+
+# will be exported in zzz.R
+knit_print.formatted_bug_drug_combinations <- function(x, ...) {
+  stop_ifnot_installed("knitr")
+  # make columns with MO names italic according to nomenclature
+  colnames(x)[3:NCOL(x)] <- italicise_taxonomy(colnames(x)[3:NCOL(x)], type = "markdown")
+  knitr::asis_output(paste("", "", knitr::kable(x, ...), collapse = "\n"))
 }
 
 #' @method print bug_drug_combinations

R/custom_antimicrobials.R

@@ -33,7 +33,7 @@
 #' @param x a [data.frame] resembling the [antibiotics] data set, at least containing columns "ab" and "name"
 #' @details **Important:** Due to how \R works, the [add_custom_antimicrobials()] function has to be run in every \R session - added antimicrobials are not stored between sessions and are thus lost when \R is exited.
 #'
-#' There are two ways to automate this process:
+#' There are two ways to circumvent this and automate the process of adding antimicrobials:
 #'
 #' **Method 1:** Using the [package option][AMR-options] [`AMR_custom_ab`][AMR-options], which is the preferred method. To use this method:
 #'
@@ -48,7 +48,7 @@
 #'
 #'       Upon package load, this file will be loaded and run through the [add_custom_antimicrobials()] function.
 #'
-#' **Method 2:** Loading the antimicrobial additions directly from your `.Rprofile` file. An important downside is that this requires the `AMR` package to be installed or else this method will fail. To use this method:
+#' **Method 2:** Loading the antimicrobial additions directly from your `.Rprofile` file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method:
 #'
 #'    1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
 #'
@@ -153,7 +153,7 @@ add_custom_antimicrobials <- function(x) {
     # assign new values
     new_df[, col] <- x[, col, drop = TRUE]
   }
-  AMR_env$AB_lookup <- unique(rbind2(AMR_env$AB_lookup, new_df))
+  AMR_env$AB_lookup <- unique(rbind_AMR(AMR_env$AB_lookup, new_df))
 
   AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% x$ab), , drop = FALSE]
   class(AMR_env$AB_lookup$ab) <- c("ab", "character")

R/custom_microorganisms.R

@@ -35,7 +35,7 @@
 #'
 #' **Important:** Due to how \R works, the [add_custom_microorganisms()] function has to be run in every \R session - added microorganisms are not stored between sessions and are thus lost when \R is exited.
 #'
-#' There are two ways to automate this process:
+#' There are two ways to circumvent this and automate the process of adding microorganisms:
 #'
 #' **Method 1:** Using the [package option][AMR-options] [`AMR_custom_mo`][AMR-options], which is the preferred method. To use this method:
 #'
@@ -50,7 +50,7 @@
 #'
 #'       Upon package load, this file will be loaded and run through the [add_custom_microorganisms()] function.
 #'
-#' **Method 2:** Loading the microorganism directly from your `.Rprofile` file. An important downside is that this requires the `AMR` package to be installed or else this method will fail. To use this method:
+#' **Method 2:** Loading the microorganism directly from your `.Rprofile` file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method:
 #'
 #'    1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
 #'
@@ -64,7 +64,7 @@
 #'        )
 #'       ```
 #'
-#' Use [clear_custom_microorganisms()] to clear the previously added antimicrobials.
+#' Use [clear_custom_microorganisms()] to clear the previously added microorganisms.
 #' @seealso [add_custom_antimicrobials()] to add custom antimicrobials.
 #' @rdname add_custom_microorganisms
 #' @export
@@ -279,7 +279,7 @@ add_custom_microorganisms <- function(x) {
   # clear previous coercions
   suppressMessages(mo_reset_session())
 
-  AMR_env$MO_lookup <- unique(rbind2(AMR_env$MO_lookup, new_df))
+  AMR_env$MO_lookup <- unique(rbind_AMR(AMR_env$MO_lookup, new_df))
   class(AMR_env$MO_lookup$mo) <- c("mo", "character")
   if (nrow(x) <= 3) {
     message_("Added ", vector_and(italicise(x$fullname), quotes = FALSE), " to the internal `microorganisms` data set.")
@@ -297,6 +297,9 @@ clear_custom_microorganisms <- function() {
   AMR_env$MO_lookup <- NULL
   add_MO_lookup_to_AMR_env()
 
+  # clear previous coercions
+  suppressMessages(mo_reset_session())
+
   n2 <- nrow(AMR_env$MO_lookup)
   AMR_env$custom_mo_codes <- character(0)
   AMR_env$mo_previously_coerced <- AMR_env$mo_previously_coerced[which(AMR_env$mo_previously_coerced$mo %in% AMR_env$MO_lookup$mo), , drop = FALSE]

R/data.R

@@ -197,7 +197,7 @@
 
 #' Data Set with `r format(nrow(WHONET), big.mark = " ")` Isolates - WHONET Example
 #'
-#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are from our [example_isolates] data set. All patient names are created using online surname generators and are only in place for practice purposes.
+#' This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are from our [example_isolates] data set. All patient names were created using online surname generators and are only in place for practice purposes.
 #' @format A [tibble][tibble::tibble] with `r format(nrow(WHONET), big.mark = " ")` observations and `r ncol(WHONET)` variables:
 #' - `Identification number`\cr ID of the sample
 #' - `Specimen number`\cr ID of the specimen

R/eucast_rules.R

@@ -181,6 +181,7 @@ eucast_rules <- function(x,
   meet_criteria(ampc_cephalosporin_resistance, allow_class = c("logical", "character", "sir"), has_length = 1, allow_NA = TRUE, allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
   meet_criteria(custom_rules, allow_class = "custom_eucast_rules", allow_NULL = TRUE)
+  if ("only_rsi_columns" %in% names(list(...))) only_sir_columns <- list(...)$only_rsi_columns
 
   add_MO_lookup_to_AMR_env()
 
@@ -475,7 +476,7 @@ eucast_rules <- function(x,
     amox$base_ab <- "AMX"
     amox$base_name <- ab_name("AMX", language = NULL)
     # merge and sort
-    ab_enzyme <- rbind2(ab_enzyme, ampi, amox)
+    ab_enzyme <- rbind_AMR(ab_enzyme, ampi, amox)
     ab_enzyme <- ab_enzyme[order(ab_enzyme$enzyme_name), , drop = FALSE]
 
     for (i in seq_len(nrow(ab_enzyme))) {
@@ -1161,7 +1162,7 @@ edit_sir <- function(x,
         )
         verbose_new <- verbose_new %pm>% pm_filter(old != new | is.na(old) | is.na(new) & !is.na(old))
         # save changes to data set 'verbose_info'
-        track_changes$verbose_info <- rbind2(
+        track_changes$verbose_info <- rbind_AMR(
           track_changes$verbose_info,
           verbose_new
         )
@@ -1215,7 +1216,7 @@ eucast_dosage <- function(ab, administration = "iv", version_breakpoints = 12.0)
       )
     )
   }
-  out <- do.call(rbind2, lapply(lst, as.data.frame, stringsAsFactors = FALSE))
+  out <- do.call(rbind_AMR, lapply(lst, as.data.frame, stringsAsFactors = FALSE))
   rownames(out) <- NULL
   out$ab <- ab
   out$name <- ab_name(ab, language = NULL)

R/first_isolate.R

@@ -226,6 +226,10 @@ first_isolate <- function(x = NULL,
   meet_criteria(points_threshold, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE)
   meet_criteria(info, allow_class = "logical", has_length = 1)
   meet_criteria(include_unknown, allow_class = "logical", has_length = 1)
+  if ("include_untested_rsi" %in% names(list(...))) {
+    deprecation_warning("include_untested_rsi", "include_untested_sir", is_function = FALSE)
+    include_untested_sir <- list(...)$include_untested_rsi
+  }
   meet_criteria(include_untested_sir, allow_class = "logical", has_length = 1)
 
   # remove data.table, grouping from tibbles, etc.
@@ -346,7 +350,7 @@ first_isolate <- function(x = NULL,
   x$newvar_mo <- as.mo(x[, col_mo, drop = TRUE])
   x$newvar_genus_species <- paste(mo_genus(x$newvar_mo), mo_species(x$newvar_mo))
   x$newvar_date <- x[, col_date, drop = TRUE]
-  x$newvar_patient_id <- x[, col_patient_id, drop = TRUE]
+  x$newvar_patient_id <- as.character(x[, col_patient_id, drop = TRUE])
 
   if (is.null(col_testcode)) {
     testcodes_exclude <- NULL
@@ -374,7 +378,7 @@ first_isolate <- function(x = NULL,
     }
   }
   if (!is.null(col_keyantimicrobials)) {
-    x$newvar_key_ab <- x[, col_keyantimicrobials, drop = TRUE]
+    x$newvar_key_ab <- as.character(x[, col_keyantimicrobials, drop = TRUE])
   }
 
   if (is.null(testcodes_exclude)) {

R/get_episode.R

@@ -27,16 +27,55 @@
 # how to conduct AMR data analysis: https://msberends.github.io/AMR/   #
 # ==================================================================== #
 
-#' Determine (Clinical) Episodes
+#' 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, and is thus equal to `!duplicated(get_episode(...))`.
+#' 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 required 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 (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 The functions [get_episode()] and [is_new_episode()] differ in this way when setting `episode_days` to 365:
+#' @details Episodes can be determined in two ways: absolute and relative.
 #'
+#' 1. Absolute
 #'
-#' | person_id | date       | `get_episode()` | `is_new_episode()` |
+#'    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 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**          |              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             |
+#'
+#' ** 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 [is_new_episode()] function on the other hand, returns `TRUE` for every new [get_episode()] index.
+#'
+#' 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               |
 #' | A         | 2019-03-01 |               1 | FALSE              |
@@ -45,7 +84,7 @@
 #' | B         | 2008-01-01 |               1 | FALSE              |
 #' | C         | 2020-01-01 |               1 | TRUE               |
 #'
-#' Dates are first sorted from old to new. The oldest date will mark the start of the first episode. After this date, the next date will be marked that is at least `episode_days` days later than the start of the first episode. From that second marked date on, the next date will be marked that is at least `episode_days` days later than the start of the second episode which will be the start of the third episode, and so on. Before the vector is being returned, the original order will be restored.
+#' ### 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.
 #'
@@ -57,6 +96,24 @@
 #' @rdname get_episode
 #' @export
 #' @examples
+#' # difference between absolute and relative determination of episodes:
+#' 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)
+#' x
+#'
+#'
 #' # `example_isolates` is a data set available in the AMR package.
 #' # See ?example_isolates
 #' df <- example_isolates[sample(seq_len(2000), size = 100), ]
@@ -140,55 +197,72 @@
 #'     select(group_vars(.), flag_episode)
 #' }
 #' }
-get_episode <- function(x, episode_days, ...) {
+get_episode <- function(x, episode_days = NULL, case_free_days = NULL, ...) {
   meet_criteria(x, allow_class = c("Date", "POSIXt"), allow_NA = TRUE)
-  meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
-  as.integer(exec_episode(x, episode_days, ...))
+  meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
+  meet_criteria(case_free_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
+  as.integer(exec_episode(x, episode_days, case_free_days, ...))
 }
 
 #' @rdname get_episode
 #' @export
-is_new_episode <- function(x, episode_days, ...) {
+is_new_episode <- function(x, episode_days = NULL, case_free_days = NULL, ...) {
   meet_criteria(x, allow_class = c("Date", "POSIXt"), allow_NA = TRUE)
-  meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE)
-  !duplicated(exec_episode(x, episode_days, ...))
+  meet_criteria(episode_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
+  meet_criteria(case_free_days, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = FALSE, allow_NULL = TRUE)
+  !duplicated(exec_episode(x, episode_days, case_free_days, ...))
 }
 
-exec_episode <- function(x, episode_days, ...) {
+exec_episode <- function(x, episode_days, case_free_days, ...) {
+  stop_ifnot(is.null(episode_days) || is.null(case_free_days),
+    "either argument `episode_days` or argument `case_free_days` must be set.",
+    call = -2
+  )
+
+  # 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
 
   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 (max(x) - min(x) >= episode_seconds) {
+  } 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))
+      }
     } else {
       return(c(1, 1))
     }
   }
 
-  # we asked on StackOverflow:
-  # https://stackoverflow.com/questions/42122245/filter-one-row-every-year
-  run_episodes <- function(x, episode_seconds) {
-    indices <- integer()
+  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[1] <- 1
+    indices[ind] <- 1
     for (i in 2:length(x)) {
-      if (isTRUE((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)) {
         ind <- ind + 1
         start <- x[i]
       }
       indices[i] <- ind
     }
+    indices[NAs] <- NA
     indices
   }
 
   ord <- order(x)
-  out <- run_episodes(x[ord], episode_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
 }

R/key_antimicrobials.R

@@ -149,6 +149,10 @@ key_antimicrobials <- function(x = NULL,
   meet_criteria(gram_positive, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(antifungal, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
 
   # force regular data.frame, not a tibble or data.table
   x <- as.data.frame(x, stringsAsFactors = FALSE)

R/mdro.R

@@ -192,6 +192,10 @@ mdro <- function(x = NULL,
   meet_criteria(pct_required_classes, allow_class = "numeric", has_length = 1)
   meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
   meet_criteria(verbose, allow_class = "logical", has_length = 1)
+  if ("only_rsi_columns" %in% names(list(...))) {
+    deprecation_warning("only_rsi_columns", "only_sir_columns", is_function = FALSE)
+    only_sir_columns <- list(...)$only_rsi_columns
+  }
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
 
   if (!any(is_sir_eligible(x))) {

R/mo.R

@@ -329,21 +329,21 @@ as.mo <- function(x,
         result_mo <- NA_character_
       } else {
         result_mo <- AMR_env$MO_lookup$mo[match(top_hits[1], AMR_env$MO_lookup$fullname)]
-        AMR_env$mo_uncertainties <- rbind2(
+        AMR_env$mo_uncertainties <- rbind_AMR(
           AMR_env$mo_uncertainties,
           data.frame(
             original_input = x_search,
             input = x_search_cleaned,
             fullname = top_hits[1],
             mo = result_mo,
-            candidates = ifelse(length(top_hits) > 1, paste(top_hits[2:min(26, length(top_hits))], collapse = ", "), ""),
+            candidates = ifelse(length(top_hits) > 1, paste(top_hits[2:min(99, length(top_hits))], collapse = ", "), ""),
             minimum_matching_score = ifelse(is.null(minimum_matching_score), "NULL", minimum_matching_score),
             keep_synonyms = keep_synonyms,
             stringsAsFactors = FALSE
           )
         )
         # save to package env to save time for next time
-        AMR_env$mo_previously_coerced <- unique(rbind2(
+        AMR_env$mo_previously_coerced <- unique(rbind_AMR(
           AMR_env$mo_previously_coerced,
           data.frame(
             x = paste(x_search, minimum_matching_score),
@@ -798,7 +798,7 @@ rep.mo <- function(x, ...) {
 #' @method print mo_uncertainties
 #' @export
 #' @noRd
-print.mo_uncertainties <- function(x, ...) {
+print.mo_uncertainties <- function(x, n = 10, ...) {
   if (NROW(x) == 0) {
     cat(word_wrap("No uncertainties to show. Only uncertainties of the last call of `as.mo()` or any `mo_*()` function are stored.\n\n", add_fn = font_blue))
     return(invisible(NULL))
@@ -833,9 +833,14 @@ print.mo_uncertainties <- function(x, ...) {
   }
 
   txt <- ""
+  any_maxed_out <- FALSE
   for (i in seq_len(nrow(x))) {
     if (x[i, ]$candidates != "") {
       candidates <- unlist(strsplit(x[i, ]$candidates, ", ", fixed = TRUE))
+      if (length(candidates) > n) {
+        any_maxed_out <- TRUE
+        candidates <- candidates[seq_len(n)]
+      }
       scores <- mo_matching_score(x = x[i, ]$input, n = candidates)
       n_candidates <- length(candidates)
 
@@ -856,10 +861,6 @@ print.mo_uncertainties <- function(x, ...) {
               font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
             ),
             quotes = FALSE, sort = FALSE
-          ),
-          ifelse(n_candidates == 25,
-            font_grey(" [showing first 25]"),
-            ""
           )
         ),
         extra_indent = nchar("Also matched: "),
@@ -905,7 +906,11 @@ print.mo_uncertainties <- function(x, ...) {
     txt <- gsub("(^[\n]|[\n]$)", "", txt)
     txt <- paste0("\n", txt, "\n")
   }
+
   cat(txt)
+  if (isTRUE(any_maxed_out)) {
+    cat(font_blue(word_wrap("\nOnly the first ", n, " other matches of each record are shown. Run `print(mo_uncertainties(), n = ...)` to view more entries, or save `mo_uncertainties()` to an object.")))
+  }
 }
 
 #' @method print mo_renamed

R/mo_source.R

@@ -149,7 +149,7 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s
 
   df <- NULL
   if (path %like% "[.]rds$") {
-    df <- readRDS2(path)
+    df <- readRDS_AMR(path)
   } else if (path %like% "[.]xlsx?$") {
     # is Excel file (old or new)
     stop_ifnot_installed("readxl")
@@ -248,7 +248,7 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.
     return(NULL)
   }
   if (is.null(AMR_env$mo_source)) {
-    AMR_env$mo_source <- readRDS2(path.expand(destination))
+    AMR_env$mo_source <- readRDS_AMR(path.expand(destination))
   }
 
   old_time <- attributes(AMR_env$mo_source)$mo_source_timestamp

R/plot.R

@@ -88,8 +88,8 @@ plot.mic <- function(x,
                      ab = NULL,
                      guideline = "EUCAST",
                      main = deparse(substitute(x)),
-                     ylab = "Frequency",
-                     xlab = "Minimum Inhibitory Concentration (mg/L)",
+                     ylab = translate_AMR("Frequency", language = language),
+                     xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
                      colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                      language = get_AMR_locale(),
                      expand = TRUE,
@@ -100,18 +100,14 @@ plot.mic <- function(x,
   meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
   meet_criteria(xlab, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if (length(colours_SIR) == 1) {
     colours_SIR <- rep(colours_SIR, 3)
   }
@@ -127,6 +123,7 @@ plot.mic <- function(x,
     colours_SIR = colours_SIR,
     fn = as.mic,
     language = language,
+    type = "MIC",
     ...
   )
   barplot(x,
@@ -146,15 +143,15 @@ plot.mic <- function(x,
     legend_txt <- character(0)
     legend_col <- character(0)
     if (any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) {
-      legend_txt <- "Susceptible"
+      legend_txt <- c(legend_txt, "(S) Susceptible")
       legend_col <- colours_SIR[1]
     }
     if (any(cols_sub$cols == colours_SIR[2] & cols_sub$count > 0)) {
-      legend_txt <- c(legend_txt, plot_name_of_I(cols_sub$guideline))
+      legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
       legend_col <- c(legend_col, colours_SIR[2])
     }
     if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
-      legend_txt <- c(legend_txt, "Resistant")
+      legend_txt <- c(legend_txt, "(R) Resistant")
       legend_col <- c(legend_col, colours_SIR[3])
     }
 
@@ -179,8 +176,8 @@ barplot.mic <- function(height,
                         ab = NULL,
                         guideline = "EUCAST",
                         main = deparse(substitute(height)),
-                        ylab = "Frequency",
-                        xlab = "Minimum Inhibitory Concentration (mg/L)",
+                        ylab = translate_AMR("Frequency", language = language),
+                        xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
                         colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                         language = get_AMR_locale(),
                         expand = TRUE,
@@ -191,18 +188,14 @@ barplot.mic <- function(height,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   main <- gsub(" +", " ", paste0(main, collapse = " "))
 
   plot(
@@ -226,8 +219,8 @@ autoplot.mic <- function(object,
                          ab = NULL,
                          guideline = "EUCAST",
                          title = deparse(substitute(object)),
-                         ylab = "Frequency",
-                         xlab = "Minimum Inhibitory Concentration (mg/L)",
+                         ylab = translate_AMR("Frequency", language = language),
+                         xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
                          colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                          language = get_AMR_locale(),
                          expand = TRUE,
@@ -239,18 +232,14 @@ autoplot.mic <- function(object,
   meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
   meet_criteria(xlab, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if ("main" %in% names(list(...))) {
     title <- list(...)$main
   }
@@ -267,16 +256,22 @@ autoplot.mic <- function(object,
     colours_SIR = colours_SIR,
     fn = as.mic,
     language = language,
+    type = "MIC",
     ...
   )
   df <- as.data.frame(x, stringsAsFactors = TRUE)
   colnames(df) <- c("mic", "count")
   df$cols <- cols_sub$cols
-  df$cols[df$cols == colours_SIR[1]] <- "Susceptible"
-  df$cols[df$cols == colours_SIR[2]] <- plot_name_of_I(cols_sub$guideline)
-  df$cols[df$cols == colours_SIR[3]] <- "Resistant"
+  df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible"
+  df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
+  df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
   df$cols <- factor(translate_into_language(df$cols, language = language),
-    levels = translate_into_language(c("Susceptible", plot_name_of_I(cols_sub$guideline), "Resistant"),
+    levels = translate_into_language(
+      c(
+        "(S) Susceptible",
+        paste("(I)", plot_name_of_I(cols_sub$guideline)),
+        "(R) Resistant"
+      ),
       language = language
     ),
     ordered = TRUE
@@ -285,10 +280,10 @@ autoplot.mic <- function(object,
 
   if (any(colours_SIR %in% cols_sub$cols)) {
     vals <- c(
-      "Susceptible" = colours_SIR[1],
-      "Susceptible, incr. exp." = colours_SIR[2],
-      "Intermediate" = colours_SIR[2],
-      "Resistant" = colours_SIR[3]
+      "(S) Susceptible" = colours_SIR[1],
+      "(I) Susceptible, incr. exp." = colours_SIR[2],
+      "(I) Intermediate" = colours_SIR[2],
+      "(R) Resistant" = colours_SIR[3]
     )
     names(vals) <- translate_into_language(names(vals), language = language)
     p <- p +
@@ -324,8 +319,8 @@ fortify.mic <- function(object, ...) {
 #' @rdname plot
 plot.disk <- function(x,
                       main = deparse(substitute(x)),
-                      ylab = "Frequency",
-                      xlab = "Disk diffusion diameter (mm)",
+                      ylab = translate_AMR("Frequency", language = language),
+                      xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
                       mo = NULL,
                       ab = NULL,
                       guideline = "EUCAST",
@@ -339,18 +334,14 @@ plot.disk <- function(x,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if (length(colours_SIR) == 1) {
     colours_SIR <- rep(colours_SIR, 3)
   }
@@ -366,6 +357,7 @@ plot.disk <- function(x,
     colours_SIR = colours_SIR,
     fn = as.disk,
     language = language,
+    type = "disk",
     ...
   )
 
@@ -386,15 +378,15 @@ plot.disk <- function(x,
     legend_txt <- character(0)
     legend_col <- character(0)
     if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
-      legend_txt <- "Resistant"
+      legend_txt <- "(R) Resistant"
       legend_col <- colours_SIR[3]
     }
     if (any(cols_sub$cols == colours_SIR[2] & cols_sub$count > 0)) {
-      legend_txt <- c(legend_txt, plot_name_of_I(cols_sub$guideline))
+      legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
       legend_col <- c(legend_col, colours_SIR[2])
     }
     if (any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) {
-      legend_txt <- c(legend_txt, "Susceptible")
+      legend_txt <- c(legend_txt, "(S) Susceptible")
       legend_col <- c(legend_col, colours_SIR[1])
     }
     legend("top",
@@ -415,8 +407,8 @@ plot.disk <- function(x,
 #' @noRd
 barplot.disk <- function(height,
                          main = deparse(substitute(height)),
-                         ylab = "Frequency",
-                         xlab = "Disk diffusion diameter (mm)",
+                         ylab = translate_AMR("Frequency", language = language),
+                         xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
                          mo = NULL,
                          ab = NULL,
                          guideline = "EUCAST",
@@ -430,18 +422,14 @@ barplot.disk <- function(height,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   main <- gsub(" +", " ", paste0(main, collapse = " "))
 
   plot(
@@ -464,8 +452,8 @@ autoplot.disk <- function(object,
                           mo = NULL,
                           ab = NULL,
                           title = deparse(substitute(object)),
-                          ylab = "Frequency",
-                          xlab = "Disk diffusion diameter (mm)",
+                          ylab = translate_AMR("Frequency", language = language),
+                          xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
                           guideline = "EUCAST",
                           colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                           language = get_AMR_locale(),
@@ -478,18 +466,14 @@ autoplot.disk <- function(object,
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if ("main" %in% names(list(...))) {
     title <- list(...)$main
   }
@@ -506,17 +490,23 @@ autoplot.disk <- function(object,
     colours_SIR = colours_SIR,
     fn = as.disk,
     language = language,
+    type = "disk",
     ...
   )
   df <- as.data.frame(x, stringsAsFactors = TRUE)
   colnames(df) <- c("disk", "count")
   df$cols <- cols_sub$cols
 
-  df$cols[df$cols == colours_SIR[1]] <- "Susceptible"
-  df$cols[df$cols == colours_SIR[2]] <- plot_name_of_I(cols_sub$guideline)
-  df$cols[df$cols == colours_SIR[3]] <- "Resistant"
+  df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible"
+  df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
+  df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
   df$cols <- factor(translate_into_language(df$cols, language = language),
-    levels = translate_into_language(c("Susceptible", plot_name_of_I(cols_sub$guideline), "Resistant"),
+    levels = translate_into_language(
+      c(
+        "(S) Susceptible",
+        paste("(I)", plot_name_of_I(cols_sub$guideline)),
+        "(R) Resistant"
+      ),
       language = language
     ),
     ordered = TRUE
@@ -525,10 +515,10 @@ autoplot.disk <- function(object,
 
   if (any(colours_SIR %in% cols_sub$cols)) {
     vals <- c(
-      "Susceptible" = colours_SIR[1],
-      "Susceptible, incr. exp." = colours_SIR[2],
-      "Intermediate" = colours_SIR[2],
-      "Resistant" = colours_SIR[3]
+      "(S) Susceptible" = colours_SIR[1],
+      "(I) Susceptible, incr. exp." = colours_SIR[2],
+      "(I) Intermediate" = colours_SIR[2],
+      "(R) Resistant" = colours_SIR[3]
     )
     names(vals) <- translate_into_language(names(vals), language = language)
     p <- p +
@@ -563,8 +553,8 @@ fortify.disk <- function(object, ...) {
 #' @importFrom graphics plot text axis
 #' @rdname plot
 plot.sir <- function(x,
-                     ylab = "Percentage",
-                     xlab = "Antimicrobial Interpretation",
+                     ylab = translate_AMR("Percentage", language = language),
+                     xlab = translate_AMR("Antimicrobial Interpretation", language = language),
                      main = deparse(substitute(x)),
                      language = get_AMR_locale(),
                      ...) {
@@ -572,26 +562,18 @@ plot.sir <- function(x,
   meet_criteria(xlab, allow_class = "character", has_length = 1)
   meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   data <- as.data.frame(table(x), stringsAsFactors = FALSE)
   colnames(data) <- c("x", "n")
   data$s <- round((data$n / sum(data$n)) * 100, 1)
 
   if (!"S" %in% data$x) {
-    data <- rbind2(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE))
+    data <- rbind_AMR(data, data.frame(x = "S", n = 0, s = 0, stringsAsFactors = FALSE))
   }
   if (!"I" %in% data$x) {
-    data <- rbind2(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE))
+    data <- rbind_AMR(data, data.frame(x = "I", n = 0, s = 0, stringsAsFactors = FALSE))
   }
   if (!"R" %in% data$x) {
-    data <- rbind2(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE))
+    data <- rbind_AMR(data, data.frame(x = "R", n = 0, s = 0, stringsAsFactors = FALSE))
   }
 
   data$x <- factor(data$x, levels = c("S", "I", "R"), ordered = TRUE)
@@ -627,8 +609,8 @@ plot.sir <- function(x,
 #' @noRd
 barplot.sir <- function(height,
                         main = deparse(substitute(height)),
-                        xlab = "Antimicrobial Interpretation",
-                        ylab = "Frequency",
+                        xlab = translate_AMR("Antimicrobial Interpretation", language = language),
+                        ylab = translate_AMR("Frequency", language = language),
                         colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                         language = get_AMR_locale(),
                         expand = TRUE,
@@ -636,18 +618,14 @@ barplot.sir <- function(height,
   meet_criteria(xlab, allow_class = "character", has_length = 1)
   meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
+  if ("colours_RSI" %in% names(list(...))) {
+    deprecation_warning(extra_msg = "The 'colours_RSI' argument has been replaced with 'colours_SIR'.")
+    colours_SIR <- list(...)$colours_RSI
+  }
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if (length(colours_SIR) == 1) {
     colours_SIR <- rep(colours_SIR, 3)
   }
@@ -670,8 +648,8 @@ barplot.sir <- function(height,
 # will be exported using s3_register() in R/zzz.R
 autoplot.sir <- function(object,
                          title = deparse(substitute(object)),
-                         xlab = "Antimicrobial Interpretation",
-                         ylab = "Frequency",
+                         xlab = translate_AMR("Antimicrobial Interpretation", language = language),
+                         ylab = translate_AMR("Frequency", language = language),
                          colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
                          language = get_AMR_locale(),
                          ...) {
@@ -681,14 +659,6 @@ autoplot.sir <- function(object,
   meet_criteria(xlab, allow_class = "character", has_length = 1)
   meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
 
-  # translate if not specifically set
-  if (missing(ylab)) {
-    ylab <- translate_into_language(ylab, language = language)
-  }
-  if (missing(xlab)) {
-    xlab <- translate_into_language(xlab, language = language)
-  }
-
   if ("main" %in% names(list(...))) {
     title <- list(...)$main
   }
@@ -774,33 +744,44 @@ plot_name_of_I <- function(guideline) {
   }
 }
 
-plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, fn, language, ...) {
+plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, fn, language, type, ...) {
   guideline <- get_guideline(guideline, AMR::clinical_breakpoints)
   if (!is.null(mo) && !is.null(ab)) {
     # interpret and give colour based on MIC values
     mo <- as.mo(mo)
-    ab <- as.ab(ab)
-    sir <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, ...)))
-    cols <- character(length = length(sir))
-    cols[is.na(sir)] <- "#BEBEBE"
-    cols[sir == "S"] <- colours_SIR[1]
-    cols[sir == "I"] <- colours_SIR[2]
-    cols[sir == "R"] <- colours_SIR[3]
     moname <- mo_name(mo, language = language)
+    ab <- as.ab(ab)
     abname <- ab_name(ab, language = language)
-    if (all(cols == "#BEBEBE")) {
+
+    sir <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, include_screening = FALSE, include_PKPD = TRUE, ...)))
+    guideline_txt <- guideline
+    if (all(is.na(sir))) {
+      sir_screening <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, include_screening = TRUE, include_PKPD = TRUE, ...)))
+      if (!all(is.na(sir_screening))) {
         message_(
-        "No ", guideline, " interpretations found for ",
-        ab_name(ab, language = NULL, tolower = TRUE), " in ", moname
+          "Only ", guideline, " ", type, " interpretations found for ",
+          ab_name(ab, language = NULL, tolower = TRUE), " in ", italicise(moname), " for screening"
+        )
+        sir <- sir_screening
+        guideline_txt <- paste0("(Screen, ", guideline_txt, ")")
+      } else {
+        message_(
+          "No ", guideline, " ", type, " interpretations found for ",
+          ab_name(ab, language = NULL, tolower = TRUE), " in ", italicise(moname)
         )
         guideline_txt <- ""
+      }
     } else {
-      guideline_txt <- guideline
       if (isTRUE(list(...)$uti)) {
         guideline_txt <- paste("UTIs,", guideline_txt)
       }
       guideline_txt <- paste0("(", guideline_txt, ")")
     }
+    cols <- character(length = length(sir))
+    cols[is.na(sir)] <- "#BEBEBE"
+    cols[sir == "S"] <- colours_SIR[1]
+    cols[sir == "I"] <- colours_SIR[2]
+    cols[sir == "R"] <- colours_SIR[3]
     sub <- bquote(.(abname) ~ "-" ~ italic(.(moname)) ~ .(guideline_txt))
   } else {
     cols <- "#BEBEBE"

R/proportion.R

@@ -43,6 +43,7 @@
 #' @param ab_result antibiotic results to test against, must be one or more values of "S", "I", or "R"
 #' @param confidence_level the confidence level for the returned confidence interval. For the calculation, the number of S or SI isolates, and R isolates are compared with the total number of available isolates with R, S, or I by using [binom.test()], i.e., the Clopper-Pearson method.
 #' @param side the side of the confidence interval to return. The default is `"both"` for a length 2 vector, but can also be (abbreviated as) `"min"`/`"left"`/`"lower"`/`"less"` or `"max"`/`"right"`/`"higher"`/`"greater"`.
+#' @param collapse a [logical] to indicate whether the output values should be 'collapsed', i.e. be merged together into one value, or a character value to use for collapsing
 #' @inheritSection as.sir Interpretation of SIR
 #' @details
 #' The function [resistance()] is equal to the function [proportion_R()]. The function [susceptibility()] is equal to the function [proportion_SI()].
@@ -112,6 +113,10 @@
 #' sir_confidence_interval(example_isolates$AMX,
 #'   confidence_level = 0.975
 #' )
+#' sir_confidence_interval(example_isolates$AMX,
+#'   confidence_level = 0.975,
+#'   collapse = ", "
+#' )
 #'
 #' # determines %S+I:
 #' susceptibility(example_isolates$AMX)
@@ -260,10 +265,16 @@ sir_confidence_interval <- function(...,
                                     as_percent = FALSE,
                                     only_all_tested = FALSE,
                                     confidence_level = 0.95,
-                                    side = "both") {
+                                    side = "both",
+                                    collapse = FALSE) {
   meet_criteria(ab_result, allow_class = c("character", "sir"), has_length = c(1, 2, 3), is_in = c("S", "I", "R"))
+  meet_criteria(minimum, allow_class = c("numeric", "integer"), has_length = 1, is_positive_or_zero = TRUE, is_finite = TRUE)
+  meet_criteria(as_percent, allow_class = "logical", has_length = 1)
+  meet_criteria(only_all_tested, allow_class = "logical", has_length = 1)
   meet_criteria(confidence_level, allow_class = "numeric", is_positive = TRUE, has_length = 1)
   meet_criteria(side, allow_class = "character", has_length = 1, is_in = c("both", "b", "left", "l", "lower", "lowest", "less", "min", "right", "r", "higher", "highest", "greater", "g", "max"))
+  meet_criteria(collapse, allow_class = c("logical", "character"), has_length = 1)
+
   x <- tryCatch(
     sir_calc(...,
       ab_result = ab_result,
@@ -281,19 +292,7 @@ sir_confidence_interval <- function(...,
     error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
   )
 
-  if (n < minimum) {
-    warning_("Introducing NA: ",
-      ifelse(n == 0, "no", paste("only", n)),
-      " results available for `sir_confidence_interval()` (`minimum` = ", minimum, ").",
-      call = FALSE
-    )
-    if (as_percent == TRUE) {
-      return(NA_character_)
-    } else {
-      return(NA_real_)
-    }
-  }
-
+  # this applies the Clopper-Pearson method
   out <- stats::binom.test(x = x, n = n, conf.level = confidence_level)$conf.int
   out <- set_clean_class(out, "double")
 
@@ -302,11 +301,30 @@ sir_confidence_interval <- function(...,
   } else if (side %in% c("right", "r", "higher", "highest", "greater", "g", "max")) {
     out <- out[2]
   }
-  if (as_percent == TRUE) {
-    percentage(out, digits = 1)
-  } else {
-    out
+  if (isTRUE(as_percent)) {
+    out <- percentage(out, digits = 1)
   }
+  if (!isFALSE(collapse) && length(out) > 1) {
+    if (is.numeric(out)) {
+      out <- round(out, digits = 3)
+    }
+    out <- paste(out, collapse = ifelse(isTRUE(collapse), "-", collapse))
+  }
+
+  if (n < minimum) {
+    warning_("Introducing NA: ",
+      ifelse(n == 0, "no", paste("only", n)),
+      " results available for `sir_confidence_interval()` (`minimum` = ", minimum, ").",
+      call = FALSE
+    )
+    if (is.character(out)) {
+      return(NA_character_)
+    } else {
+      return(NA_real_)
+    }
+  }
+
+  out
 }
 
 #' @rdname proportion

R/random.R

@@ -83,6 +83,10 @@ random_disk <- function(size = NULL, mo = NULL, ab = NULL, ...) {
 #' @export
 random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
   meet_criteria(size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE, allow_NULL = TRUE)
+  if ("prob_RSI" %in% names(list(...))) {
+    deprecation_warning("prob_RSI", "prob_SIR", is_function = FALSE)
+    prob_SIR <- list(...)$prob_RSI
+  }
   meet_criteria(prob_SIR, allow_class = c("numeric", "integer"), has_length = 3)
   if (is.null(size)) {
     size <- NROW(get_current_data(arg_name = "size", call = -3))
@@ -91,7 +95,7 @@ random_sir <- function(size = NULL, prob_SIR = c(0.33, 0.33, 0.33), ...) {
 }
 
 random_exec <- function(type, size, mo = NULL, ab = NULL) {
-  df <- clinical_breakpoints %pm>%
+  df <- AMR::clinical_breakpoints %pm>%
     pm_filter(guideline %like% "EUCAST") %pm>%
     pm_arrange(pm_desc(guideline)) %pm>%
     subset(guideline == max(guideline) &

R/sir.R

@@ -300,7 +300,7 @@ is_sir_eligible <- function(x, threshold = 0.05) {
 #' @export
 # extra param: warn (logical, to never throw a warning)
 as.sir.default <- function(x, ...) {
-  if (is.sir(x)) {
+  if (inherits(x, "sir")) {
     return(x)
   }
 
@@ -775,7 +775,7 @@ as_sir_method <- function(method_short,
   } else {
     mo.bak <- mo
   }
-  # be sure to take current taxonomy, as the clinical_breakpoints data set only contains current taxonomy
+  # be sure to take current taxonomy, as the 'clinical_breakpoints' data set only contains current taxonomy
   mo <- suppressWarnings(suppressMessages(as.mo(mo, keep_synonyms = FALSE, inf0 = FALSE)))
   guideline_coerced <- get_guideline(guideline, reference_data)
   if (is.na(ab)) {
@@ -999,7 +999,7 @@ as_sir_method <- function(method_short,
       }
 
       if (method == "mic") {
-        new_sir <- quick_case_when(
+        new_sir <- case_when_AMR(
           is.na(values) ~ NA_sir_,
           values <= breakpoints_current$breakpoint_S ~ as.sir("S"),
           guideline_coerced %like% "EUCAST" & values > breakpoints_current$breakpoint_R ~ as.sir("R"),
@@ -1010,7 +1010,7 @@ as_sir_method <- function(method_short,
           TRUE ~ NA_sir_
         )
       } else if (method == "disk") {
-        new_sir <- quick_case_when(
+        new_sir <- case_when_AMR(
           is.na(values) ~ NA_sir_,
           as.double(values) >= as.double(breakpoints_current$breakpoint_S) ~ as.sir("S"),
           guideline_coerced %like% "EUCAST" & as.double(values) < as.double(breakpoints_current$breakpoint_R) ~ as.sir("R"),
@@ -1023,7 +1023,7 @@ as_sir_method <- function(method_short,
       }
 
       # write to verbose output
-      AMR_env$sir_interpretation_history <- rbind2(
+      AMR_env$sir_interpretation_history <- rbind_AMR(
         AMR_env$sir_interpretation_history,
         # recycling 1 to 2 rows does not seem to work, which is why rep() was added
         data.frame(

R/sir_calc.R

@@ -322,7 +322,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
           }
           out_new <- cbind(group_values, out_new)
         }
-        out <- rbind2(out, out_new)
+        out <- rbind_AMR(out, out_new)
       }
     }
     out
@@ -331,7 +331,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
   # based on pm_apply_grouped_function
   apply_group <- function(.data, fn, groups, drop = FALSE, ...) {
     grouped <- pm_split_into_groups(.data, groups, drop)
-    res <- do.call(rbind2, unname(lapply(grouped, fn, ...)))
+    res <- do.call(rbind_AMR, unname(lapply(grouped, fn, ...)))
     if (any(groups %in% colnames(res))) {
       class(res) <- c("grouped_data", class(res))
       res <- pm_set_groups(res, groups[groups %in% colnames(res)])

R/zz_deprecated.R

@@ -92,8 +92,7 @@ ggplot_rsi_predict <- function(...) {
 #' @export
 is.rsi <- function(...) {
   # REMINDER: change as.sir() to remove the deprecation warning there
-  deprecation_warning("is.rsi", "is.sir")
-  is.sir(...)
+  suppressWarnings(is.sir(...))
 }
 #' @rdname AMR-deprecated
 #' @export
@@ -190,21 +189,33 @@ summary.rsi <- summary.sir
 #' @export
 unique.rsi <- unique.sir
 
-# WHEN REMOVING RSI, DON'T FORGET TO REMOVE THE "rsi_df" CLASS FROM R/sir_calc.R
+# WHEN REMOVING RSI, DON'T FORGET TO REMOVE :
+# - THE "rsi_df" CLASS FROM R/sir_calc.R
+# - CODE CONTAINING only_rsi_columns, colours_RSI, include_untested_rsi, prob_RSI
 
-deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL) {
+deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL, is_function = TRUE) {
   if (is.null(old)) {
     warning_(extra_msg)
   } else {
     env <- paste0("deprecated_", old)
     if (!env %in% names(AMR_env)) {
       AMR_env[[paste0("deprecated_", old)]] <- 1
+      if (isTRUE(is_function)) {
+        old <- paste0(old, "()")
+        new <- paste0(new, "()")
+        type <- "function"
+      } else {
+        type <- "argument"
+      }
       warning_(
         ifelse(is.null(new),
-          paste0("The `", old, "()` function is no longer in use"),
-          paste0("The `", old, "()` function has been replaced with `", new, "()`")
+          paste0("The `", old, "` ", type, " is no longer in use"),
+          paste0("The `", old, "` ", type, " has been replaced with `", new, "`")
+        ),
+        ifelse(type == "argument",
+          ". While the old argument still works, it will be removed in a future version, so please update your code.",
+          ", see `?AMR-deprecated`."
         ),
-        ", see `?AMR-deprecated`.",
         ifelse(!is.null(extra_msg),
           paste0(" ", extra_msg),
           ""

R/zzz.R

@@ -128,6 +128,9 @@ if (utf8_supported && !is_latex) {
   s3_register("ggplot2::fortify", "sir")
   s3_register("ggplot2::fortify", "mic")
   s3_register("ggplot2::fortify", "disk")
+  # Support for knitr (R Markdown/Quarto)
+  s3_register("knitr::knit_print", "antibiogram")
+  s3_register("knitr::knit_print", "formatted_bug_drug_combinations")
   # Support vctrs package for use in e.g. dplyr verbs
   # S3: ab_selector
   s3_register("vctrs::vec_ptype2", "character.ab_selector")
@@ -192,7 +195,7 @@ if (utf8_supported && !is_latex) {
   # if custom ab option is available, load it
   if (!is.null(getOption("AMR_custom_ab")) && file.exists(getOption("AMR_custom_ab", default = ""))) {
     packageStartupMessage("Adding custom antimicrobials from '", getOption("AMR_custom_ab"), "'...", appendLF = FALSE)
-    x <- readRDS2(getOption("AMR_custom_ab"))
+    x <- readRDS_AMR(getOption("AMR_custom_ab"))
     tryCatch(
       {
         suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
@@ -204,7 +207,7 @@ if (utf8_supported && !is_latex) {
   # if custom mo option is available, load it
   if (!is.null(getOption("AMR_custom_mo")) && file.exists(getOption("AMR_custom_mo", default = ""))) {
     packageStartupMessage("Adding custom microorganisms from '", getOption("AMR_custom_mo"), "'...", appendLF = FALSE)
-    x <- readRDS2(getOption("AMR_custom_mo"))
+    x <- readRDS_AMR(getOption("AMR_custom_mo"))
     tryCatch(
       {
         suppressWarnings(suppressMessages(add_custom_microorganisms(x)))

README.md

@@ -27,26 +27,8 @@ install.packages("AMR")
 
 It will be downloaded and installed automatically. For RStudio, click on the menu *Tools* > *Install Packages...* and then type in "AMR" and press <kbd>Install</kbd>.
 
-### Copyright
+----
 
-This R package is licensed under the [GNU General Public License (GPL) v2.0](https://github.com/msberends/AMR/blob/main/LICENSE). In a nutshell, this means that this package:
-
-- May be used for commercial purposes
-
-- May be used for private purposes
-
-- May **not** be used for patent purposes
-
-- May be modified, although:
-
-  - Modifications **must** be released under the same license when distributing the package
-  - Changes made to the code **must** be documented
-
-- May be distributed, although:
-
-  - Source code **must** be made available when the package is distributed
-  - A copy of the license and copyright notice **must** be included with the package.
-
-- Comes with a LIMITATION of liability
-
-- Comes with NO warranty
+<small>
+This AMR package for R is free, open-source software and licensed under the [GNU General Public License v2.0 (GPL-2)](https://msberends.github.io/AMR/LICENSE-text.html). These requirements are consequently legally binding: modifications must be released under the same license when distributing the package, changes made to the code must be documented, source code must be made available when the package is distributed, and a copy of the license and copyright notice must be included with the package.
+</small>

_pkgdown.yml

@@ -76,9 +76,6 @@ navbar:
     - text: "How to"
       icon: "fa-question-circle"
       menu:
-      - text: "User- Or Team-specific Package Settings"
-        icon: "fa-gear"
-        href: "reference/AMR-options.html"
       - text: "Conduct AMR Analysis"
         icon: "fa-directions"
         href: "articles/AMR.html"
@@ -88,9 +85,12 @@ navbar:
       - text: "Predict Antimicrobial Resistance"
         icon: "fa-dice"
         href: "articles/resistance_predict.html"
-      - text: "Data Sets for Download / Own Use"
+      - text: "Download Data Sets for Own Use"
         icon: "fa-database"
         href: "articles/datasets.html"
+      - text: "Set User- Or Team-specific Package Settings"
+        icon: "fa-gear"
+        href: "reference/AMR-options.html"
       - text: "Conduct Principal Component Analysis for AMR"
         icon: "fa-compress"
         href: "articles/PCA.html"

cran-comments.md

@@ -1,2 +1,5 @@
-Extra release for fixing image options, as requested by CRAN team on 17 February 2022 (Kurt Hornik).
+As with all previous >20 releases, some CHECKs might return a NOTE for *just* hitting the installation size limit, though its size has been brought down to a minimum in collaboration with CRAN maintainers previously.
 
+We consider this a high-impact package: it was published in the Journal of Statistical Software (2022), is including in a CRAN Task View (Epidemiology), and is according to download stats used in almost all countries in the world. If there is anything to note, please let us know up-front without directly archiving the current version. That said, we continually unit test our package extensively and have no reason to assume that anything is wrong.
+
+Thanks for maintaining and hosting CRAN! It's empowering R and its use enormously!

data-raw/antibiograms.Rmd

@@ -2,7 +2,7 @@
 title: "Generating antibiograms with the AMR package"
 author: "AMR package developers"
 date: "`r Sys.Date()`"
-output: html_document
+output: pdf_document
 ---
 
 ```{r setup, include=FALSE}
@@ -22,35 +22,28 @@ example_isolates
 ### Traditional Antibiogram
 
 ```{r trad}
-print(
 antibiogram(example_isolates,
             antibiotics = c(aminoglycosides(), carbapenems()))
-)
 ```
 
 ### Combined Antibiogram
 
 ```{r comb}
-print(
 antibiogram(example_isolates,
             antibiotics = c("TZP", "TZP+TOB", "TZP+GEN"))
-)
 ```
 
 ### Syndromic Antibiogram
 
 ```{r synd}
-print(
 antibiogram(example_isolates,
              antibiotics = c(aminoglycosides(), carbapenems()),
              syndromic_group = "ward")
-)
 ```
 
 ### Weighted-Incidence Syndromic Combination Antibiogram (WISCA)
 
 ```{r wisca}
-print(
 antibiogram(example_isolates,
             antibiotics = c("AMC", "AMC+CIP", "TZP", "TZP+TOB"),
             mo_transform = "gramstain",
@@ -58,5 +51,4 @@ print(
             syndromic_group = ifelse(example_isolates$age >= 65 &
                                        example_isolates$gender == "M",
                                      "WISCA Group 1", "WISCA Group 2"))
-)
 ```

data-raw/antibiograms.html

@@ -11,7 +11,7 @@
 
 <meta name="author" content="AMR package developers" />
 
-<meta name="date" content="2023-02-18" />
+<meta name="date" content="2023-02-24" />
 
 <title>Generating antibiograms with the AMR package</title>
 
@@ -353,7 +353,7 @@ display: none;
 <h1 class="title toc-ignore">Generating antibiograms with the AMR
 package</h1>
 <h4 class="author">AMR package developers</h4>
-<h4 class="date">2023-02-18</h4>
+<h4 class="date">2023-02-24</h4>
 
 </div>
 
@@ -385,10 +385,8 @@ looks like:</p>
 ## #   CHL &lt;sir&gt;, COL &lt;sir&gt;, MUP &lt;sir&gt;, RIF &lt;sir&gt;</code></pre>
 <div id="traditional-antibiogram" class="section level3">
 <h3>Traditional Antibiogram</h3>
-<pre class="r"><code>print(
-  antibiogram(example_isolates,
-              antibiotics = c(aminoglycosides(), carbapenems()))
-)</code></pre>
+<pre class="r"><code>antibiogram(example_isolates,
+            antibiotics = c(aminoglycosides(), carbapenems()))</code></pre>
 <table>
 <thead>
 <tr class="header">
@@ -416,7 +414,7 @@ looks like:</p>
 <td align="right">100</td>
 <td align="right">98</td>
 <td align="right">100</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">97</td>
 </tr>
@@ -426,70 +424,70 @@ looks like:</p>
 <td align="right">0</td>
 <td align="right">100</td>
 <td align="right">0</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">0</td>
 </tr>
 <tr class="even">
 <td align="left"><em>K. pneumoniae</em> (0-58)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">90</td>
 <td align="right">100</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">90</td>
 </tr>
 <tr class="odd">
 <td align="left"><em>P. aeruginosa</em> (17-30)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">0</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 </tr>
 <tr class="even">
 <td align="left"><em>P. mirabilis</em> (0-34)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">94</td>
 <td align="right">94</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
 <td align="right">94</td>
 </tr>
 <tr class="odd">
 <td align="left"><em>S. aureus</em> (2-233)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">99</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 <td align="right">98</td>
 </tr>
 <tr class="even">
 <td align="left"><em>S. epidermidis</em> (8-163)</td>
 <td align="right">0</td>
 <td align="right">79</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">0</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">51</td>
 </tr>
 <tr class="odd">
 <td align="left"><em>S. hominis</em> (3-80)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">92</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 <td align="right">85</td>
 </tr>
 <tr class="even">
 <td align="left"><em>S. pneumoniae</em> (11-117)</td>
 <td align="right">0</td>
 <td align="right">0</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">0</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">0</td>
 </tr>
 </tbody>
@@ -497,10 +495,8 @@ looks like:</p>
 </div>
 <div id="combined-antibiogram" class="section level3">
 <h3>Combined Antibiogram</h3>
-<pre class="r"><code>print(
-  antibiogram(example_isolates,
-              antibiotics = c(&quot;TZP&quot;, &quot;TZP+TOB&quot;, &quot;TZP+GEN&quot;))
-)</code></pre>
+<pre class="r"><code>antibiogram(example_isolates,
+            antibiotics = c(&quot;TZP&quot;, &quot;TZP+TOB&quot;, &quot;TZP+GEN&quot;))</code></pre>
 <table>
 <thead>
 <tr class="header">
@@ -515,7 +511,7 @@ looks like:</p>
 <td align="left">CoNS (29-274)</td>
 <td align="right">30</td>
 <td align="right">97</td>
-<td align="right">NA</td>
+<td align="right"></td>
 </tr>
 <tr class="even">
 <td align="left"><em>E. coli</em> (416-461)</td>
@@ -531,31 +527,31 @@ looks like:</p>
 </tr>
 <tr class="even">
 <td align="left"><em>P. aeruginosa</em> (27-30)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">100</td>
 </tr>
 <tr class="odd">
 <td align="left"><em>P. mirabilis</em> (27-34)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">100</td>
 </tr>
 <tr class="even">
 <td align="left"><em>S. aureus</em> (7-231)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">100</td>
 </tr>
 <tr class="odd">
 <td align="left"><em>S. epidermidis</em> (5-128)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">100</td>
 </tr>
 <tr class="even">
 <td align="left"><em>S. hominis</em> (0-74)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">100</td>
 </tr>
@@ -570,15 +566,13 @@ looks like:</p>
 </div>
 <div id="syndromic-antibiogram" class="section level3">
 <h3>Syndromic Antibiogram</h3>
-<pre class="r"><code>print(
-  antibiogram(example_isolates,
+<pre class="r"><code>antibiogram(example_isolates,
              antibiotics = c(aminoglycosides(), carbapenems()),
-              syndromic_group = &quot;ward&quot;)
-)</code></pre>
+             syndromic_group = &quot;ward&quot;)</code></pre>
 <table>
 <colgroup>
-<col width="29%" />
-<col width="33%" />
+<col width="25%" />
+<col width="37%" />
 <col width="6%" />
 <col width="6%" />
 <col width="6%" />
@@ -602,141 +596,141 @@ looks like:</p>
 <tr class="odd">
 <td align="left">Clinical</td>
 <td align="left">CoNS (23-205)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">89</td>
 <td align="right">57</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">57</td>
 <td align="right">26</td>
 </tr>
 <tr class="even">
 <td align="left">ICU</td>
 <td align="left">CoNS (10-73)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">79</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 </tr>
 <tr class="odd">
 <td align="left">Outpatient</td>
 <td align="left">CoNS (3-31)</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">84</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 </tr>
 <tr class="even">
 <td align="left">Clinical</td>
-<td align="left">E. <em>coli</em> (0-299)</td>
+<td align="left"><em>E. coli</em> (0-299)</td>
 <td align="right">100</td>
 <td align="right">98</td>
 <td align="right">100</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">98</td>
 </tr>
 <tr class="odd">
 <td align="left">ICU</td>
-<td align="left">E. <em>coli</em> (0-137)</td>
+<td align="left"><em>E. coli</em> (0-137)</td>
 <td align="right">100</td>
 <td align="right">99</td>
 <td align="right">100</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">96</td>
 </tr>
 <tr class="even">
 <td align="left">Clinical</td>
-<td align="left">K. <em>pneumoniae</em> (0-51)</td>
-<td align="right">NA</td>
+<td align="left"><em>K. pneumoniae</em> (0-51)</td>
+<td align="right"></td>
 <td align="right">92</td>
 <td align="right">100</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">100</td>
 <td align="right">92</td>
 </tr>
 <tr class="odd">
 <td align="left">Clinical</td>
-<td align="left">P. <em>mirabilis</em> (0-30)</td>
-<td align="right">NA</td>
+<td align="left"><em>P. mirabilis</em> (0-30)</td>
+<td align="right"></td>
 <td align="right">100</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 <td align="right">100</td>
 </tr>
 <tr class="even">
 <td align="left">Clinical</td>
-<td align="left">S. <em>aureus</em> (2-150)</td>
-<td align="right">NA</td>
+<td align="left"><em>S. aureus</em> (2-150)</td>
+<td align="right"></td>
 <td align="right">99</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 <td align="right">97</td>
 </tr>
 <tr class="odd">
 <td align="left">ICU</td>
-<td align="left">S. <em>aureus</em> (0-66)</td>
-<td align="right">NA</td>
+<td align="left"><em>S. aureus</em> (0-66)</td>
+<td align="right"></td>
 <td align="right">100</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 </tr>
 <tr class="even">
 <td align="left">Clinical</td>
-<td align="left">S. <em>epidermidis</em> (4-79)</td>
-<td align="right">NA</td>
+<td align="left"><em>S. epidermidis</em> (4-79)</td>
+<td align="right"></td>
 <td align="right">82</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 <td align="right">55</td>
 </tr>
 <tr class="odd">
 <td align="left">ICU</td>
-<td align="left">S. <em>epidermidis</em> (4-75)</td>
-<td align="right">NA</td>
+<td align="left"><em>S. epidermidis</em> (4-75)</td>
+<td align="right"></td>
 <td align="right">72</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 <td align="right">41</td>
 </tr>
 <tr class="even">
 <td align="left">Clinical</td>
-<td align="left">S. <em>hominis</em> (1-45)</td>
-<td align="right">NA</td>
+<td align="left"><em>S. hominis</em> (1-45)</td>
+<td align="right"></td>
 <td align="right">96</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
-<td align="right">NA</td>
+<td align="right"></td>
+<td align="right"></td>
+<td align="right"></td>
 <td align="right">94</td>
 </tr>
 <tr class="odd">
 <td align="left">Clinical</td>
-<td align="left">S. <em>pneumoniae</em> (5-78)</td>
+<td align="left"><em>S. pneumoniae</em> (5-78)</td>
 <td align="right">0</td>
 <td align="right">0</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">0</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">0</td>
 </tr>
 <tr class="even">
 <td align="left">ICU</td>
-<td align="left">S. <em>pneumoniae</em> (5-30)</td>
+<td align="left"><em>S. pneumoniae</em> (5-30)</td>
 <td align="right">0</td>
 <td align="right">0</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">0</td>
-<td align="right">NA</td>
+<td align="right"></td>
 <td align="right">0</td>
 </tr>
 </tbody>
@@ -744,19 +738,17 @@ looks like:</p>
 </div>
 <div id="weighted-incidence-syndromic-combination-antibiogram-wisca" class="section level3">
 <h3>Weighted-Incidence Syndromic Combination Antibiogram (WISCA)</h3>
-<pre class="r"><code>print(
-  antibiogram(example_isolates,
+<pre class="r"><code>antibiogram(example_isolates,
             antibiotics = c(&quot;AMC&quot;, &quot;AMC+CIP&quot;, &quot;TZP&quot;, &quot;TZP+TOB&quot;),
             mo_transform = &quot;gramstain&quot;,
             minimum = 10, # this should be &gt;= 30, but now just as example
             syndromic_group = ifelse(example_isolates$age &gt;= 65 &amp;
                                        example_isolates$gender == &quot;M&quot;,
-                                       &quot;WISCA Group 1&quot;, &quot;WISCA Group 2&quot;))
-)</code></pre>
+                                     &quot;WISCA Group 1&quot;, &quot;WISCA Group 2&quot;))</code></pre>
 <table>
 <colgroup>
-<col width="24%" />
-<col width="34%" />
+<col width="23%" />
+<col width="35%" />
 <col width="5%" />
 <col width="14%" />
 <col width="5%" />

data-raw/microorganisms.md5

@@ -1 +1 @@
-b3734ad222d485de6923fc9957d8f2f5
+7846247d4113c4e8f550cfd2cb87467f

data-raw/microorganisms.txt

@@ -45279,7 +45279,7 @@
 "B_STNTR_INDC"	"Stenotrophomonas indicatrix"	"accepted"	"Bacteria"	"Pseudomonadota"	"Gammaproteobacteria"	"Lysobacterales"	"Lysobacteraceae"	"Stenotrophomonas"	"indicatrix"	""	"species"	"Weber et al., 2018"	"LPSN"	"797782"	"516670"		"10701219"			1.5	""
 "B_STNTR_KRNS"	"Stenotrophomonas koreensis"	"accepted"	"Bacteria"	"Pseudomonadota"	"Gammaproteobacteria"	"Lysobacterales"	"Lysobacteraceae"	"Stenotrophomonas"	"koreensis"	""	"species"	"Yang et al., 2006"	"LPSN"	"781248"	"516670"		"3222376"			1.5	""
 "B_STNTR_LCTT"	"Stenotrophomonas lactitubi"	"accepted"	"Bacteria"	"Pseudomonadota"	"Gammaproteobacteria"	"Lysobacterales"	"Lysobacteraceae"	"Stenotrophomonas"	"lactitubi"	""	"species"	"Weber et al., 2018"	"LPSN"	"797783"	"516670"		"10788780"			1.5	""
-"B_STNTR_MLTP"	"Stenotrophomonas maltophilia"	"synonym"	"Bacteria"	"Pseudomonadota"	"Gammaproteobacteria"	"Lysobacterales"	"Lysobacteraceae"	"Stenotrophomonas"	"maltophilia"	""	"species"	"Palleroni et al., 1993"	"LPSN"	"781249"	"516670"	"783141"	"10912104"			1	"113697002"
+"B_STNTR_MLTP"	"Stenotrophomonas maltophilia"	"accepted"	"Bacteria"	"Pseudomonadota"	"Gammaproteobacteria"	"Lysobacterales"	"Lysobacteraceae"	"Stenotrophomonas"	"maltophilia"	""	"species"	"Palleroni et al., 1993"	"LPSN"	"781249"	"516670"		"10912104"			1	"113697002"
 "B_STNTR_NTRT"	"Stenotrophomonas nitritireducens"	"accepted"	"Bacteria"	"Pseudomonadota"	"Gammaproteobacteria"	"Lysobacterales"	"Lysobacteraceae"	"Stenotrophomonas"	"nitritireducens"	""	"species"	"Finkmann et al., 2000"	"LPSN"	"781250"	"516670"		"3222370"			1.5	"416746005"
 "B_STNTR_PNCH"	"Stenotrophomonas panacihumi"	"accepted"	"Bacteria"	"Pseudomonadota"	"Gammaproteobacteria"	"Lysobacterales"	"Lysobacteraceae"	"Stenotrophomonas"	"panacihumi"	""	"species"	"Yi et al., 2010"	"GBIF"				"11141735"			1.5	""
 "B_STNTR_PAVN"	"Stenotrophomonas pavanii"	"accepted"	"Bacteria"	"Pseudomonadota"	"Gammaproteobacteria"	"Lysobacterales"	"Lysobacteraceae"	"Stenotrophomonas"	"pavanii"	""	"species"	"Ramos et al., 2011"	"LPSN"	"789171"	"516670"		"8102737"			1.5	"704977000"

data-raw/reproduction_of_clinical_breakpoints.R

@@ -95,8 +95,8 @@ new_mo_codes <- breakpoints %>%
 new_mo_codes %>%
   mutate(code = toupper(ORGANISM_CODE)) %>%
   rename(mo_new = mo) %>%
-  left_join(microorganisms.codes) %>%
-  filter(mo != mo_new)
+  left_join(microorganisms.codes %>% rename(mo_old = mo)) %>%
+  filter(mo_old != mo_new)
 
 microorganisms.codes <- microorganisms.codes %>%
   filter(!code %in% toupper(new_mo_codes$ORGANISM_CODE)) %>%

data-raw/reproduction_of_microorganisms.R

@@ -1357,19 +1357,29 @@ taxonomy <- taxonomy %>%
 
 # set class <mo>
 class(taxonomy$mo) <- c("mo", "character")
+microorganisms <- taxonomy
 
-### this was previously needed?? Since 2022 M. catarrhalis seems to be "accepted" again
-# # Moraxella catarrhalis was named Branhamella catarrhalis (Catlin, 1970), but this is unaccepted in clinical microbiology
-# # we keep them both
-# taxonomy$status[which(taxonomy$fullname == "Moraxella catarrhalis")]
-# taxonomy$lpsn_renamed_to[which(taxonomy$fullname == "Moraxella catarrhalis")]
-# taxonomy$status[which(taxonomy$fullname == "Moraxella catarrhalis")] <- "accepted"
-# taxonomy$lpsn_renamed_to[which(taxonomy$fullname == "Moraxella catarrhalis")] <- NA_character_
+
+# Restore 'synonym' microorganisms to 'accepted' --------------------------
+
+# according to LPSN: Stenotrophomonas maltophilia is the correct name if this species is regarded as a separate species (i.e., if its nomenclatural type is not assigned to another species whose name is validly published, legitimate and not rejected and has priority) within a separate genus Stenotrophomonas.
+# https://lpsn.dsmz.de/species/stenotrophomonas-maltophilia
+
+# all MO's to keep as 'accepted', not as 'synonym':
+to_restore <- c(
+  "Stenotrophomonas maltophilia",
+  "Moraxella catarrhalis"
+)
+all(to_restore %in% microorganisms$fullname)
+for (nm in to_restore) {
+  microorganisms$lpsn_renamed_to[which(microorganisms$fullname == nm)] <- NA
+  microorganisms$gbif_renamed_to[which(microorganisms$fullname == nm)] <- NA
+  microorganisms$status[which(microorganisms$fullname == nm)] <- "accepted"
+}
 
 
 # Save to package ---------------------------------------------------------
 
-microorganisms <- taxonomy
 usethis::use_data(microorganisms, overwrite = TRUE, version = 2, compress = "xz")
 rm(microorganisms)
 

data-raw/reproduction_of_poorman.R

@@ -107,3 +107,4 @@ contents <- c(
 writeLines(contents, "R/aa_helper_pm_functions.R")
 
 # note: pm_left_join() will be overwritten by aaa_helper_functions.R, which contains a faster implementation
+# replace `res <- as.data.frame(res)` with  `res <- as.data.frame(res, stringsAsFactors = FALSE)`

index.md

@@ -34,6 +34,8 @@ With the help of contributors from all corners of the world, the `AMR` package i
 
 #### Filtering and selecting data
 
+One of the most powerful functions of this package, aside from calculating and plotting AMR, is selecting and filtering based on antibiotic columns. This can be done using the so-called [antibiotic class selectors](https://msberends.github.io/AMR/reference/antibiotic_class_selectors.html) that work in base R, `dplyr` and `data.table`:
+
 ```r
 # AMR works great with dplyr, but it's not required or neccesary
 library(AMR)
@@ -41,8 +43,10 @@ library(dplyr)
 
 example_isolates %>%
   mutate(bacteria = mo_fullname()) %>%
+  # filtering functions for microorganisms:
   filter(mo_is_gram_negative(),
          mo_is_intrinsic_resistant(ab = "cefotax")) %>%
+  # antibiotic selectors:
   select(bacteria,
          aminoglycosides(),
          carbapenems())
@@ -66,19 +70,24 @@ With only having defined a row filter on Gram-negative bacteria with intrinsic r
 A base R equivalent would be:
 
 ```r
+library(AMR)
 example_isolates$bacteria <- mo_fullname(example_isolates$mo)
 example_isolates[which(mo_is_gram_negative() &
                          mo_is_intrinsic_resistant(ab = "cefotax")),
                  c("bacteria", aminoglycosides(), carbapenems())]
 ```
 
-This base R snippet will work in any version of R since April 2013 (R-3.0).
+This base R code will work in any version of R since April 2013 (R-3.0). Moreover, this code works identically with the `data.table` package, only by starting with:
+
+```r
+example_isolates <- data.table::as.data.table(example_isolates)
+```
 
 #### Generating antibiograms
 
 The `AMR` package supports generating traditional, combined, syndromic, and even weighted-incidence syndromic combination antibiograms (WISCA).
 
-If used inside R Markdown or Quarto, the table will be printed in the right output format automatically (such as markdown, LaTeX, HTML, etc.) when using `print()` on an antibiogram object.
+If used inside R Markdown or Quarto, the table will be printed in the right output format automatically (such as markdown, LaTeX, HTML, etc.).
 
 ```r
 antibiogram(example_isolates,
@@ -115,7 +124,7 @@ Like many other functions in this package, `antibiogram()` comes with support fo
 
 ```r
 antibiogram(example_isolates,
-            antibiotics = c("CIP", "TOB", "GEN"),
+            antibiotics = c("cipro", "tobra", "genta"), # any arbitrary name or code will work
             mo_transform = "gramstain",
             ab_transform = "name",
             language = "uk") # Ukrainian
@@ -131,6 +140,25 @@ antibiogram(example_isolates,
 
 For a manual approach, you can use the `resistance` or `susceptibility()` function:
 
+```r
+example_isolates %>%
+  # group by ward:
+  group_by(ward) %>%
+  # calculate AMR using resistance() for gentamicin and tobramycin
+  # and get their 95% confidence intervals using sir_confidence_interval():
+  summarise(across(c(GEN, TOB),
+                   list(total_R = resistance,
+                        conf_int = function(x) sir_confidence_interval(x, collapse = "-"))))
+```
+
+|ward       | GEN_total_R|GEN_conf_int | TOB_total_R|TOB_conf_int |
+|:---------:|:----------:|:-----------:|:----------:|:-----------:|
+|Clinical   |   0.229    |0.205-0.254  |   0.315    |0.284-0.347  |
+|ICU        |   0.290    |0.253-0.330  |   0.400    |0.353-0.449  |
+|Outpatient |   0.200    |0.131-0.285  |   0.368    |0.254-0.493  |
+
+Or use [antibiotic class selectors](https://msberends.github.io/AMR/reference/antibiotic_class_selectors.html) to select a series of antibiotic columns:
+
 ```r
 library(AMR)
 library(dplyr)
@@ -138,8 +166,7 @@ library(dplyr)
 out <- example_isolates %>%
   # group by ward:
   group_by(ward) %>%
-  # calculate AMR using resistance(), over all aminoglycosides
-  # and polymyxins:
+  # calculate AMR using resistance(), over all aminoglycosides and polymyxins:
   summarise(across(c(aminoglycosides(), polymyxins()),
             resistance))
 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/AMR.Rd

@@ -30,11 +30,11 @@ Welcome to the \code{AMR} package.
 
 The \code{AMR} package is a \href{https://msberends.github.io/AMR/#copyright}{free and open-source} R package with \href{https://en.wikipedia.org/wiki/Dependency_hell}{zero dependencies} to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. \strong{Our aim is to provide a standard} for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. \href{https://msberends.github.io/AMR/authors.html}{Many different researchers} from around the globe are continually helping us to make this a successful and durable project!
 
-This work was published in the Journal of Statistical Software (Volume 104(3); \href{https://doi.org/10.18637/jss.v104.i03}{DOI 10.18637/jss.v104.i03}) and formed the basis of two PhD theses (\href{https://doi.org/10.33612/diss.177417131}{DOI 10.33612/diss.177417131} and \href{https://doi.org/10.33612/diss.192486375}{DOI 10.33612/diss.192486375}).
+This work was published in the Journal of Statistical Software (Volume 104(3); \doi{jss.v104.i03}) and formed the basis of two PhD theses (\doi{10.33612/diss.177417131} and \doi{10.33612/diss.192486375}).
 
-After installing this package, R knows \href{https://msberends.github.io/AMR/reference/microorganisms.html}{\strong{~52 000}} (updated December 2022) and all \href{https://msberends.github.io/AMR/reference/antibiotics.html}{\strong{~600 antibiotic, antimycotic and antiviral drugs}} by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral breakpoint guidelines from CLSI and EUCAST are included from the last 10 years. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). \strong{It was designed to work in any setting, including those with very limited resources}. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the \href{https://www.rug.nl}{University of Groningen}, in collaboration with non-profit organisations \href{https://www.certe.nl}{Certe Medical Diagnostics and Advice Foundation} and \href{https://www.umcg.nl}{University Medical Center Groningen}.
+After installing this package, R knows \href{https://msberends.github.io/AMR/reference/microorganisms.html}{\strong{~52 000 microorganisms}} (updated December 2022) and all \href{https://msberends.github.io/AMR/reference/antibiotics.html}{\strong{~600 antibiotic, antimycotic and antiviral drugs}} by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral breakpoint guidelines from CLSI and EUCAST are included from the last 10 years. It supports and can read any data format, including WHONET data. This package works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). \strong{It was designed to work in any setting, including those with very limited resources}. It was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the \href{https://www.rug.nl}{University of Groningen}, in collaboration with non-profit organisations \href{https://www.certe.nl}{Certe Medical Diagnostics and Advice Foundation} and \href{https://www.umcg.nl}{University Medical Center Groningen}.
 
-The \code{AMR} package is available in English, Chinese, Danish, Dutch, French, German, Greek, Italian, Japanese, Polish, Portuguese, Russian, Spanish, Swedish, Turkish and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
+The \code{AMR} package is available in English, Chinese, Czech, Danish, Dutch, Finnish, French, German, Greek, Italian, Japanese, Norwegian, Polish, Portuguese, Romanian, Russian, Spanish, Swedish, Turkish, and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
 }
 \section{Reference Data Publicly Available}{
 

man/WHONET.Rd

@@ -39,7 +39,7 @@ A \link[tibble:tibble]{tibble} with 500 observations and 53 variables:
 WHONET
 }
 \description{
-This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are from our \link{example_isolates} data set. All patient names are created using online surname generators and are only in place for practice purposes.
+This example data set has the exact same structure as an export file from WHONET. Such files can be used with this package, as this example data set shows. The antibiotic results are from our \link{example_isolates} data set. All patient names were created using online surname generators and are only in place for practice purposes.
 }
 \details{
 Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.

man/add_custom_antimicrobials.Rd

@@ -18,7 +18,7 @@ With \code{\link[=add_custom_antimicrobials]{add_custom_antimicrobials()}} you c
 \details{
 \strong{Important:} Due to how \R works, the \code{\link[=add_custom_antimicrobials]{add_custom_antimicrobials()}} function has to be run in every \R session - added antimicrobials are not stored between sessions and are thus lost when \R is exited.
 
-There are two ways to automate this process:
+There are two ways to circumvent this and automate the process of adding antimicrobials:
 
 \strong{Method 1:} Using the \link[=AMR-options]{package option} \code{\link[=AMR-options]{AMR_custom_ab}}, which is the preferred method. To use this method:
 \enumerate{
@@ -32,7 +32,7 @@ options(AMR_custom_ab = "~/my_custom_ab.rds")
 Upon package load, this file will be loaded and run through the \code{\link[=add_custom_antimicrobials]{add_custom_antimicrobials()}} function.
 }
 
-\strong{Method 2:} Loading the antimicrobial additions directly from your \code{.Rprofile} file. An important downside is that this requires the \code{AMR} package to be installed or else this method will fail. To use this method:
+\strong{Method 2:} Loading the antimicrobial additions directly from your \code{.Rprofile} file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method:
 \enumerate{
 \item Edit the \code{.Rprofile} file using e.g. \code{utils::file.edit("~/.Rprofile")}.
 \item Add a text like below and save the file:

man/add_custom_microorganisms.Rd

@@ -20,7 +20,7 @@ This function will fill in missing taxonomy for you, if specific taxonomic colum
 
 \strong{Important:} Due to how \R works, the \code{\link[=add_custom_microorganisms]{add_custom_microorganisms()}} function has to be run in every \R session - added microorganisms are not stored between sessions and are thus lost when \R is exited.
 
-There are two ways to automate this process:
+There are two ways to circumvent this and automate the process of adding microorganisms:
 
 \strong{Method 1:} Using the \link[=AMR-options]{package option} \code{\link[=AMR-options]{AMR_custom_mo}}, which is the preferred method. To use this method:
 \enumerate{
@@ -34,7 +34,7 @@ options(AMR_custom_mo = "~/my_custom_mo.rds")
 Upon package load, this file will be loaded and run through the \code{\link[=add_custom_microorganisms]{add_custom_microorganisms()}} function.
 }
 
-\strong{Method 2:} Loading the microorganism directly from your \code{.Rprofile} file. An important downside is that this requires the \code{AMR} package to be installed or else this method will fail. To use this method:
+\strong{Method 2:} Loading the microorganism directly from your \code{.Rprofile} file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method:
 \enumerate{
 \item Edit the \code{.Rprofile} file using e.g. \code{utils::file.edit("~/.Rprofile")}.
 \item Add a text like below and save the file:
@@ -47,7 +47,7 @@ Upon package load, this file will be loaded and run through the \code{\link[=add
 }\if{html}{\out{</div>}}
 }
 
-Use \code{\link[=clear_custom_microorganisms]{clear_custom_microorganisms()}} to clear the previously added antimicrobials.
+Use \code{\link[=clear_custom_microorganisms]{clear_custom_microorganisms()}} to clear the previously added microorganisms.
 }
 \examples{
 \donttest{

man/antibiogram.Rd

@@ -4,7 +4,7 @@
 \alias{antibiogram}
 \alias{plot.antibiogram}
 \alias{autoplot.antibiogram}
-\alias{print.antibiogram}
+\alias{knit_print.antibiogram}
 \title{Generate Antibiogram: Traditional, Combined, Syndromic, or Weighted-Incidence Syndromic Combination (WISCA)}
 \source{
 \itemize{
@@ -35,9 +35,8 @@ antibiogram(
 
 \method{autoplot}{antibiogram}(object, ...)
 
-\method{print}{antibiogram}(
+\method{knit_print}{antibiogram}(
   x,
-  as_kable = !interactive(),
   italicise = TRUE,
   na = getOption("knitr.kable.NA", default = ""),
   ...
@@ -46,7 +45,7 @@ antibiogram(
 \arguments{
 \item{x}{a \link{data.frame} containing at least a column with microorganisms and columns with antibiotic results (class 'sir', see \code{\link[=as.sir]{as.sir()}})}
 
-\item{antibiotics}{vector of column names, or (any combinations of) \link[=antibiotic_class_selectors]{antibiotic selectors} such as \code{\link[=aminoglycosides]{aminoglycosides()}} or \code{\link[=carbapenems]{carbapenems()}}. For combination antibiograms, this can also be column names separated with \code{"+"}, such as "TZP+TOB" given that the data set contains columns "TZP" and "TOB". See \emph{Examples}.}
+\item{antibiotics}{vector of any antibiotic name or code (will be evaluated with \code{\link[=as.ab]{as.ab()}}, column name of \code{x}, or (any combinations of) \link[=antibiotic_class_selectors]{antibiotic selectors} such as \code{\link[=aminoglycosides]{aminoglycosides()}} or \code{\link[=carbapenems]{carbapenems()}}. For combination antibiograms, this can also be set to values separated with \code{"+"}, such as "TZP+TOB" or "cipro + genta", given that columns resembling such antibiotics exist in \code{x}. See \emph{Examples}.}
 
 \item{mo_transform}{a character to transform microorganism input - must be "name", "shortname", "gramstain", or one of the column names of the \link{microorganisms} data set: "mo", "fullname", "status", "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies", "rank", "ref", "source", "lpsn", "lpsn_parent", "lpsn_renamed_to", "gbif", "gbif_parent", "gbif_renamed_to", "prevalence", or "snomed". Can also be \code{NULL} to not transform the input.}
 
@@ -72,15 +71,13 @@ antibiogram(
 
 \item{info}{a \link{logical} to indicate info should be printed - the default is \code{TRUE} only in interactive mode}
 
-\item{...}{when used in \code{\link[=print]{print()}}: arguments passed on to \code{\link[knitr:kable]{knitr::kable()}} (otherwise, has no use)}
+\item{...}{when used in \link[knitr:kable]{R Markdown or Quarto}: arguments passed on to \code{\link[knitr:kable]{knitr::kable()}} (otherwise, has no use)}
 
 \item{object}{an \code{\link[=antibiogram]{antibiogram()}} object}
 
-\item{as_kable}{a \link{logical} to indicate whether the printing should be done using \code{\link[knitr:kable]{knitr::kable()}} (which is the default in non-interactive sessions)}
+\item{italicise}{a \link{logical} to indicate whether the microorganism names in the \link[knitr:kable]{knitr} table should be made italic, using \code{\link[=italicise_taxonomy]{italicise_taxonomy()}}.}
 
-\item{italicise}{(only when \code{as_kable = TRUE}) a \link{logical} to indicate whether the microorganism names in the output table should be made italic, using \code{\link[=italicise_taxonomy]{italicise_taxonomy()}}. This only works when the output format is markdown, such as in HTML output.}
-
-\item{na}{(only when \code{as_kable = TRUE}) character to use for showing \code{NA} values}
+\item{na}{character to use for showing \code{NA} values}
 }
 \description{
 Generate an antibiogram, and communicate the results in plots or tables. These functions follow the logic of Klinker \emph{et al.} and Barbieri \emph{et al.} (see \emph{Source}), and allow reporting in e.g. R Markdown and Quarto as well.
@@ -90,6 +87,9 @@ This function returns a table with values between 0 and 100 for \emph{susceptibi
 
 \strong{Remember that you should filter your data to let it contain only first isolates!} This is needed to exclude duplicates and to reduce selection bias. Use \code{\link[=first_isolate]{first_isolate()}} to determine them in your data set with one of the four available algorithms.
 
+All types of antibiograms as listed below can be plotted (using \code{\link[ggplot2:autoplot]{ggplot2::autoplot()}} or base \R \code{\link[=plot]{plot()}}/\code{\link[=barplot]{barplot()}}). The \code{antibiogram} object can also be used directly in R Markdown / Quarto (i.e., \code{knitr}) for reports. In this case, \code{\link[knitr:kable]{knitr::kable()}} will be applied automatically and microorganism names will even be printed in italics at default (see argument \code{italicise}). You can also use functions from specific 'table reporting' packages to transform the output of \code{\link[=antibiogram]{antibiogram()}} to your needs, e.g. with \code{flextable::as_flextable()} or \code{gt::gt()}.
+\subsection{Antibiogram Types}{
+
 There are four antibiogram types, as proposed by Klinker \emph{et al.} (2021, \doi{10.1177/20499361211011373}), and they are all supported by \code{\link[=antibiogram]{antibiogram()}}:
 \enumerate{
 \item \strong{Traditional Antibiogram}
@@ -137,8 +137,6 @@ your_data \%>\%
 }\if{html}{\out{</div>}}
 }
 
-All types of antibiograms can be generated with the functions as described on this page, and can be plotted (using \code{\link[ggplot2:autoplot]{ggplot2::autoplot()}} or base \R \code{\link[=plot]{plot()}}/\code{\link[=barplot]{barplot()}}) or printed into R Markdown / Quarto formats for reports using \code{print()}. Use functions from specific 'table reporting' packages to transform the output of \code{\link[=antibiogram]{antibiogram()}} to your needs, e.g. \code{flextable::as_flextable()} or \code{gt::gt()}.
-
 Note that for combination antibiograms, it is important to realise that susceptibility can be calculated in two ways, which can be set with the \code{only_all_tested} argument (default is \code{FALSE}). See this example for two antibiotics, Drug A and Drug B, about how \code{\link[=antibiogram]{antibiogram()}} works to calculate the \%SI:
 
 \if{html}{\out{<div class="sourceCode">}}\preformatted{--------------------------------------------------------------------
@@ -158,8 +156,7 @@ Note that for combination antibiograms, it is important to realise that suscepti
   <NA>      <NA>        -            -            -            -
 --------------------------------------------------------------------
 }\if{html}{\out{</div>}}
-
-Printing the antibiogram in non-interactive sessions will be done by \code{\link[knitr:kable]{knitr::kable()}}, with support for \link[knitr:kable]{all their implemented formats}, such as "markdown". The knitr format will be automatically determined if printed inside a knitr document (LaTeX, HTML, etc.).
+}
 }
 \examples{
 # example_isolates is a data set available in the AMR package.
@@ -194,8 +191,9 @@ antibiogram(example_isolates,
   mo_transform = "gramstain"
 )
 
+# names of antibiotics do not need to resemble columns exactly:
 antibiogram(example_isolates,
-  antibiotics = c("TZP", "TZP+TOB"),
+  antibiotics = c("Cipro", "cipro + genta"),
   mo_transform = "gramstain",
   ab_transform = "name",
   sep = " & "
@@ -238,14 +236,19 @@ antibiogram(example_isolates,
   )
 )
 
+
 # Print the output for R Markdown / Quarto -----------------------------
 
 ureido <- antibiogram(example_isolates,
   antibiotics = ureidopenicillins(),
-                      ab_transform = "name")
+  ab_transform = "name"
+)
 
-# in an Rmd file, you would just need print(ureido), but to be explicit:
-print(ureido, as_kable = TRUE, format = "markdown", italicise = TRUE)
+# in an Rmd file, you would just need to return `ureido` in a chunk,
+# but to be explicit here:
+if (requireNamespace("knitr")) {
+  knitr::knit_print(ureido)
+}
 
 
 # Generate plots with ggplot2 or base R --------------------------------
@@ -269,6 +272,5 @@ if (requireNamespace("ggplot2")) {
 
 plot(ab1)
 plot(ab2)
-
 }
 }

man/antibiotic_class_selectors.Rd

@@ -118,10 +118,12 @@ not_intrinsic_resistant(
 (internally) a \link{character} vector of column names, with additional class \code{"ab_selector"}
 }
 \description{
-These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group, without the need to define the columns or antibiotic abbreviations. In short, if you have a column name that resembles an antimicrobial drug, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "CZO" and "J01DB04" will all be picked up by \code{\link[=cephalosporins]{cephalosporins()}}.
+These functions allow for filtering rows and selecting columns based on antibiotic test results that are of a specific antibiotic class or group (according to the \link{antibiotics} data set), without the need to define the columns or antibiotic abbreviations.
+
+In short, if you have a column name that resembles an antimicrobial drug, it will be picked up by any of these functions that matches its pharmaceutical class: "cefazolin", "kefzol", "CZO" and "J01DB04" will all be picked up by \code{\link[=cephalosporins]{cephalosporins()}}.
 }
 \details{
-These functions can be used in data set calls for selecting columns and filtering rows. They are heavily inspired by the \link[tidyselect:language]{Tidyverse selection helpers} such as \code{\link[tidyselect:everything]{everything()}}, but also work in base \R and not only in \code{dplyr} verbs. Nonetheless, they are very convenient to use with \code{dplyr} functions such as \code{\link[dplyr:select]{select()}}, \code{\link[dplyr:filter]{filter()}} and \code{\link[dplyr:summarise]{summarise()}}, see \emph{Examples}.
+These functions can be used in data set calls for selecting columns and filtering rows. They work with base \R, the Tidyverse, and \code{data.table}. They are heavily inspired by the \link[tidyselect:language]{Tidyverse selection helpers} such as \code{\link[tidyselect:everything]{everything()}}, but are not limited to \code{dplyr} verbs. Nonetheless, they are very convenient to use with \code{dplyr} functions such as \code{\link[dplyr:select]{select()}}, \code{\link[dplyr:filter]{filter()}} and \code{\link[dplyr:summarise]{summarise()}}, see \emph{Examples}.
 
 All columns in the data in which these functions are called will be searched for known antibiotic names, abbreviations, brand names, and codes (ATC, EARS-Net, WHO, etc.) according to the \link{antibiotics} data set. This means that a selector such as \code{\link[=aminoglycosides]{aminoglycosides()}} will pick up column names like 'gen', 'genta', 'J01GB03', 'tobra', 'Tobracin', etc.
 
@@ -174,6 +176,10 @@ All data sets in this \code{AMR} package (about microorganisms, antibiotics, SIR
 # See ?example_isolates.
 example_isolates
 
+
+# Examples sections below are split into 'base R', 'dplyr', and 'data.table':
+
+
 # base R ------------------------------------------------------------------
 
 # select columns 'IPM' (imipenem) and 'MEM' (meropenem)
@@ -196,7 +202,7 @@ example_isolates[all(carbapenems()), ]
 # filter with multiple antibiotic selectors using c()
 example_isolates[all(c(carbapenems(), aminoglycosides()) == "R"), ]
 
-# filter + select in one go: get penicillins in carbapenems-resistant strains
+# filter + select in one go: get penicillins in carbapenem-resistant strains
 example_isolates[any(carbapenems() == "R"), penicillins()]
 
 # You can combine selectors with '&' to be more specific. For example,
@@ -206,13 +212,19 @@ example_isolates[any(carbapenems() == "R"), penicillins()]
 # and erythromycin is not a penicillin:
 example_isolates[, penicillins() & administrable_per_os()]
 
-# ab_selector() applies a filter in the `antibiotics` data set and is thus very
-# flexible. For instance, to select antibiotic columns with an oral DDD of at
-# least 1 gram:
+# ab_selector() applies a filter in the `antibiotics` data set and is thus
+# very flexible. For instance, to select antibiotic columns with an oral DDD
+# of at least 1 gram:
 example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
 
-# dplyr -------------------------------------------------------------------
 \donttest{
+# dplyr -------------------------------------------------------------------
+
+if (require("dplyr")) {
+  tibble(kefzol = random_sir(5)) \%>\%
+    select(cephalosporins())
+}
+
 if (require("dplyr")) {
   # get AMR for all aminoglycosides e.g., per ward:
   example_isolates \%>\%
@@ -287,11 +299,44 @@ if (require("dplyr")) {
     select(penicillins()) # only the 'J01CA01' column will be selected
 }
 if (require("dplyr")) {
-  # with recent versions of dplyr this is all equal:
+  # with recent versions of dplyr, this is all equal:
   x <- example_isolates[carbapenems() == "R", ]
   y <- example_isolates \%>\% filter(carbapenems() == "R")
   z <- example_isolates \%>\% filter(if_all(carbapenems(), ~ .x == "R"))
   identical(x, y) && identical(y, z)
 }
+
+
+# data.table --------------------------------------------------------------
+
+# data.table is supported as well, just use it in the same way as with
+# base R, but add `with = FALSE` if using a single AB selector.
+
+if (require("data.table")) {
+  dt <- as.data.table(example_isolates)
+
+  # this does not work, it returns column *names*
+  dt[, carbapenems()]
+}
+if (require("data.table")) {
+  # so `with = FALSE` is required
+  dt[, carbapenems(), with = FALSE]
+}
+
+# for multiple selections or AB selectors, `with = FALSE` is not needed:
+if (require("data.table")) {
+  dt[, c("mo", aminoglycosides())]
+}
+if (require("data.table")) {
+  dt[, c(carbapenems(), aminoglycosides())]
+}
+
+# row filters are also supported:
+if (require("data.table")) {
+  dt[any(carbapenems() == "S"), ]
+}
+if (require("data.table")) {
+  dt[any(carbapenems() == "S"), penicillins(), with = FALSE]
+}
 }
 }

man/bug_drug_combinations.Rd

@@ -55,7 +55,7 @@ The function \code{\link[=bug_drug_combinations]{bug_drug_combinations()}} retur
 Determine antimicrobial resistance (AMR) of all bug-drug combinations in your data set where at least 30 (default) isolates are available per species. Use \code{\link[=format]{format()}} on the result to prettify it to a publishable/printable format, see \emph{Examples}.
 }
 \details{
-The function \code{\link[=format]{format()}} calculates the resistance per bug-drug combination. Use \code{combine_SI = TRUE} (default) to test R vs. S+I and \code{combine_SI = FALSE} to test R+I vs. S.
+The function \code{\link[=format]{format()}} calculates the resistance per bug-drug combination and returns a table ready for reporting/publishing. Use \code{combine_SI = TRUE} (default) to test R vs. S+I and \code{combine_SI = FALSE} to test R+I vs. S. This table can also directly be used in R Markdown / Quarto without the need for e.g. \code{\link[knitr:kable]{knitr::kable()}}.
 }
 \examples{
 # example_isolates is a data set available in the AMR package.

man/get_episode.Rd

@@ -3,16 +3,18 @@
 \name{get_episode}
 \alias{get_episode}
 \alias{is_new_episode}
-\title{Determine (Clinical) Episodes}
+\title{Determine Clinical or Epidemic Episodes}
 \usage{
-get_episode(x, episode_days, ...)
+get_episode(x, episode_days = NULL, case_free_days = NULL, ...)
 
-is_new_episode(x, episode_days, ...)
+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}{required 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}{(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}
 }
@@ -23,11 +25,49 @@ is_new_episode(x, episode_days, ...)
 }
 }
 \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, and is thus equal to \code{!duplicated(get_episode(...))}.
+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{
-The functions \code{\link[=get_episode]{get_episode()}} and \code{\link[=is_new_episode]{is_new_episode()}} differ in this way when setting \code{episode_days} to 365:\tabular{cccc}{
-   person_id \tab date \tab \code{get_episode()} \tab \code{is_new_episode()} \cr
+Episodes can be determined in two ways: absolute and relative.
+\enumerate{
+\item Absolute
+
+This method uses \code{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 \emph{S. aureus} bacteraemia in ICU patients for example. The episode length could then be 30 days, so that new \emph{S. aureus} isolates after an ICU episode of 30 days will be considered a different (or new) episode.
+
+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 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}.
+}
+
+In a table:\tabular{ccc}{
+   Date \tab Using \code{episode_days = 7} \tab Using \code{case_free_days = 7} \cr
+   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** \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
+   2023-03-01 \tab 4 \tab 2 \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
+*** 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.
+
+The \code{\link[=is_new_episode]{is_new_episode()}} function on the other hand, returns \code{TRUE} for every new \code{\link[=get_episode]{get_episode()}} index.
+
+To specify, when setting \code{episode_days = 365} (using method 1 as explained above), this is how the two functions differ:\tabular{cccc}{
+   patient \tab date \tab \code{get_episode()} \tab \code{is_new_episode()} \cr
    A \tab 2019-01-01 \tab 1 \tab TRUE \cr
    A \tab 2019-03-01 \tab 1 \tab FALSE \cr
    A \tab 2021-01-01 \tab 2 \tab TRUE \cr
@@ -36,14 +76,34 @@ The functions \code{\link[=get_episode]{get_episode()}} and \code{\link[=is_new_
    C \tab 2020-01-01 \tab 1 \tab TRUE \cr
 }
 
+}
 
-Dates are first sorted from old to new. The oldest date will mark the start of the first episode. After this date, the next date will be marked that is at least \code{episode_days} days later than the start of the first episode. From that second marked date on, the next date will be marked that is at least \code{episode_days} days later than the start of the second episode which will be the start of the third episode, and so on. Before the vector is being returned, the original order will be restored.
+\subsection{Other}{
 
 The \code{\link[=first_isolate]{first_isolate()}} function is a wrapper around the \code{\link[=is_new_episode]{is_new_episode()}} function, but is more efficient for data sets containing microorganism codes or names and allows for different isolate selection methods.
 
 The \code{dplyr} package is not required for these functions to work, but these episode functions do support \link[dplyr:group_by]{variable grouping} and work conveniently inside \code{dplyr} verbs such as \code{\link[dplyr:filter]{filter()}}, \code{\link[dplyr:mutate]{mutate()}} and \code{\link[dplyr:summarise]{summarise()}}.
 }
+}
 \examples{
+# difference between absolute and relative determination of episodes:
+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)
+x
+
+
 # `example_isolates` is a data set available in the AMR package.
 # See ?example_isolates
 df <- example_isolates[sample(seq_len(2000), size = 100), ]

man/plot.Rd

@@ -19,8 +19,8 @@
   ab = NULL,
   guideline = "EUCAST",
   main = deparse(substitute(x)),
-  ylab = "Frequency",
-  xlab = "Minimum Inhibitory Concentration (mg/L)",
+  ylab = translate_AMR("Frequency", language = language),
+  xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
   colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   language = get_AMR_locale(),
   expand = TRUE,
@@ -33,8 +33,8 @@
   ab = NULL,
   guideline = "EUCAST",
   title = deparse(substitute(object)),
-  ylab = "Frequency",
-  xlab = "Minimum Inhibitory Concentration (mg/L)",
+  ylab = translate_AMR("Frequency", language = language),
+  xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
   colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   language = get_AMR_locale(),
   expand = TRUE,
@@ -46,8 +46,8 @@
 \method{plot}{disk}(
   x,
   main = deparse(substitute(x)),
-  ylab = "Frequency",
-  xlab = "Disk diffusion diameter (mm)",
+  ylab = translate_AMR("Frequency", language = language),
+  xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
   mo = NULL,
   ab = NULL,
   guideline = "EUCAST",
@@ -62,8 +62,8 @@
   mo = NULL,
   ab = NULL,
   title = deparse(substitute(object)),
-  ylab = "Frequency",
-  xlab = "Disk diffusion diameter (mm)",
+  ylab = translate_AMR("Frequency", language = language),
+  xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
   guideline = "EUCAST",
   colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   language = get_AMR_locale(),
@@ -75,8 +75,8 @@
 
 \method{plot}{sir}(
   x,
-  ylab = "Percentage",
-  xlab = "Antimicrobial Interpretation",
+  ylab = translate_AMR("Percentage", language = language),
+  xlab = translate_AMR("Antimicrobial Interpretation", language = language),
   main = deparse(substitute(x)),
   language = get_AMR_locale(),
   ...
@@ -85,8 +85,8 @@
 \method{autoplot}{sir}(
   object,
   title = deparse(substitute(object)),
-  xlab = "Antimicrobial Interpretation",
-  ylab = "Frequency",
+  xlab = translate_AMR("Antimicrobial Interpretation", language = language),
+  ylab = translate_AMR("Frequency", language = language),
   colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
   language = get_AMR_locale(),
   ...

man/proportion.Rd

@@ -29,7 +29,8 @@ sir_confidence_interval(
   as_percent = FALSE,
   only_all_tested = FALSE,
   confidence_level = 0.95,
-  side = "both"
+  side = "both",
+  collapse = FALSE
 )
 
 proportion_R(..., minimum = 30, as_percent = FALSE, only_all_tested = FALSE)
@@ -77,6 +78,8 @@ sir_df(
 
 \item{side}{the side of the confidence interval to return. The default is \code{"both"} for a length 2 vector, but can also be (abbreviated as) \code{"min"}/\code{"left"}/\code{"lower"}/\code{"less"} or \code{"max"}/\code{"right"}/\code{"higher"}/\code{"greater"}.}
 
+\item{collapse}{a \link{logical} to indicate whether the output values should be 'collapsed', i.e. be merged together into one value, or a character value to use for collapsing}
+
 \item{data}{a \link{data.frame} containing columns with class \code{\link{sir}} (see \code{\link[=as.sir]{as.sir()}})}
 
 \item{translate_ab}{a column name of the \link{antibiotics} data set to translate the antibiotic abbreviations to, using \code{\link[=ab_property]{ab_property()}}}
@@ -172,6 +175,10 @@ sir_confidence_interval(example_isolates$AMX)
 sir_confidence_interval(example_isolates$AMX,
   confidence_level = 0.975
 )
+sir_confidence_interval(example_isolates$AMX,
+  confidence_level = 0.975,
+  collapse = ", "
+)
 
 # determines \%S+I:
 susceptibility(example_isolates$AMX)

vignettes/AMR.Rmd

@@ -28,7 +28,7 @@ knitr::opts_chunk$set(
 
 Conducting AMR data analysis unfortunately requires in-depth knowledge from different scientific fields, which makes it hard to do right. At least, it requires:
 
-* Good questions (always start with those!)
+* Good questions (always start with those!) and reliable data
 * A thorough understanding of (clinical) epidemiology, to understand the clinical and epidemiological relevance and possible bias of results
 * A thorough understanding of (clinical) microbiology/infectious diseases, to understand which microorganisms are causal to which infections and the implications of pharmaceutical treatment, as well as understanding intrinsic and acquired microbial resistance
 * Experience with data analysis with microbiological tests and their results, to understand the determination and limitations of MIC values and their interpretations to SIR values
@@ -60,6 +60,7 @@ knitr::kable(
 ``` 
 
 ## Needed R packages
+
 As with many uses in R, we need some additional packages for AMR data analysis. Our package works closely together with the [tidyverse packages](https://www.tidyverse.org) [`dplyr`](https://dplyr.tidyverse.org/) and [`ggplot2`](https://ggplot2.tidyverse.org) by RStudio. The tidyverse tremendously improves the way we conduct data science - it allows for a very natural way of writing syntaxes and creating beautiful plots in R.
 
 We will also use the `cleaner` package, that can be used for cleaning data and creating frequency tables.
@@ -68,156 +69,93 @@ We will also use the `cleaner` package, that can be used for cleaning data and c
 library(dplyr)
 library(ggplot2)
 library(AMR)
-library(cleaner)
 
 # (if not yet installed, install with:)
-# install.packages(c("dplyr", "ggplot2", "AMR", "cleaner"))
+# install.packages(c("dplyr", "ggplot2", "AMR"))
 ```
 
-# Creation of data
-We will create some fake example data to use for analysis. For AMR data analysis, we need at least: a patient ID, name or code of a microorganism, a date and antimicrobial results (an antibiogram). It could also include a specimen type (e.g. to filter on blood or urine), the ward type (e.g. to filter on ICUs). 
+The `AMR` package contains a data set `example_isolates_unclean`, which might look data that users have extracted from their laboratory systems:
 
-With additional columns (like a hospital name, the patients gender of even [well-defined] clinical properties) you can do a comparative analysis, as this tutorial will demonstrate too.
+```{r}
+example_isolates_unclean
 
-## Patients
-To start with patients, we need a unique list of patients. 
-
-```{r create patients}
-patients <- unlist(lapply(LETTERS, paste0, 1:10))
+# we will use 'our_data' as the data set name for this tutorial
+our_data <- example_isolates_unclean
 ```
 
-The `LETTERS` object is available in R - it's a vector with 26 characters: `A` to `Z`. The `patients` object we just created is now a vector of length `r length(patients)`, with values (patient IDs) varying from ``r patients[1]`` to ``r patients[length(patients)]``. Now we we also set the gender of our patients, by putting the ID and the gender in a table:
+For AMR data analysis, we would like the microorganism column to contain valid, up-to-date taxonomy, and the antibiotic columns to be cleaned as SIR values as well.
 
-```{r create gender}
-patients_table <- data.frame(
-  patient_id = patients,
-  gender = c(
-    rep("M", 135),
-    rep("F", 125)
-  )
-)
+## Taxonomy of microorganisms
+
+With `as.mo()`, users can transform arbitrary microorganism names or codes to current taxonomy. The `AMR` package contains up-to-date taxonomic data. To be specific, currently included data were retrieved on `r format(AMR:::TAXONOMY_VERSION$LPSN$accessed_date, "%d %b %Y")`. 
+
+The codes of the AMR packages that come from `as.mo()` are short, but still human readable. More importantly, `as.mo()`  supports all kinds of input:
+
+```{r, message = FALSE}
+as.mo("Klebsiella pneumoniae")
+as.mo("K. pneumoniae")
+as.mo("KLEPNE")
+as.mo("KLPN")
 ```
 
-The first 135 patient IDs are now male, the other 125 are female.
+The first character in above codes denote their taxonomic kingdom, such as Bacteria (B), Fungi (F), and Protozoa (P).
 
-## Dates
-Let's pretend that our data consists of blood cultures isolates from between 1 January 2010 and 1 January 2018. 
+The `AMR` package also contain functions to directly retrieve taxonomic properties, such as the name, genus, species, family, order, and even Gram-stain. They all start with `mo_` and they use `as.mo()` internally, so that still any arbitrary user input can be used:
 
-```{r create dates}
-dates <- seq(as.Date("2010-01-01"), as.Date("2018-01-01"), by = "day")
+```{r, message = FALSE}
+mo_family("K. pneumoniae")
+mo_genus("K. pneumoniae")
+mo_species("K. pneumoniae")
+
+mo_gramstain("Klebsiella pneumoniae")
+
+mo_ref("K. pneumoniae")
+
+mo_snomed("K. pneumoniae")
 ```
 
-This `dates` object now contains all days in our date range.
+Now we can thus clean our data:
 
-#### Microorganisms
-For this tutorial, we will uses four different microorganisms: *Escherichia coli*, *Staphylococcus aureus*, *Streptococcus pneumoniae*, and *Klebsiella pneumoniae*:
-
-```{r mo}
-bacteria <- c(
-  "Escherichia coli", "Staphylococcus aureus",
-  "Streptococcus pneumoniae", "Klebsiella pneumoniae"
-)
+```{r, echo = FALSE, message = FALSE}
+mo_reset_session()
 ```
 
-## Put everything together
-
-Using the `sample()` function, we can randomly select items from all objects we defined earlier. To let our fake data reflect reality a bit, we will also approximately define the probabilities of bacteria and the antibiotic results, using the `random_sir()` function.
-
-```{r merge data}
-sample_size <- 20000
-data <- data.frame(
-  date = sample(dates, size = sample_size, replace = TRUE),
-  patient_id = sample(patients, size = sample_size, replace = TRUE),
-  hospital = sample(
-    c(
-      "Hospital A",
-      "Hospital B",
-      "Hospital C",
-      "Hospital D"
-    ),
-    size = sample_size, replace = TRUE,
-    prob = c(0.30, 0.35, 0.15, 0.20)
-  ),
-  bacteria = sample(bacteria,
-    size = sample_size, replace = TRUE,
-    prob = c(0.50, 0.25, 0.15, 0.10)
-  ),
-  AMX = random_sir(sample_size, prob_sir = c(0.35, 0.60, 0.05)),
-  AMC = random_sir(sample_size, prob_sir = c(0.15, 0.75, 0.10)),
-  CIP = random_sir(sample_size, prob_sir = c(0.20, 0.80, 0.00)),
-  GEN = random_sir(sample_size, prob_sir = c(0.08, 0.92, 0.00))
-)
+```{r, message = TRUE}
+our_data$bacteria <- as.mo(our_data$bacteria, info = TRUE)
 ```
 
-Using the `left_join()` function from the `dplyr` package, we can 'map' the gender to the patient ID using the `patients_table` object we created earlier:
+Apparently, there was some uncertainty about the translation to taxonomic codes. Let's check this:
 
-```{r merge data 2, message = FALSE, warning = FALSE}
-data <- data %>% left_join(patients_table)
+```{r}
+mo_uncertainties()
 ```
 
-The resulting data set contains `r format(nrow(data), big.mark = " ")` blood culture isolates. With the `head()` function we can preview the first 6 rows of this data set:
+That's all good.
 
-```{r preview data set 1, eval = FALSE}
-head(data)
+## Antibiotic results
+
+The column with antibiotic test results must also be cleaned. The `AMR` package comes with three new data types to work with such test results: `mic` for minimal inhibitory concentrations (MIC), `disk` for disk diffusion diameters, and `sir` for SIR data that have been interpreted already. This package can also determine SIR values based on MIC or disk diffusion values, read more about that on the `as.sir()` page.
+
+For now, we will just clean the SIR columns in our data using dplyr:
+
+```{r}
+# method 1, be explicit about the columns:
+our_data <- our_data %>%
+  mutate_at(vars(AMX:GEN), as.sir)
+
+# method 2, let the AMR package determine the eligible columns
+our_data <- our_data %>%
+  mutate_if(is_sir_eligible, as.sir)
+
+# result:
+our_data
 ```
 
-```{r preview data set 2, echo = FALSE, results = 'asis'}
-knitr::kable(head(data), align = "c")
-```
-
-Now, let's start the cleaning and the analysis!
-
-# Cleaning the data
-
-We also created a package dedicated to data cleaning and checking, called the `cleaner` package. It `freq()` function can be used to create frequency tables.
-
-For example, for the `gender` variable:
-
-```{r freq gender 1, results="asis"}
-data %>% freq(gender)
-```
-
-So, we can draw at least two conclusions immediately. From a data scientists perspective, the data looks clean: only values `M` and `F`. From a researchers perspective: there are slightly more men. Nothing we didn't already know.
-
-The data is already quite clean, but we still need to transform some variables. The `bacteria` column now consists of text, and we want to add more variables based on microbial IDs later on. So, we will transform this column to valid IDs. The `mutate()` function of the `dplyr` package makes this really easy:
-
-```{r transform mo 1}
-data <- data %>%
-  mutate(bacteria = as.mo(bacteria))
-```
-
-We also want to transform the antibiotics, because in real life data we don't know if they are really clean. The `as.sir()` function ensures reliability and reproducibility in these kind of variables. The `is_sir_eligible()` can check which columns are probably columns with SIR test results. Using `mutate()` and `across()`, we can apply the transformation to the formal `<rsi>` class:
-
-```{r transform abx}
-is_sir_eligible(data)
-colnames(data)[is_sir_eligible(data)]
-
-data <- data %>%
-  mutate(across(where(is_sir_eligible), as.sir))
-```
-
-Finally, we will apply [EUCAST rules](https://www.eucast.org/expert_rules_and_intrinsic_resistance/) on our antimicrobial results. In Europe, most medical microbiological laboratories already apply these rules. Our package features their latest insights on intrinsic resistance and exceptional phenotypes. Moreover, the `eucast_rules()` function can also apply additional rules, like forcing <help title="ATC: J01CA01">ampicillin</help> = R when <help title="ATC: J01CR02">amoxicillin/clavulanic acid</help> = R.
-
-Because the amoxicillin (column `AMX`) and amoxicillin/clavulanic acid (column `AMC`) in our data were generated randomly, some rows will undoubtedly contain AMX = S and AMC = R, which is technically impossible. The `eucast_rules()` fixes this:
-
-```{r eucast, warning = FALSE, message = FALSE}
-data <- eucast_rules(data, col_mo = "bacteria", rules = "all")
-```
-
-# Adding new variables
-Now that we have the microbial ID, we can add some taxonomic properties:
-
-```{r new taxo}
-data <- data %>%
-  mutate(
-    gramstain = mo_gramstain(bacteria),
-    genus = mo_genus(bacteria),
-    species = mo_species(bacteria)
-  )
-```
+This is basically it for the cleaning, time to start the data inclusion.
 
 ## First isolates
-We also need to know which isolates we can *actually* use for analysis.
+
+We need to know which isolates we can *actually* use for analysis without repetition bias.
 
 To conduct an analysis of antimicrobial resistance, you must [only include the first isolate of every patient per episode](https:/pubmed.ncbi.nlm.nih.gov/17304462/) (Hindler *et al.*, Clin Infect Dis. 2007). If you would not do this, you could easily get an overestimate or underestimate of the resistance of an antibiotic. Imagine that a patient was admitted with an MRSA and that it was found in 5 different blood cultures the following weeks (yes, some countries like the Netherlands have these blood drawing policies). The resistance percentage of oxacillin of all \emph{S. aureus} isolates would be overestimated, because you included this MRSA more than once. It would clearly be [selection bias](https://en.wikipedia.org/wiki/Selection_bias).
 
@@ -226,116 +164,149 @@ The Clinical and Laboratory Standards Institute (CLSI) appoints this as follows:
 > *(...) When preparing a cumulative antibiogram to guide clinical decisions about empirical antimicrobial therapy of initial infections, **only the first isolate of a given species per patient, per analysis period (eg, one year) should be included, irrespective of body site, antimicrobial susceptibility profile, or other phenotypical characteristics (eg, biotype)**. The first isolate is easily identified, and cumulative antimicrobial susceptibility test data prepared using the first isolate are generally comparable to cumulative antimicrobial susceptibility test data calculated by other methods, providing duplicate isolates are excluded.*
 <br>[M39-A4 Analysis and Presentation of Cumulative Antimicrobial Susceptibility Test Data, 4th Edition. CLSI, 2014. Chapter 6.4](https://clsi.org/standards/products/microbiology/documents/m39/)
 
-This `AMR` package includes this methodology with the `first_isolate()` function and is able to apply the four different methods as defined by [Hindler *et al.* in 2007](https://academic.oup.com/cid/article/44/6/867/364325): phenotype-based, episode-based, patient-based, isolate-based. The right method depends on your goals and analysis, but the default phenotype-based method is in any case the method to properly correct for most duplicate isolates. This method also takes into account the antimicrobial susceptibility test results using `all_microbials()`. Read more about the methods on the `first_isolate()` page.
+This `AMR` package includes this methodology with the `first_isolate()` function and is able to apply the four different methods as defined by [Hindler *et al.* in 2007](https://academic.oup.com/cid/article/44/6/867/364325): phenotype-based, episode-based, patient-based, isolate-based. The right method depends on your goals and analysis, but the default phenotype-based method is in any case the method to properly correct for most duplicate isolates. Read more about the methods on the `first_isolate()` page.
 
 The outcome of the function can easily be added to our data:
 
 ```{r 1st isolate}
-data <- data %>%
+our_data <- our_data %>%
   mutate(first = first_isolate(info = TRUE))
 ```
 
-So only `r percentage(sum(data$first) / nrow(data))` is suitable for resistance analysis! We can now filter on it with the `filter()` function, also from the `dplyr` package:
+So only `r round((sum(our_data$first) / nrow(our_data) * 100))`% is suitable for resistance analysis! We can now filter on it with the `filter()` function, also from the `dplyr` package:
 
 ```{r 1st isolate filter}
-data_1st <- data %>%
+our_data_1st <- our_data %>%
   filter(first == TRUE)
 ```
 
 For future use, the above two syntaxes can be shortened:
 
 ```{r 1st isolate filter 2}
-data_1st <- data %>%
+our_data_1st <- our_data %>%
   filter_first_isolate()
 ```
 
-So we end up with `r format(nrow(data_1st), big.mark = " ")` isolates for analysis. Now our data looks like:
+So we end up with `r format(nrow(our_data_1st), big.mark = " ")` isolates for analysis. Now our data looks like:
 
-```{r preview data set 3, eval = FALSE}
-head(data_1st)
+```{r preview data set 3}
+our_data_1st
 ```
 
-```{r preview data set 4, echo = FALSE, results = 'asis'}
-knitr::kable(head(data_1st), align = "c")
-```
-
-Time for the analysis!
+Time for the analysis.
 
 # Analysing the data
-You might want to start by getting an idea of how the data is distributed. It's an important start, because it also decides how you will continue your analysis. Although this package contains a convenient function to make frequency tables, exploratory data analysis (EDA) is not the primary scope of this package. Use a package like [`DataExplorer`](https://cran.r-project.org/package=DataExplorer) for that, or read the free online book [Exploratory Data Analysis with R](https://bookdown.org/rdpeng/exdata/) by Roger D. Peng.
 
-## Dispersion of species
-To just get an idea how the species are distributed, create a frequency table with our `freq()` function. We created the `genus` and `species` column earlier based on the microbial ID. With `paste()`, we can concatenate them together.
+The base R `summary()` function gives a good first impression, as it comes with support for the new `mo` and `sir` classes that we now have in our data set:
 
-The `freq()` function can be used like the base R language was intended:
+```{r}
+summary(our_data_1st)
 
-```{r freq 1, eval = FALSE}
-freq(paste(data_1st$genus, data_1st$species))
+glimpse(our_data_1st)
+
+# number of unique values per column:
+sapply(our_data_1st, n_distinct)
 ```
 
-Or can be used like the `dplyr` way, which is easier readable:
+## Availability of species
 
-```{r freq 2a, eval = FALSE}
-data_1st %>% freq(genus, species)
-```
-```{r freq 2b, results = 'asis', echo = FALSE}
-data_1st %>%
-  freq(genus, species, header = TRUE)
+To just get an idea how the species are distributed, create a frequency table with `count()` based on the name of the microorganisms:
+
+```{r freq 1}
+our_data %>%
+  count(mo_name(bacteria), sort = TRUE)
+
+our_data_1st %>%
+  count(mo_name(bacteria), sort = TRUE)
 ```
 
-## Overview of different bug/drug combinations
+## Select and filter with antibiotic selectors
 
-Using [tidyverse selections](https://tidyselect.r-lib.org/reference/language.html), you can also select or filter columns based on the antibiotic class they are in:
+Using so-called antibiotic class selectors, you can select or filter columns based on the antibiotic class that your antibiotic results are in:
 
-```{r bug_drg 2a, eval = FALSE}
-data_1st %>%
+```{r bug_drg 2a}
+our_data_1st %>%
+  select(date, aminoglycosides())
+
+our_data_1st %>%
+  select(bacteria, betalactams())
+
+our_data_1st %>%
+  select(bacteria, where(is.sir))
+
+# filtering using AB selectors is also possible:
+our_data_1st %>%
   filter(any(aminoglycosides() == "R"))
+
+our_data_1st %>%
+  filter(all(betalactams() == "R"))
+
+# even works in base R (since R 3.0):
+our_data_1st[all(betalactams() == "R"), ]
 ```
 
-```{r bug_drg 2b, echo = FALSE, results = 'asis'}
-knitr::kable(
-  data_1st %>%
-    filter(any(aminoglycosides() == "R")) %>%
-    head(),
-  align = "c"
+## Generate antibiograms
+
+This package comes with `antibiogram()`, a function that automatically generates traditional, combined, syndromic, and even weighted-incidence syndromic combination antibiograms (WISCA). For R Markdown (such as this page) it automatically prints in the right table format.
+
+Below are some suggestions for how to generate the different antibiograms:
+
+```{r}
+# traditional:
+antibiogram(our_data_1st)
+antibiogram(our_data_1st,
+  ab_transform = "name"
+)
+antibiogram(our_data_1st,
+  ab_transform = "name",
+  language = "es"
+) # support for 20 languages
+```
+
+```{r}
+# combined:
+antibiogram(our_data_1st,
+  antibiotics = c("AMC", "AMC+CIP", "AMC+GEN")
 )
 ```
 
-If you want to get a quick glance of the number of isolates in different bug/drug combinations, you can use the `bug_drug_combinations()` function:
+```{r}
+# for a syndromic antibiogram, we must fake some clinical conditions:
+our_data_1st$condition <- sample(c("Cardial", "Respiratory", "Rheumatic"),
+  size = nrow(our_data_1st),
+  replace = TRUE
+)
 
-```{r bug_drg 1a, eval = FALSE}
-data_1st %>%
-  bug_drug_combinations() %>%
-  head() # show first 6 rows
-```
-
-```{r bug_drg 1b, echo = FALSE, results = 'asis'}
-knitr::kable(
-  data_1st %>%
-    bug_drug_combinations() %>%
-    head(),
-  align = "c"
+# syndromic:
+antibiogram(our_data_1st,
+  syndromic_group = "condition"
+)
+antibiogram(our_data_1st,
+  # you can use AB selectors here as well:
+  antibiotics = c(penicillins(), aminoglycosides()),
+  syndromic_group = "condition",
+  mo_transform = "gramstain"
 )
 ```
 
-
-```{r bug_drg 3a, eval = FALSE}
-data_1st %>%
-  select(bacteria, aminoglycosides()) %>%
-  bug_drug_combinations()
-```
-
-
-```{r bug_drg 3b, echo = FALSE, results = 'asis'}
-knitr::kable(
-  data_1st %>%
-    select(bacteria, aminoglycosides()) %>%
-    bug_drug_combinations(),
-  align = "c"
+```{r}
+# WISCA:
+# (we lack some details, but it could contain a filter on e.g. >65 year-old males)
+wisca <- antibiogram(our_data_1st,
+  antibiotics = c("AMC", "AMC+CIP", "AMC+GEN"),
+  syndromic_group = "condition",
+  mo_transform = "gramstain"
 )
+wisca
 ```
 
-This will only give you the crude numbers in the data. To calculate antimicrobial resistance in a more sensible way, also by correcting for too few results, we use the `resistance()` and `susceptibility()` functions.
+Antibiograms can be plotted using `autoplot()` from the `ggplot2` packages, since this package provides an extension to that function:
+
+```{r}
+autoplot(wisca)
+```
+
+To calculate antimicrobial resistance in a more sensible way, also by correcting for too few results, we use the `resistance()` and `susceptibility()` functions.
 
 ## Resistance percentages
 
@@ -346,274 +317,17 @@ All these functions contain a `minimum` argument, denoting the minimum required
 As per the EUCAST guideline of 2019, we calculate resistance as the proportion of R (`proportion_R()`, equal to `resistance()`) and susceptibility as the proportion of S and I (`proportion_SI()`, equal to `susceptibility()`). These functions can be used on their own:
 
 ```{r}
-data_1st %>% resistance(AMX)
+our_data_1st %>% resistance(AMX)
 ```
 
 Or can be used in conjunction with `group_by()` and `summarise()`, both from the `dplyr` package:
 
-```{r, eval = FALSE}
-data_1st %>%
+```{r}
+our_data_1st %>%
   group_by(hospital) %>%
   summarise(amoxicillin = resistance(AMX))
 ```
-```{r, echo = FALSE}
-data_1st %>%
-  group_by(hospital) %>%
-  summarise(amoxicillin = resistance(AMX)) %>%
-  knitr::kable(align = "c", big.mark = " ")
-```
-
-Of course it would be very convenient to know the number of isolates responsible for the percentages. For that purpose the `n_sir()` can be used, which works exactly like `n_distinct()` from the `dplyr` package. It counts all isolates available for every group (i.e. values S, I or R):
-
-```{r, eval = FALSE}
-data_1st %>%
-  group_by(hospital) %>%
-  summarise(
-    amoxicillin = resistance(AMX),
-    available = n_sir(AMX)
-  )
-```
-```{r, echo = FALSE}
-data_1st %>%
-  group_by(hospital) %>%
-  summarise(
-    amoxicillin = resistance(AMX),
-    available = n_sir(AMX)
-  ) %>%
-  knitr::kable(align = "c", big.mark = " ")
-```
-
-These functions can also be used to get the proportion of multiple antibiotics, to calculate empiric susceptibility of combination therapies very easily:
-
-```{r, eval = FALSE}
-data_1st %>%
-  group_by(genus) %>%
-  summarise(
-    amoxiclav = susceptibility(AMC),
-    gentamicin = susceptibility(GEN),
-    amoxiclav_genta = susceptibility(AMC, GEN)
-  )
-```
-```{r, echo = FALSE}
-data_1st %>%
-  group_by(genus) %>%
-  summarise(
-    amoxiclav = susceptibility(AMC),
-    gentamicin = susceptibility(GEN),
-    amoxiclav_genta = susceptibility(AMC, GEN)
-  ) %>%
-  knitr::kable(align = "c", big.mark = " ")
-```
-
-Or if you are curious for the resistance within certain antibiotic classes, use a antibiotic class selector such as `penicillins()`, which automatically will include the columns `AMX` and `AMC` of our data:
-
-```{r, eval = FALSE}
-data_1st %>%
-  # group by hospital
-  group_by(hospital) %>%
-  #                / -> select all penicillins in the data for calculation
-  #                |              / -> use resistance() for all peni's per hospital
-  #                |              |           / -> print as percentages
-  summarise(across(penicillins(), resistance, as_percent = TRUE)) %>%
-  # format the antibiotic column names, using so-called snake case,
-  # so 'Amoxicillin/clavulanic acid' becomes 'amoxicillin_clavulanic_acid'
-  rename_with(set_ab_names, penicillins())
-```
-```{r, echo = FALSE, message = FALSE}
-data_1st %>%
-  group_by(hospital) %>%
-  summarise(across(penicillins(), resistance, as_percent = TRUE)) %>%
-  rename_with(set_ab_names, penicillins()) %>%
-  knitr::kable(align = "lrr")
-```
-
-To make a transition to the next part, let's see how differences in the previously calculated combination therapies could be plotted:
-
-```{r plot 1}
-data_1st %>%
-  group_by(genus) %>%
-  summarise(
-    "1. Amoxi/clav" = susceptibility(AMC),
-    "2. Gentamicin" = susceptibility(GEN),
-    "3. Amoxi/clav + genta" = susceptibility(AMC, GEN)
-  ) %>%
-  # pivot_longer() from the tidyr package "lengthens" data:
-  tidyr::pivot_longer(-genus, names_to = "antibiotic") %>%
-  ggplot(aes(
-    x = genus,
-    y = value,
-    fill = antibiotic
-  )) +
-  geom_col(position = "dodge2")
-```
-
-## Plots
-
-To show results in plots, most R users would nowadays use the `ggplot2` package. This package lets you create plots in layers. You can read more about it [on their website](https://ggplot2.tidyverse.org/). A quick example would look like these syntaxes:
-
-```{r plot 2, eval = FALSE}
-ggplot(
-  data = a_data_set,
-  mapping = aes(
-    x = year,
-    y = value
-  )
-) +
-  geom_col() +
-  labs(
-    title = "A title",
-    subtitle = "A subtitle",
-    x = "My X axis",
-    y = "My Y axis"
-  )
-
-# or as short as:
-ggplot(a_data_set) +
-  geom_bar(aes(year))
-```
-
-The `AMR` package contains functions to extend this `ggplot2` package, for example `geom_sir()`. It automatically transforms data with `count_df()` or `proportion_df()` and show results in stacked bars. Its simplest and shortest example:
-
-```{r plot 3}
-ggplot(data_1st) +
-  geom_sir(translate_ab = FALSE)
-```
-
-Omit the `translate_ab = FALSE` to have the antibiotic codes (AMX, AMC, CIP, GEN) translated to official WHO names (amoxicillin, amoxicillin/clavulanic acid, ciprofloxacin, gentamicin).
-
-If we group on e.g. the `genus` column and add some additional functions from our package, we can create this:
-
-```{r plot 4}
-# group the data on `genus`
-ggplot(data_1st %>% group_by(genus)) +
-  # create bars with genus on x axis
-  # it looks for variables with class `sir`,
-  # of which we have 4 (earlier created with `as.sir`)
-  geom_sir(x = "genus") +
-  # split plots on antibiotic
-  facet_sir(facet = "antibiotic") +
-  # set colours to the SIR interpretations (colour-blind friendly)
-  scale_sir_colours() +
-  # show percentages on y axis
-  scale_y_percent(breaks = 0:4 * 25) +
-  # turn 90 degrees, to make it bars instead of columns
-  coord_flip() +
-  # add labels
-  labs(
-    title = "Resistance per genus and antibiotic",
-    subtitle = "(this is fake data)"
-  ) +
-  # and print genus in italic to follow our convention
-  # (is now y axis because we turned the plot)
-  theme(axis.text.y = element_text(face = "italic"))
-```
-
-To simplify this, we also created the `ggplot_sir()` function, which combines almost all above functions:
-
-```{r plot 5}
-data_1st %>%
-  group_by(genus) %>%
-  ggplot_sir(
-    x = "genus",
-    facet = "antibiotic",
-    breaks = 0:4 * 25,
-    datalabels = FALSE
-  ) +
-  coord_flip()
-```
-
-### Plotting MIC and disk diffusion values
-
-The AMR package also extends the `plot()` and `ggplot2::autoplot()` functions for plotting minimum inhibitory concentrations (MIC, created with `as.mic()`) and disk diffusion diameters (created with `as.disk()`).
-
-With the `random_mic()` and `random_disk()` functions, we can generate sampled values for the new data types (S3 classes) `<mic>` and `<disk>`:
-
-```{r, results='markup'}
-mic_values <- random_mic(size = 100)
-mic_values
-```
-
-```{r mic_plots}
-# base R:
-plot(mic_values)
-# ggplot2:
-autoplot(mic_values)
-```
-
-But we could also be more specific, by generating MICs that are likely to be found in *E. coli* for ciprofloxacin:
-
-```{r, results = 'markup', message = FALSE, warning = FALSE}
-mic_values <- random_mic(size = 100, mo = "E. coli", ab = "cipro")
-```
-
-For the `plot()` and `autoplot()` function, we can define the microorganism and an antimicrobial agent the same way. This will add the interpretation of those values according to a chosen guidelines (defaults to the latest EUCAST guideline).
-
-Default colours are colour-blind friendly, while maintaining the convention that e.g. 'susceptible' should be green and 'resistant' should be red:
-
-```{r mic_plots_mo_ab, message = FALSE, warning = FALSE}
-# base R:
-plot(mic_values, mo = "E. coli", ab = "cipro")
-# ggplot2:
-autoplot(mic_values, mo = "E. coli", ab = "cipro")
-```
-
-For disk diffusion values, there is not much of a difference in plotting:
-
-```{r, results = 'markup'}
-disk_values <- random_disk(size = 100, mo = "E. coli", ab = "cipro")
-disk_values
-```
-
-```{r disk_plots, message = FALSE, warning = FALSE}
-# base R:
-plot(disk_values, mo = "E. coli", ab = "cipro")
-```
-
-And when using the `ggplot2` package, but now choosing the latest implemented CLSI guideline (notice that the EUCAST-specific term "Susceptible, incr. exp." has changed to "Intermediate"):
-
-```{r disk_plots_mo_ab, message = FALSE, warning = FALSE}
-autoplot(
-  disk_values,
-  mo = "E. coli",
-  ab = "cipro",
-  guideline = "CLSI"
-)
-```
-
-## Independence test
-
-The next example uses the `example_isolates` data set. This is a data set included with this package and contains 2,000 microbial isolates with their full antibiograms. It reflects reality and can be used to practise AMR data analysis.
-
-We will compare the resistance to amoxicillin/clavulanic acid (column `AMC`) between an ICU and other clinical wards. The input for the `fisher.test()` can be retrieved with a transformation like this:
-
-```{r, results = 'markup'}
-# use package 'tidyr' to pivot data:
-library(tidyr)
-
-check_AMC <- example_isolates %>%
-  filter(ward %in% c("ICU", "Clinical")) %>% # filter on only these wards
-  select(ward, AMC) %>% # select the wards and amoxi/clav
-  group_by(ward) %>% # group on the wards
-  count_df(combine_SI = TRUE) %>% # count all isolates per group (ward)
-  pivot_wider(
-    names_from = ward, # transform output so "ICU" and "Clinical" are columns
-    values_from = value
-  ) %>%
-  select(ICU, Clinical) %>% # and only select these columns
-  as.matrix() # transform to a good old matrix for fisher.test()
-
-check_AMC
-```
-
-We can apply the test now with:
-
-```{r}
-# do Fisher's Exact Test
-fisher.test(check_AMC)
-```
-
-As can be seen, the p value is practically zero (`r format(fisher.test(check_AMC)$p.value, scientific = FALSE)`), which means that the amoxicillin/clavulanic acid resistance found in isolates between patients in ICUs and other clinical wards are really different.
 
 ----
 
-*Author: Dr. Matthijs Berends*
+*Author: Dr. Matthijs Berends, 26th Feb 2023*

vignettes/welcome_to_AMR.Rmd

@@ -26,13 +26,13 @@ Note: to keep the package size as small as possible, we only included this vigne
 
 ----
 
-The `AMR` package is a [free and open-source](https://msberends.github.io/AMR/#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting.
+The `AMR` package is a [free and open-source](https://msberends.github.io/AMR/#copyright) R package with [zero dependencies](https://en.wikipedia.org/wiki/Dependency_hell) to simplify the analysis and prediction of Antimicrobial Resistance (AMR) and to work with microbial and antimicrobial data and properties, by using evidence-based methods. **Our aim is to provide a standard** for clean and reproducible AMR data analysis, that can therefore empower epidemiological analyses to continuously enable surveillance and treatment evaluation in any setting. [Many different researchers](https://msberends.github.io/AMR/authors.html) from around the globe are continually helping us to make this a successful and durable project!
 
 This work was published in the Journal of Statistical Software (Volume 104(3); [DOI 10.18637/jss.v104.i03](https://doi.org/10.18637/jss.v104.i03)) and formed the basis of two PhD theses ([DOI 10.33612/diss.177417131](https://doi.org/10.33612/diss.177417131) and [DOI 10.33612/diss.192486375](https://doi.org/10.33612/diss.192486375)).
 
 After installing this package, R knows `r AMR:::format_included_data_number(AMR::microorganisms)` distinct microbial species and all `r AMR:::format_included_data_number(rbind(AMR::antibiotics[, "atc", drop = FALSE], AMR::antivirals[, "atc", drop = FALSE]))` antibiotic, antimycotic and antiviral drugs by name and code (including ATC, EARS-Net, ASIARS-Net, PubChem, LOINC and SNOMED CT), and knows all about valid SIR and MIC values. The integral breakpoint guidelines from CLSI and EUCAST are included from the last 10 years. It supports and can read any data format, including WHONET data.
 
-The `AMR` package is available in English, Chinese, Danish, Dutch, French, German, Greek, Italian, Japanese, Polish, Portuguese, Russian, Spanish, Swedish, Turkish and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
+With the help of contributors from all corners of the world, the `AMR` package is available in English, Czech, Chinese, Danish, Dutch, Finnish, French, German, Greek, Italian, Japanese, Norwegian, Polish, Portuguese, Romanian, Russian, Spanish, Swedish, Turkish, and Ukrainian. Antimicrobial drug (group) names and colloquial microorganism names are provided in these languages.
 
 This package is fully independent of any other R package and works on Windows, macOS and Linux with all versions of R since R-3.0 (April 2013). **It was designed to work in any setting, including those with very limited resources**. Since its first public release in early 2018, this package has been downloaded from more than 175 countries.
 
@@ -57,7 +57,7 @@ This package can be used for:
   
 All reference data sets (about microorganisms, antibiotics, SIR interpretation, EUCAST rules, etc.) in this `AMR` package are publicly and freely available. We continually export our data sets to formats for use in R, SPSS, SAS, Stata and Excel. We also supply flat files that are machine-readable and suitable for input in any software program, such as laboratory information systems. Please find [all download links on our website](https://msberends.github.io/AMR/articles/datasets.html), which is automatically updated with every code change.
 
-This R package was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl), and is being [actively and durably maintained](./news) by two public healthcare organisations in the Netherlands.
+This R package was created for both routine data analysis and academic research at the Faculty of Medical Sciences of the [University of Groningen](https://www.rug.nl), in collaboration with non-profit organisations [Certe Medical Diagnostics and Advice Foundation](https://www.certe.nl) and [University Medical Center Groningen](https://www.umcg.nl), and is being [actively and durably maintained](https://msberends.github.io/AMR/news/) by two public healthcare organisations in the Netherlands.
 
 ----