sort sir history

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 1.8.2.9096
+Version: 1.8.2.9098
-Date: 2023-01-21
+Date: 2023-01-23
 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

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 1.8.2.9096
+# AMR 1.8.2.9098
 
 *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*
 

R/aa_amr-package.R

@@ -33,11 +33,11 @@
 #' Welcome to the `AMR` package.
 #'
 #' 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 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).
-#' 
+#'
 #' 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.
 #' @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).

R/aa_helper_functions.R

@@ -49,12 +49,13 @@ pm_left_join <- function(x, y, by = NULL, suffix = c(".x", ".y")) {
 
   merged <- cbind(
     x,
-    y[match(
+    y[
-      x[, by[1], drop = TRUE],
+      match(
-      y[, by[2], drop = TRUE]
+        x[, by[1], drop = TRUE],
-    ),
+        y[, by[2], drop = TRUE]
-    colnames(y)[!colnames(y) %in% colnames(x) & !colnames(y) == by[2]],
+      ),
-    drop = FALSE
+      colnames(y)[!colnames(y) %in% colnames(x) & !colnames(y) == by[2]],
+      drop = FALSE
     ]
   )
 
@@ -190,12 +191,13 @@ addin_insert_like <- function() {
     )
   }
   replace_pos <- function(old, with) {
-    modifyRange(document_range(
+    modifyRange(
-      document_position(current_row, current_col - nchar(old)),
+      document_range(
-      document_position(current_row, current_col)
+        document_position(current_row, current_col - nchar(old)),
-    ),
+        document_position(current_row, current_col)
-    text = with,
+      ),
-    id = context$id
+      text = with,
+      id = context$id
     )
   }
 
@@ -226,7 +228,7 @@ search_type_in_df <- function(x, type, info = TRUE) {
   # -- mo
   if (type == "mo") {
     add_MO_lookup_to_AMR_env()
-    
+
     if (any(vapply(FUN.VALUE = logical(1), x, is.mo))) {
       # take first 'mo' column
       found <- colnames(x)[vapply(FUN.VALUE = logical(1), x, is.mo)]
@@ -253,11 +255,12 @@ search_type_in_df <- function(x, type, info = TRUE) {
       # WHONET support
       found <- sort(colnames(x)[colnames_formatted %like_case% "^(specimen date|specimen_date|spec_date)"])
       if (!inherits(pm_pull(x, found), c("Date", "POSIXct"))) {
-        stop(font_red(paste0(
+        stop(
-          "Found column '", font_bold(found), "' to be used as input for `col_", type,
+          font_red(paste0(
-          "`, but this column contains no valid dates. Transform its values to valid dates first."
+            "Found column '", font_bold(found), "' to be used as input for `col_", type,
-        )),
+            "`, but this column contains no valid dates. Transform its values to valid dates first."
-        call. = FALSE
+          )),
+          call. = FALSE
         )
       }
     } else if (any(vapply(FUN.VALUE = logical(1), x, function(x) inherits(x, c("Date", "POSIXct"))))) {
@@ -319,21 +322,23 @@ search_type_in_df <- function(x, type, info = TRUE) {
 }
 
 is_valid_regex <- function(x) {
-  regex_at_all <- tryCatch(vapply(
+  regex_at_all <- tryCatch(
-    FUN.VALUE = logical(1),
+    vapply(
-    X = strsplit(x, "", fixed = TRUE),
+      FUN.VALUE = logical(1),
-    FUN = function(y) {
+      X = strsplit(x, "", fixed = TRUE),
-      any(y %in% c(
+      FUN = function(y) {
-        "$", "(", ")", "*", "+", "-",
+        any(
-        ".", "?", "[", "]", "^", "{",
+          y %in% c(
-        "|", "}", "\\"
+            "$", "(", ")", "*", "+", "-",
-      ),
+            ".", "?", "[", "]", "^", "{",
-      na.rm = TRUE
+            "|", "}", "\\"
-      )
+          ),
-    },
+          na.rm = TRUE
-    USE.NAMES = FALSE
+        )
-  ),
+      },
-  error = function(e) rep(TRUE, length(x))
+      USE.NAMES = FALSE
+    ),
+    error = function(e) rep(TRUE, length(x))
   )
   regex_valid <- vapply(
     FUN.VALUE = logical(1),
@@ -410,16 +415,17 @@ word_wrap <- function(...,
 
   if (msg %like% "\n") {
     # run word_wraps() over every line here, bind them and return again
-    return(paste0(vapply(
+    return(paste0(
-      FUN.VALUE = character(1),
+      vapply(
-      trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"),
+        FUN.VALUE = character(1),
-      word_wrap,
+        trimws(unlist(strsplit(msg, "\n", fixed = TRUE)), which = "right"),
-      add_fn = add_fn,
+        word_wrap,
-      as_note = FALSE,
+        add_fn = add_fn,
-      width = width,
+        as_note = FALSE,
-      extra_indent = extra_indent
+        width = width,
-    ),
+        extra_indent = extra_indent
-    collapse = "\n"
+      ),
+      collapse = "\n"
     ))
   }
 
@@ -429,11 +435,12 @@ word_wrap <- function(...,
   # we need to correct for already applied style, that adds text like "\033[31m\"
   msg_stripped <- font_stripstyle(msg)
   # where are the spaces now?
-  msg_stripped_wrapped <- paste0(strwrap(msg_stripped,
+  msg_stripped_wrapped <- paste0(
-    simplify = TRUE,
+    strwrap(msg_stripped,
-    width = width
+      simplify = TRUE,
-  ),
+      width = width
-  collapse = "\n"
+    ),
+    collapse = "\n"
   )
   msg_stripped_wrapped <- paste0(unlist(strsplit(msg_stripped_wrapped, "(\n|\\*\\|\\*)")),
     collapse = "\n"
@@ -487,11 +494,12 @@ message_ <- function(...,
                      appendLF = TRUE,
                      add_fn = list(font_blue),
                      as_note = TRUE) {
-  message(word_wrap(...,
+  message(
-    add_fn = add_fn,
+    word_wrap(...,
-    as_note = as_note
+      add_fn = add_fn,
-  ),
+      as_note = as_note
-  appendLF = appendLF
+    ),
+    appendLF = appendLF
   )
 }
 
@@ -499,12 +507,13 @@ warning_ <- function(...,
                      add_fn = list(),
                      immediate = FALSE,
                      call = FALSE) {
-  warning(word_wrap(...,
+  warning(
-    add_fn = add_fn,
+    word_wrap(...,
-    as_note = FALSE
+      add_fn = add_fn,
-  ),
+      as_note = FALSE
-  immediate. = immediate,
+    ),
-  call. = call
+    immediate. = immediate,
+    call. = call
   )
 }
 
@@ -836,17 +845,18 @@ meet_criteria <- function(object,
     )
   }
   if (!is.null(contains_column_class)) {
-    stop_ifnot(any(vapply(
+    stop_ifnot(
-      FUN.VALUE = logical(1),
+      any(vapply(
-      object,
+        FUN.VALUE = logical(1),
-      function(col, columns_class = contains_column_class) {
+        object,
-        inherits(col, columns_class)
+        function(col, columns_class = contains_column_class) {
-      }
+          inherits(col, columns_class)
-    ), na.rm = TRUE),
+        }
-    "the data provided in argument `", obj_name,
+      ), na.rm = TRUE),
-    "` must contain at least one column of class <", contains_column_class, ">. ",
+      "the data provided in argument `", obj_name,
-    "See ?as.", contains_column_class, ".",
+      "` must contain at least one column of class <", contains_column_class, ">. ",
-    call = call_depth
+      "See ?as.", contains_column_class, ".",
+      call = call_depth
     )
   }
   return(invisible())
@@ -1314,7 +1324,6 @@ round2 <- function(x, digits = 1, force_zero = TRUE) {
 
 # percentage from our other package: 'cleaner'
 percentage <- function(x, digits = NULL, ...) {
-
   # getdecimalplaces() function
   getdecimalplaces <- function(x, minimum = 0, maximum = 3) {
     if (maximum < minimum) {
@@ -1330,12 +1339,13 @@ percentage <- function(x, digits = NULL, ...) {
       ), ".", fixed = TRUE),
       function(y) ifelse(length(y) == 2, nchar(y[2]), 0)
     )), na.rm = TRUE)
-    max(min(max_places,
+    max(
-      maximum,
+      min(max_places,
+        maximum,
+        na.rm = TRUE
+      ),
+      minimum,
       na.rm = TRUE
-    ),
-    minimum,
-    na.rm = TRUE
     )
   }
 
@@ -1366,11 +1376,12 @@ percentage <- function(x, digits = NULL, ...) {
     # max one digit if undefined
     digits <- getdecimalplaces(x, minimum = 0, maximum = 1)
   }
-  format_percentage(structure(
+  format_percentage(
-    .Data = as.double(x),
+    structure(
-    class = c("percentage", "numeric")
+      .Data = as.double(x),
-  ),
+      class = c("percentage", "numeric")
-  digits = digits, ...
+    ),
+    digits = digits, ...
   )
 }
 
@@ -1385,7 +1396,7 @@ add_MO_lookup_to_AMR_env <- function() {
   # for all MO functions, saves a lot of time on package load and in package size
   if (is.null(AMR_env$MO_lookup)) {
     MO_lookup <- AMR::microorganisms
-    
+
     MO_lookup$kingdom_index <- NA_real_
     MO_lookup[which(MO_lookup$kingdom == "Bacteria" | MO_lookup$mo == "UNKNOWN"), "kingdom_index"] <- 1
     MO_lookup[which(MO_lookup$kingdom == "Fungi"), "kingdom_index"] <- 2
@@ -1393,7 +1404,7 @@ add_MO_lookup_to_AMR_env <- function() {
     MO_lookup[which(MO_lookup$kingdom == "Archaea"), "kingdom_index"] <- 4
     # all the rest
     MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5
-    
+
     # the fullname lowercase, important for the internal algorithms in as.mo()
     MO_lookup$fullname_lower <- tolower(trimws(paste(
       MO_lookup$genus,
@@ -1405,7 +1416,7 @@ add_MO_lookup_to_AMR_env <- function() {
     MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
     # special for Salmonella - they have cities as subspecies but not the species (enterica) in the fullname:
     MO_lookup$fullname_lower[which(MO_lookup$subspecies %like_case% "^[A-Z]")] <- gsub(" enterica ", " ", MO_lookup$fullname_lower[which(MO_lookup$subspecies %like_case% "^[A-Z]")], fixed = TRUE)
-    
+
     MO_lookup$full_first <- substr(MO_lookup$fullname_lower, 1, 1)
     MO_lookup$species_first <- tolower(substr(MO_lookup$species, 1, 1)) # tolower for groups (Streptococcus, Salmonella)
     MO_lookup$subspecies_first <- tolower(substr(MO_lookup$subspecies, 1, 1)) # tolower for Salmonella serovars

R/ab.R

@@ -87,7 +87,6 @@
 #'
 #' \donttest{
 #' if (require("dplyr")) {
-#'
 #'   # you can quickly rename 'sir' columns using set_ab_names() with dplyr:
 #'   example_isolates %>%
 #'     set_ab_names(where(is.sir), property = "atc")
@@ -338,22 +337,23 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
       }
 
       # transform back from other languages and try again
-      x_translated <- paste(lapply(
+      x_translated <- paste(
-        strsplit(x[i], "[^A-Z0-9]"),
+        lapply(
-        function(y) {
+          strsplit(x[i], "[^A-Z0-9]"),
-          for (i in seq_len(length(y))) {
+          function(y) {
-            for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
+            for (i in seq_len(length(y))) {
-              y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
+              for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
-                TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
+                y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
-                  !isFALSE(TRANSLATIONS$fixed)), "pattern"],
+                  TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
-                y[i]
+                    !isFALSE(TRANSLATIONS$fixed)), "pattern"],
-              )
+                  y[i]
+                )
+              }
             }
+            generalise_antibiotic_name(y)
           }
-          generalise_antibiotic_name(y)
+        )[[1]],
-        }
+        collapse = "/"
-      )[[1]],
-      collapse = "/"
       )
       x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE))
       if (!is.na(x_translated_guess)) {
@@ -362,20 +362,21 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
       }
 
       # now also try to coerce brandname combinations like "Amoxy/clavulanic acid"
-      x_translated <- paste(lapply(
+      x_translated <- paste(
-        strsplit(x_translated, "[^A-Z0-9 ]"),
+        lapply(
-        function(y) {
+          strsplit(x_translated, "[^A-Z0-9 ]"),
-          for (i in seq_len(length(y))) {
+          function(y) {
-            y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE))
+            for (i in seq_len(length(y))) {
-            y[i] <- ifelse(!is.na(y_name),
+              y_name <- suppressWarnings(ab_name(y[i], language = NULL, initial_search = FALSE))
-              y_name,
+              y[i] <- ifelse(!is.na(y_name),
-              y[i]
+                y_name,
-            )
+                y[i]
+              )
+            }
+            generalise_antibiotic_name(y)
           }
-          generalise_antibiotic_name(y)
+        )[[1]],
-        }
+        collapse = "/"
-      )[[1]],
-      collapse = "/"
       )
       x_translated_guess <- suppressWarnings(as.ab(x_translated, initial_search = FALSE))
       if (!is.na(x_translated_guess)) {
@@ -513,8 +514,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
     )
   }
   x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
-  x_unknown <- c(x_unknown,
+  x_unknown <- c(
-                 AMR_env$ab_previously_coerced$x_bak[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))])
+    x_unknown,
+    AMR_env$ab_previously_coerced$x_bak[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))]
+  )
   if (length(x_unknown) > 0 && fast_mode == FALSE) {
     warning_(
       "in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ",
@@ -660,9 +663,9 @@ get_translate_ab <- function(translate_ab) {
   } else {
     translate_ab <- tolower(translate_ab)
     stop_ifnot(translate_ab %in% colnames(AMR::antibiotics),
-               "invalid value for 'translate_ab', this must be a column name of the antibiotics data set\n",
+      "invalid value for 'translate_ab', this must be a column name of the antibiotics data set\n",
-               "or TRUE (equals 'name') or FALSE to not translate at all.",
+      "or TRUE (equals 'name') or FALSE to not translate at all.",
-               call = FALSE
+      call = FALSE
     )
     translate_ab
   }

R/ab_selectors.R

@@ -95,20 +95,17 @@
 #' # dplyr -------------------------------------------------------------------
 #' \donttest{
 #' if (require("dplyr")) {
-#'
 #'   # get AMR for all aminoglycosides e.g., per ward:
 #'   example_isolates %>%
 #'     group_by(ward) %>%
 #'     summarise(across(aminoglycosides(), resistance))
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # You can combine selectors with '&' to be more specific:
 #'   example_isolates %>%
 #'     select(penicillins() & administrable_per_os())
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # get AMR for only drugs that matter - no intrinsic resistance:
 #'   example_isolates %>%
 #'     filter(mo_genus() %in% c("Escherichia", "Klebsiella")) %>%
@@ -116,7 +113,6 @@
 #'     summarise(across(not_intrinsic_resistant(), resistance))
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # get susceptibility for antibiotics whose name contains "trim":
 #'   example_isolates %>%
 #'     filter(first_isolate()) %>%
@@ -124,19 +120,16 @@
 #'     summarise(across(ab_selector(name %like% "trim"), susceptibility))
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
 #'   example_isolates %>%
 #'     select(carbapenems())
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
 #'   example_isolates %>%
 #'     select(mo, aminoglycosides())
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # any() and all() work in dplyr's filter() too:
 #'   example_isolates %>%
 #'     filter(
@@ -145,25 +138,21 @@
 #'     )
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # also works with c():
 #'   example_isolates %>%
 #'     filter(any(c(carbapenems(), aminoglycosides()) == "R"))
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # not setting any/all will automatically apply all():
 #'   example_isolates %>%
 #'     filter(aminoglycosides() == "R")
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
 #'   example_isolates %>%
 #'     select(mo, ab_class("mycobact"))
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # get bug/drug combinations for only glycopeptides in Gram-positives:
 #'   example_isolates %>%
 #'     filter(mo_is_gram_positive()) %>%
@@ -179,7 +168,6 @@
 #'     select(penicillins()) # only the 'J01CA01' column will be selected
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # with recent versions of dplyr this is all equal:
 #'   x <- example_isolates[carbapenems() == "R", ]
 #'   y <- example_isolates %>% filter(carbapenems() == "R")
@@ -433,14 +421,16 @@ administrable_per_os <- function(only_sir_columns = FALSE, ...) {
     ab_group = "administrable_per_os",
     examples = paste0(
       " (such as ",
-      vector_or(ab_name(sample(agents_all,
+      vector_or(
-        size = min(5, length(agents_all)),
+        ab_name(
-        replace = FALSE
+          sample(agents_all,
-      ),
+            size = min(5, length(agents_all)),
-      tolower = TRUE,
+            replace = FALSE
-      language = NULL
+          ),
-      ),
+          tolower = TRUE,
-      quotes = FALSE
+          language = NULL
+        ),
+        quotes = FALSE
       ),
       ")"
     )
@@ -491,20 +481,21 @@ not_intrinsic_resistant <- function(only_sir_columns = FALSE, col_mo = NULL, ver
     sort = FALSE, fn = "not_intrinsic_resistant"
   )
   # intrinsic vars
-  vars_df_R <- tryCatch(sapply(
+  vars_df_R <- tryCatch(
-    eucast_rules(vars_df,
+    sapply(
-      col_mo = col_mo,
+      eucast_rules(vars_df,
-      version_expertrules = version_expertrules,
+        col_mo = col_mo,
-      rules = "expert",
+        version_expertrules = version_expertrules,
-      info = FALSE
+        rules = "expert",
+        info = FALSE
+      ),
+      function(col) {
+        tryCatch(!any(is.na(col)) && all(col == "R"),
+          error = function(e) FALSE
+        )
+      }
     ),
-    function(col) {
+    error = function(e) stop_("in not_intrinsic_resistant(): ", e$message, call = FALSE)
-      tryCatch(!any(is.na(col)) && all(col == "R"),
-        error = function(e) FALSE
-      )
-    }
-  ),
-  error = function(e) stop_("in not_intrinsic_resistant(): ", e$message, call = FALSE)
   )
 
   agents <- ab_in_data[ab_in_data %in% names(vars_df_R[which(vars_df_R)])]
@@ -549,12 +540,13 @@ ab_select_exec <- function(function_name,
       if (message_not_thrown_before(function_name, "ab_class", "untreatable", entire_session = TRUE)) {
         warning_(
           "in `", function_name, "()`: some drugs were ignored since they cannot be used for treating patients: ",
-          vector_and(ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
+          vector_and(
-            language = NULL,
+            ab_name(names(ab_in_data)[names(ab_in_data) %in% untreatable],
-            tolower = TRUE
+              language = NULL,
-          ),
+              tolower = TRUE
-          quotes = FALSE,
+            ),
-          sort = TRUE
+            quotes = FALSE,
+            sort = TRUE
           ), ". They can be included using `", function_name, "(only_treatable = FALSE)`. ",
           "This warning will be shown once per session."
         )
@@ -593,11 +585,12 @@ ab_select_exec <- function(function_name,
       }
       ab_group <- function_name
     }
-    examples <- paste0(" (such as ", vector_or(ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
+    examples <- paste0(" (such as ", vector_or(
-      tolower = TRUE,
+      ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
-      language = NULL
+        tolower = TRUE,
-    ),
+        language = NULL
-    quotes = FALSE
+      ),
+      quotes = FALSE
     ), ")")
   } else {
     # this for the 'manual' ab_class() function
@@ -821,11 +814,12 @@ find_ab_names <- function(ab_group, n = 3) {
   if (length(drugs) == 0) {
     return("??")
   }
-  vector_or(ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE),
+  vector_or(
-    tolower = TRUE,
+    ab_name(sample(drugs, size = min(n, length(drugs)), replace = FALSE),
-    language = NULL
+      tolower = TRUE,
-  ),
+      language = NULL
-  quotes = FALSE
+    ),
+    quotes = FALSE
   )
 }
 

R/age.R

@@ -83,11 +83,12 @@ age <- function(x, reference = Sys.Date(), exact = FALSE, na.rm = FALSE, ...) {
   # add decimals
   if (exact == TRUE) {
     # get dates of `x` when `x` would have the year of `reference`
-    x_in_reference_year <- as.POSIXlt(paste0(
+    x_in_reference_year <- as.POSIXlt(
-      format(as.Date(reference), "%Y"),
+      paste0(
-      format(as.Date(x), "-%m-%d")
+        format(as.Date(reference), "%Y"),
-    ),
+        format(as.Date(x), "-%m-%d")
-    format = "%Y-%m-%d"
+      ),
+      format = "%Y-%m-%d"
     )
     # get differences in days
     n_days_x_rest <- as.double(difftime(as.Date(reference),

R/av.R

@@ -308,22 +308,23 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
       }
 
       # transform back from other languages and try again
-      x_translated <- paste(lapply(
+      x_translated <- paste(
-        strsplit(x[i], "[^A-Z0-9]"),
+        lapply(
-        function(y) {
+          strsplit(x[i], "[^A-Z0-9]"),
-          for (i in seq_len(length(y))) {
+          function(y) {
-            for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
+            for (i in seq_len(length(y))) {
-              y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
+              for (lang in LANGUAGES_SUPPORTED[LANGUAGES_SUPPORTED != "en"]) {
-                TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
+                y[i] <- ifelse(tolower(y[i]) %in% tolower(TRANSLATIONS[, lang, drop = TRUE]),
-                  !isFALSE(TRANSLATIONS$fixed)), "pattern"],
+                  TRANSLATIONS[which(tolower(TRANSLATIONS[, lang, drop = TRUE]) == tolower(y[i]) &
-                y[i]
+                    !isFALSE(TRANSLATIONS$fixed)), "pattern"],
-              )
+                  y[i]
+                )
+              }
             }
+            generalise_antibiotic_name(y)
           }
-          generalise_antibiotic_name(y)
+        )[[1]],
-        }
+        collapse = "/"
-      )[[1]],
-      collapse = "/"
       )
       x_translated_guess <- suppressWarnings(as.av(x_translated, initial_search = FALSE))
       if (!is.na(x_translated_guess)) {
@@ -332,20 +333,21 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
       }
 
       # now also try to coerce brandname combinations like "Amoxy/clavulanic acid"
-      x_translated <- paste(lapply(
+      x_translated <- paste(
-        strsplit(x_translated, "[^A-Z0-9 ]"),
+        lapply(
-        function(y) {
+          strsplit(x_translated, "[^A-Z0-9 ]"),
-          for (i in seq_len(length(y))) {
+          function(y) {
-            y_name <- suppressWarnings(av_name(y[i], language = NULL, initial_search = FALSE))
+            for (i in seq_len(length(y))) {
-            y[i] <- ifelse(!is.na(y_name),
+              y_name <- suppressWarnings(av_name(y[i], language = NULL, initial_search = FALSE))
-              y_name,
+              y[i] <- ifelse(!is.na(y_name),
-              y[i]
+                y_name,
-            )
+                y[i]
+              )
+            }
+            generalise_antibiotic_name(y)
           }
-          generalise_antibiotic_name(y)
+        )[[1]],
-        }
+        collapse = "/"
-      )[[1]],
-      collapse = "/"
       )
       x_translated_guess <- suppressWarnings(as.av(x_translated, initial_search = FALSE))
       if (!is.na(x_translated_guess)) {
@@ -478,8 +480,10 @@ as.av <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
     )
   }
   x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
-  x_unknown <- c(x_unknown,
+  x_unknown <- c(
-                 AMR_env$av_previously_coerced$x_bak[which(AMR_env$av_previously_coerced$x %in% x & is.na(AMR_env$av_previously_coerced$av))])
+    x_unknown,
+    AMR_env$av_previously_coerced$x_bak[which(AMR_env$av_previously_coerced$x %in% x & is.na(AMR_env$av_previously_coerced$av))]
+  )
   if (length(x_unknown) > 0 && fast_mode == FALSE) {
     warning_(
       "in `as.av()`: these values could not be coerced to a valid antiviral drug ID: ",
@@ -604,9 +608,9 @@ get_translate_av <- function(translate_av) {
   } else {
     translate_av <- tolower(translate_av)
     stop_ifnot(translate_av %in% colnames(AMR::antivirals),
-               "invalid value for 'translate_av', this must be a column name of the antivirals data set\n",
+      "invalid value for 'translate_av', this must be a column name of the antivirals data set\n",
-               "or TRUE (equals 'name') or FALSE to not translate at all.",
+      "or TRUE (equals 'name') or FALSE to not translate at all.",
-               call = FALSE
+      call = FALSE
     )
     translate_av
   }

R/av_from_text.R

@@ -69,26 +69,26 @@ av_from_text <- function(text,
   if (missing(type)) {
     type <- type[1L]
   }
-  
+
   meet_criteria(text)
   meet_criteria(type, allow_class = "character", has_length = 1)
   meet_criteria(collapse, has_length = 1, allow_NULL = TRUE)
   meet_criteria(translate_av, allow_NULL = FALSE) # get_translate_av() will be more informative about what's allowed
   meet_criteria(thorough_search, allow_class = "logical", has_length = 1, allow_NULL = TRUE)
   meet_criteria(info, allow_class = "logical", has_length = 1)
-  
+
   type <- tolower(trimws2(type))
-  
+
   text <- tolower(as.character(text))
   text_split_all <- strsplit(text, "[ ;.,:\\|]")
   progress <- progress_ticker(n = length(text_split_all), n_min = 5, print = info)
   on.exit(close(progress))
-  
+
   if (type %like% "(drug|ab|anti)") {
     translate_av <- get_translate_av(translate_av)
-    
+
     if (isTRUE(thorough_search) ||
-        (isTRUE(is.null(thorough_search)) && max(vapply(FUN.VALUE = double(1), text_split_all, length), na.rm = TRUE) <= 3)) {
+      (isTRUE(is.null(thorough_search)) && max(vapply(FUN.VALUE = double(1), text_split_all, length), na.rm = TRUE) <= 3)) {
       text_split_all <- text_split_all[nchar(text_split_all) >= 4 & grepl("[a-z]+", text_split_all)]
       result <- lapply(text_split_all, function(text_split) {
         progress$tick()
@@ -125,9 +125,9 @@ av_from_text <- function(text,
         )
       })
     }
-    
+
     close(progress)
-    
+
     result <- lapply(result, function(out) {
       out <- out[!is.na(out)]
       if (length(out) == 0) {
@@ -149,7 +149,7 @@ av_from_text <- function(text,
       text_split <- as.double(gsub("[^0-9.]", "", text_split))
       # minimal 100 units/mg and no years that unlikely doses
       text_split <- text_split[text_split >= 100 & !text_split %in% c(1951:1999, 2001:2049)]
-      
+
       if (length(text_split) > 0) {
         text_split
       } else {
@@ -170,7 +170,7 @@ av_from_text <- function(text,
   } else {
     stop_("`type` must be either 'drug', 'dose' or 'administration'")
   }
-  
+
   # collapse text if needed
   if (!is.null(collapse)) {
     result <- vapply(FUN.VALUE = character(1), result, function(x) {
@@ -181,6 +181,6 @@ av_from_text <- function(text,
       }
     })
   }
-  
+
   result
 }

R/av_property.R

@@ -84,7 +84,7 @@ av_name <- function(x, language = get_AMR_locale(), tolower = FALSE, ...) {
   meet_criteria(x, allow_NA = TRUE)
   language <- validate_language(language)
   meet_criteria(tolower, allow_class = "logical", has_length = 1)
-  
+
   x <- translate_into_language(av_validate(x = x, property = "name", ...), language = language, only_affect_ab_names = TRUE)
   if (tolower == TRUE) {
     # use perl to only transform the first character
@@ -155,11 +155,11 @@ av_loinc <- function(x, ...) {
 av_ddd <- function(x, administration = "oral", ...) {
   meet_criteria(x, allow_NA = TRUE)
   meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
-  
+
   x <- as.av(x, ...)
   ddd_prop <- paste0(administration, "_ddd")
   out <- av_validate(x = x, property = ddd_prop)
-  
+
   if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
     warning_(
       "in `av_ddd()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
@@ -175,11 +175,11 @@ av_ddd <- function(x, administration = "oral", ...) {
 av_ddd_units <- function(x, administration = "oral", ...) {
   meet_criteria(x, allow_NA = TRUE)
   meet_criteria(administration, is_in = c("oral", "iv"), has_length = 1)
-  
+
   x <- as.av(x, ...)
   ddd_prop <- paste0(administration, "_units")
   out <- av_validate(x = x, property = ddd_prop)
-  
+
   if (any(av_name(x, language = NULL) %like% "/" & is.na(out))) {
     warning_(
       "in `av_ddd_units()`: DDDs of some combined products are available for different dose combinations and not (yet) part of the AMR package.",
@@ -195,7 +195,7 @@ av_ddd_units <- function(x, administration = "oral", ...) {
 av_info <- function(x, language = get_AMR_locale(), ...) {
   meet_criteria(x, allow_NA = TRUE)
   language <- validate_language(language)
-  
+
   x <- as.av(x, ...)
   list(
     av = as.character(x),
@@ -224,18 +224,18 @@ av_info <- function(x, language = get_AMR_locale(), ...) {
 av_url <- function(x, open = FALSE, ...) {
   meet_criteria(x, allow_NA = TRUE)
   meet_criteria(open, allow_class = "logical", has_length = 1)
-  
+
   av <- as.av(x = x, ...)
   atcs <- av_atc(av, only_first = TRUE)
   u <- paste0("https://www.whocc.no/atc_ddd_index/?code=", atcs, "&showdescription=no")
   u[is.na(atcs)] <- NA_character_
   names(u) <- av_name(av)
-  
+
   NAs <- av_name(av, tolower = TRUE, language = NULL)[!is.na(av) & is.na(atcs)]
   if (length(NAs) > 0) {
     warning_("in `av_url()`: no ATC code available for ", vector_and(NAs, quotes = FALSE), ".")
   }
-  
+
   if (open == TRUE) {
     if (length(u) > 1 && !is.na(u[1L])) {
       warning_("in `av_url()`: only the first URL will be opened, as `browseURL()` only suports one string.")
@@ -264,9 +264,9 @@ av_validate <- function(x, property, ...) {
     # try to catch an error when inputting an invalid argument
     # so the 'call.' can be set to FALSE
     tryCatch(x[1L] %in% AMR_env$AV_lookup[1, property, drop = TRUE],
-             error = function(e) stop(e$message, call. = FALSE)
+      error = function(e) stop(e$message, call. = FALSE)
     )
-    
+
     if (!all(x %in% AMR_env$AV_lookup[, property, drop = TRUE])) {
       x <- as.av(x, ...)
       if (all(is.na(x)) && is.list(AMR_env$AV_lookup[, property, drop = TRUE])) {
@@ -276,7 +276,7 @@ av_validate <- function(x, property, ...) {
       }
     }
   }
-  
+
   if (property == "av") {
     return(set_clean_class(x, new_class = c("av", "character")))
   } else if (property == "cid") {

R/custom_antimicrobials.R

@@ -31,25 +31,25 @@
 #'
 #' With [add_custom_antimicrobials()] you can add your own custom antimicrobial drug names and codes.
 #' @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. 
+#' @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:
-#' 
+#'
 #' **Method 1:** Save the antimicrobials to a local or remote file (can even be the internet). To use this method:
-#' 
+#'
 #'    1. Create a data set in the structure of the [antibiotics] data set (containing at the very least columns "ab" and "name") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_ab.rds"`, or any remote location.
-#'    
+#'
 #'    2. Set the file location to the `AMR_custom_ab` \R option: `options(AMR_custom_ab = "~/my_custom_ab.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
 #'
 #'       ```r
 #'       # Add custom antibiotic drug codes:
 #'       options(AMR_custom_ab = "~/my_custom_ab.rds")
 #'       ```
-#'       
+#'
 #'       Upon package load, this file will be loaded and run through the [add_custom_antimicrobials()] function.
-#' 
+#'
 #' **Method 2:** Save the antimicrobial additions directly to your `.Rprofile` file. An important downside is that this requires to load the `AMR` package at every start-up. To use this method:
-#' 
+#'
 #'    1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
 #'
 #'    2. Add a text like below and save the file:
@@ -139,10 +139,10 @@ add_custom_antimicrobials <- function(x) {
       x[, col] <- as.list(x[, col, drop = TRUE])
     }
   }
-  
+
   AMR_env$custom_ab_codes <- c(AMR_env$custom_ab_codes, x$ab)
   class(AMR_env$AB_lookup$ab) <- "character"
-  
+
   new_df <- AMR_env$AB_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE]
   rownames(new_df) <- NULL
   list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list)
@@ -155,7 +155,7 @@ add_custom_antimicrobials <- function(x) {
     new_df[, col] <- x[, col, drop = TRUE]
   }
   AMR_env$AB_lookup <- unique(rbind(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")
   message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal `antibiotics` data set.")

R/custom_eucast_rules.R

@@ -240,11 +240,12 @@ print.custom_eucast_rules <- function(x, ...) {
       " (", rule$result_group, ")"
     )
     agents <- sort(agents)
-    rule_if <- word_wrap(paste0(
+    rule_if <- word_wrap(
-      i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "),
+      paste0(
-      "set to {result}:"
+        i, ". ", font_bold("If "), font_blue(rule$query), font_bold(" then "),
-    ),
+        "set to {result}:"
-    extra_indent = 5
+      ),
+      extra_indent = 5
     )
     rule_if <- gsub("{result}", val, rule_if, fixed = TRUE)
     rule_then <- paste0("     ", word_wrap(paste0(agents, collapse = ", "), extra_indent = 5))

R/custom_microorganisms.R

@@ -32,26 +32,26 @@
 #' With [add_custom_microorganisms()] you can add your own custom microorganisms, such the non-taxonomic outcome of laboratory analysis.
 #' @param x a [data.frame] resembling the [microorganisms] data set, at least containing column "genus" (case-insensitive)
 #' @details This function will fill in missing taxonomy for you, if specific taxonomic columns are missing, see *Examples*.
-#' 
+#'
-#' **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. 
+#' **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:
-#' 
+#'
 #' **Method 1:** Using the option [`AMR_custom_mo`][AMR-options], which is the preferred method. To use this method:
-#' 
+#'
 #'    1. Create a data set in the structure of the [microorganisms] data set (containing at the very least column "genus") and save it with [saveRDS()] to a location of choice, e.g. `"~/my_custom_mo.rds"`, or any remote location.
-#'    
+#'
 #'    2. Set the file location to the `AMR_custom_mo` \R option: `options(AMR_custom_mo = "~/my_custom_mo.rds")`. This can even be a remote file location, such as an https URL. Since options are not saved between \R sessions, it is best to save this option to the `.Rprofile` file so that it will be loaded on start-up of \R. To do this, open the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`, add this text and save the file:
 #'
 #'       ```r
 #'       # Add custom microorganism codes:
 #'       options(AMR_custom_mo = "~/my_custom_mo.rds")
 #'       ```
-#'       
+#'
 #'       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:
-#' 
+#'
 #'    1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`.
 #'
 #'    2. Add a text like below and save the file:
@@ -77,44 +77,49 @@
 #' # now add a custom entry - it will be considered by as.mo() and
 #' # all mo_*() functions
 #' add_custom_microorganisms(
-#'   data.frame(genus = "Enterobacter",
+#'   data.frame(
-#'              species = "asburiae/cloacae"
+#'     genus = "Enterobacter",
+#'     species = "asburiae/cloacae"
 #'   )
 #' )
 #'
 #' # E. asburiae/cloacae is now a new microorganism:
 #' mo_name("Enterobacter asburiae/cloacae")
-#' 
+#'
 #' # its code:
 #' as.mo("Enterobacter asburiae/cloacae")
-#' 
+#'
 #' # all internal algorithms will work as well:
 #' mo_name("Ent asburia cloacae")
-#' 
+#'
 #' # and even the taxonomy was added based on the genus!
 #' mo_family("E. asburiae/cloacae")
 #' mo_gramstain("Enterobacter asburiae/cloacae")
 #'
 #' mo_info("Enterobacter asburiae/cloacae")
-#' 
+#'
-#' 
+#'
 #' # the function tries to be forgiving:
 #' add_custom_microorganisms(
-#'   data.frame(GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE",
+#'   data.frame(
-#'              SPECIES = "SPECIES")
+#'     GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE",
+#'     SPECIES = "SPECIES"
+#'   )
 #' )
 #' mo_name("BACTEROIDES / PARABACTEROIDES")
 #' mo_rank("BACTEROIDES / PARABACTEROIDES")
-#' 
+#'
 #' # taxonomy still works, although a slashline genus was given as input:
 #' mo_family("Bacteroides/Parabacteroides")
-#' 
+#'
-#' 
+#'
 #' # for groups and complexes, set them as species or subspecies:
 #' add_custom_microorganisms(
-#'   data.frame(genus = "Citrobacter", 
+#'   data.frame(
-#'              species = c("freundii", "braakii complex"),
+#'     genus = "Citrobacter",
-#'              subspecies = c("complex", ""))
+#'     species = c("freundii", "braakii complex"),
+#'     subspecies = c("complex", "")
+#'   )
 #' )
 #' mo_name(c("C. freundii complex", "C. braakii complex"))
 #' mo_species(c("C. freundii complex", "C. braakii complex"))
@@ -123,9 +128,9 @@
 add_custom_microorganisms <- function(x) {
   meet_criteria(x, allow_class = "data.frame")
   stop_ifnot("genus" %in% tolower(colnames(x)), paste0("`x` must contain column 'genus'."))
-  
+
   add_MO_lookup_to_AMR_env()
-  
+
   # remove any extra class/type, such as grouped tbl, or data.table:
   x <- as.data.frame(x, stringsAsFactors = FALSE)
   colnames(x) <- tolower(colnames(x))
@@ -135,7 +140,7 @@ add_custom_microorganisms <- function(x) {
   }
   # keep only columns available in the microorganisms data set
   x <- x[, colnames(AMR_env$MO_lookup)[colnames(AMR_env$MO_lookup) %in% colnames(x)], drop = FALSE]
-  
+
   # clean the input ----
   for (col in c("genus", "species", "subspecies")) {
     if (!col %in% colnames(x)) {
@@ -152,7 +157,7 @@ add_custom_microorganisms <- function(x) {
     col_ <- gsub(" *([/-]) *", "\\1", col_, perl = TRUE)
     # groups are in our taxonomic table with a capital G
     col_ <- gsub(" group( |$)", " Group\\1", col_, perl = TRUE)
-    
+
     col_[is.na(col_)] <- ""
     if (col == "genus") {
       substr(col_, 1, 1) <- toupper(substr(col_, 1, 1))
@@ -163,19 +168,27 @@ add_custom_microorganisms <- function(x) {
     x[, col] <- col_
   }
   # if subspecies is a group or complex, add it to the species and empty the subspecies
-  x$species[which(x$subspecies %in% c("group", "Group", "complex"))] <- paste(x$species[which(x$subspecies %in% c("group", "Group", "complex"))],
+  x$species[which(x$subspecies %in% c("group", "Group", "complex"))] <- paste(
-                                                                              x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))])
+    x$species[which(x$subspecies %in% c("group", "Group", "complex"))],
+    x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))]
+  )
   x$subspecies[which(x$subspecies %in% c("group", "Group", "complex"))] <- ""
-  
+
   if ("rank" %in% colnames(x)) {
-    stop_ifnot(all(x$rank %in% AMR_env$MO_lookup$rank),
+    stop_ifnot(
-               "the 'rank' column can only contain these values: ", vector_or(AMR_env$MO_lookup$rank))
+      all(x$rank %in% AMR_env$MO_lookup$rank),
+      "the 'rank' column can only contain these values: ", vector_or(AMR_env$MO_lookup$rank)
+    )
   } else {
     x$rank <- ifelse(x$subspecies != "", "subspecies",
-                     ifelse(x$species != "", "species",
+      ifelse(x$species != "", "species",
-                            ifelse(x$genus != "", "genus",
+        ifelse(x$genus != "", "genus",
-                                   stop("in add_custom_microorganisms(): only microorganisms up to the genus level can be added",
+          stop("in add_custom_microorganisms(): only microorganisms up to the genus level can be added",
-                                        call. = FALSE))))
+            call. = FALSE
+          )
+        )
+      )
+    )
   }
   x$source <- "Added by user"
   if (!"fullname" %in% colnames(x)) {
@@ -191,7 +204,7 @@ add_custom_microorganisms <- function(x) {
   x$class[is.na(x$class)] <- ""
   x$order[is.na(x$order)] <- ""
   x$family[is.na(x$family)] <- ""
-  
+
   for (col in colnames(x)) {
     if (is.factor(x[, col, drop = TRUE])) {
       x[, col] <- as.character(x[, col, drop = TRUE])
@@ -200,7 +213,7 @@ add_custom_microorganisms <- function(x) {
       x[, col] <- as.list(x[, col, drop = TRUE])
     }
   }
-  
+
   # fill in taxonomy based on genus
   genus_to_check <- gsub("^(.*)[^a-zA-Z].*", "\\1", x$genus, perl = TRUE)
   x$kingdom[which(x$kingdom == "" & genus_to_check != "")] <- AMR_env$MO_lookup$kingdom[match(genus_to_check[which(x$kingdom == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
@@ -208,7 +221,7 @@ add_custom_microorganisms <- function(x) {
   x$class[which(x$class == "" & genus_to_check != "")] <- AMR_env$MO_lookup$class[match(genus_to_check[which(x$class == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
   x$order[which(x$order == "" & genus_to_check != "")] <- AMR_env$MO_lookup$order[match(genus_to_check[which(x$order == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
   x$family[which(x$family == "" & genus_to_check != "")] <- AMR_env$MO_lookup$family[match(genus_to_check[which(x$family == "" & genus_to_check != "")], AMR_env$MO_lookup$genus)]
-  
+
   # fill in other columns that are used in internal algorithms
   x$prevalence <- NA_real_
   x$prevalence[which(genus_to_check != "")] <- AMR_env$MO_lookup$prevalence[match(genus_to_check[which(genus_to_check != "")], AMR_env$MO_lookup$genus)]
@@ -222,7 +235,7 @@ add_custom_microorganisms <- function(x) {
   x$full_first <- substr(x$fullname_lower, 1, 1)
   x$species_first <- tolower(substr(x$species, 1, 1))
   x$subspecies_first <- tolower(substr(x$subspecies, 1, 1))
-  
+
   if (!"mo" %in% colnames(x)) {
     # create the mo code
     x$mo <- NA_character_
@@ -230,19 +243,27 @@ add_custom_microorganisms <- function(x) {
   x$mo <- trimws2(as.character(x$mo))
   x$mo[x$mo == ""] <- NA_character_
   current <- sum(AMR_env$MO_lookup$source == "Added by user", na.rm = TRUE)
-  x$mo[is.na(x$mo)] <- paste0("CUSTOM",
+  x$mo[is.na(x$mo)] <- paste0(
-                              seq.int(from = current + 1, to = current + nrow(x), by = 1),
+    "CUSTOM",
-                              "_",
+    seq.int(from = current + 1, to = current + nrow(x), by = 1),
-                              toupper(unname(abbreviate(gsub(" +", " _ ",
+    "_",
-                                                             gsub("[^A-Za-z0-9-]", " ",
+    toupper(unname(abbreviate(
-                                                                  trimws2(paste(x$genus, x$species, x$subspecies)))),
+      gsub(
-                                                        minlength = 10))))
+        " +", " _ ",
+        gsub(
+          "[^A-Za-z0-9-]", " ",
+          trimws2(paste(x$genus, x$species, x$subspecies))
+        )
+      ),
+      minlength = 10
+    )))
+  )
   stop_if(anyDuplicated(c(as.character(AMR_env$MO_lookup$mo), x$mo)), "MO codes must be unique and not match existing MO codes of the AMR package")
-  
+
   # add to package ----
   AMR_env$custom_mo_codes <- c(AMR_env$custom_mo_codes, x$mo)
   class(AMR_env$MO_lookup$mo) <- "character"
-  
+
   new_df <- AMR_env$MO_lookup[0, , drop = FALSE][seq_len(NROW(x)), , drop = FALSE]
   rownames(new_df) <- NULL
   list_cols <- vapply(FUN.VALUE = logical(1), new_df, is.list)
@@ -254,10 +275,10 @@ add_custom_microorganisms <- function(x) {
     # assign new values
     new_df[, col] <- x[, col, drop = TRUE]
   }
-  
+
   # clear previous coercions
   suppressMessages(mo_reset_session())
-  
+
   AMR_env$MO_lookup <- unique(rbind(AMR_env$MO_lookup, new_df))
   class(AMR_env$MO_lookup$mo) <- c("mo", "character")
   if (nrow(x) <= 3) {
@@ -271,11 +292,11 @@ add_custom_microorganisms <- function(x) {
 #' @export
 clear_custom_microorganisms <- function() {
   n <- nrow(AMR_env$MO_lookup)
-  
+
   # reset
   AMR_env$MO_lookup <- NULL
   add_MO_lookup_to_AMR_env()
-  
+
   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

@@ -65,10 +65,10 @@
 #'
 #' ### Direct download
 #' Like all data sets in this package, these data sets are publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. 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 
+#' @source
-#' 
+#'
 #' * World Health Organization (WHO) Collaborating Centre for Drug Statistics Methodology (WHOCC): <https://www.whocc.no/atc_ddd_index/>
-#' 
+#'
 #' * `r TAXONOMY_VERSION$LOINC$citation` Accessed from <`r TAXONOMY_VERSION$LOINC$url`> on `r documentation_date(TAXONOMY_VERSION$LOINC$accessed_date)`.
 #'
 #' * European Commission Public Health PHARMACEUTICALS - COMMUNITY REGISTER: <https://ec.europa.eu/health/documents/community-register/html/reg_hum_atc.htm>
@@ -141,9 +141,9 @@
 #' * `r TAXONOMY_VERSION$GBIF$citation` Accessed from <`r TAXONOMY_VERSION$GBIF$url`> on `r documentation_date(TAXONOMY_VERSION$GBIF$accessed_date)`.
 #'
 #' * `r TAXONOMY_VERSION$SNOMED$citation` URL: <`r TAXONOMY_VERSION$SNOMED$url`>
-#' 
+#'
 #' * Grimont *et al.* (2007). Antigenic Formulae of the Salmonella Serovars, 9th Edition. WHO Collaborating Centre for Reference and Research on *Salmonella* (WHOCC-SALM).
-#' 
+#'
 #' * Bartlett *et al.* (2022). **A comprehensive list of bacterial pathogens infecting humans** *Microbiology* 168:001269; \doi{10.1099/mic.0.001269}
 #' @seealso [as.mo()], [mo_property()], [microorganisms.codes], [intrinsic_resistant]
 #' @examples

R/disk.R

@@ -120,13 +120,13 @@ as.disk <- function(x, na.rm = FALSE) {
         vector_and(quotes = TRUE)
       cur_col <- get_current_column()
       warning_("in `as.disk()`: ", na_after - na_before, " result",
-               ifelse(na_after - na_before > 1, "s", ""),
+        ifelse(na_after - na_before > 1, "s", ""),
-               ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
+        ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
-               " truncated (",
+        " truncated (",
-               round(((na_after - na_before) / length(x)) * 100),
+        round(((na_after - na_before) / length(x)) * 100),
-               "%) that were invalid disk zones: ",
+        "%) that were invalid disk zones: ",
-               list_missing,
+        list_missing,
-               call = FALSE
+        call = FALSE
       )
     }
   }

R/episode.R

@@ -57,11 +57,12 @@
 #' df[which(get_episode(df$date, 60) == 3), ]
 #'
 #' # the functions also work for less than a day, e.g. to include one per hour:
-#' get_episode(c(
+#' get_episode(
-#'   Sys.time(),
+#'   c(
-#'   Sys.time() + 60 * 60
+#'     Sys.time(),
-#' ),
+#'     Sys.time() + 60 * 60
-#' episode_days = 1 / 24
+#'   ),
+#'   episode_days = 1 / 24
 #' )
 #'
 #' \donttest{
@@ -98,7 +99,6 @@
 #'     )
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # grouping on patients and microorganisms leads to the same
 #'   # results as first_isolate() when using 'episode-based':
 #'   x <- df %>%
@@ -115,7 +115,6 @@
 #'   identical(x, y)
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # but is_new_episode() has a lot more flexibility than first_isolate(),
 #'   # since you can now group on anything that seems relevant:
 #'   df %>%

R/eucast_rules.R

@@ -702,11 +702,12 @@ eucast_rules <- function(x,
       # Print rule  -------------------------------------------------------------
       if (rule_current != rule_previous) {
         # is new rule within group, print its name
-        cat(italicise_taxonomy(word_wrap(rule_current,
+        cat(italicise_taxonomy(
-          width = getOption("width") - 30,
+          word_wrap(rule_current,
-          extra_indent = 6
+            width = getOption("width") - 30,
-        ),
+            extra_indent = 6
-        type = "ansi"
+          ),
+          type = "ansi"
         ))
         warned <- FALSE
       }
@@ -721,21 +722,23 @@ eucast_rules <- function(x,
     if (mo_value %like% "coagulase" && any(x$genus == "Staphylococcus", na.rm = TRUE)) {
       if (mo_value %like% "negative") {
         eucast_rules_df[i, "this_value"] <- paste0(
-          "^(", paste0(all_staph[which(all_staph$CNS_CPS %like% "negative"),
+          "^(", paste0(
-            "fullname",
+            all_staph[which(all_staph$CNS_CPS %like% "negative"),
-            drop = TRUE
+              "fullname",
-          ],
+              drop = TRUE
-          collapse = "|"
+            ],
+            collapse = "|"
           ),
           ")$"
         )
       } else {
         eucast_rules_df[i, "this_value"] <- paste0(
-          "^(", paste0(all_staph[which(all_staph$CNS_CPS %like% "positive"),
+          "^(", paste0(
-            "fullname",
+            all_staph[which(all_staph$CNS_CPS %like% "positive"),
-            drop = TRUE
+              "fullname",
-          ],
+              drop = TRUE
-          collapse = "|"
+            ],
+            collapse = "|"
           ),
           ")$"
         )
@@ -745,11 +748,12 @@ eucast_rules <- function(x,
     # be sure to comprise all beta-haemolytic Streptococci (Lancefield groups A, B, C and G) when they are mentioned
     if (mo_value %like% "group [ABCG]" && any(x$genus == "Streptococcus", na.rm = TRUE)) {
       eucast_rules_df[i, "this_value"] <- paste0(
-        "^(", paste0(all_strep[which(all_strep$Lancefield %like% "group [ABCG]"),
+        "^(", paste0(
-          "fullname",
+          all_strep[which(all_strep$Lancefield %like% "group [ABCG]"),
-          drop = TRUE
+            "fullname",
-        ],
+            drop = TRUE
-        collapse = "|"
+          ],
+          collapse = "|"
         ),
         ")$"
       )
@@ -789,15 +793,17 @@ eucast_rules <- function(x,
       if (length(source_antibiotics) == 0) {
         rows <- integer(0)
       } else if (length(source_antibiotics) == 1) {
-        rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value &
+        rows <- tryCatch(
-          as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]),
+          which(x[, if_mo_property, drop = TRUE] %like% mo_value &
-        error = function(e) integer(0)
+            as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L]),
+          error = function(e) integer(0)
         )
       } else if (length(source_antibiotics) == 2) {
-        rows <- tryCatch(which(x[, if_mo_property, drop = TRUE] %like% mo_value &
+        rows <- tryCatch(
-          as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] &
+          which(x[, if_mo_property, drop = TRUE] %like% mo_value &
-          as.sir_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]),
+            as.sir_no_warning(x[, source_antibiotics[1L]]) == source_value[1L] &
-        error = function(e) integer(0)
+            as.sir_no_warning(x[, source_antibiotics[2L]]) == source_value[2L]),
+          error = function(e) integer(0)
         )
         # nolint start
         # } else if (length(source_antibiotics) == 3) {
@@ -872,11 +878,12 @@ eucast_rules <- function(x,
       )
       if (isTRUE(info)) {
         # print rule
-        cat(italicise_taxonomy(word_wrap(format_custom_query_rule(rule$query, colours = FALSE),
+        cat(italicise_taxonomy(
-          width = getOption("width") - 30,
+          word_wrap(format_custom_query_rule(rule$query, colours = FALSE),
-          extra_indent = 6
+            width = getOption("width") - 30,
-        ),
+            extra_indent = 6
-        type = "ansi"
+          ),
+          type = "ansi"
         ))
         warned <- FALSE
       }
@@ -1117,14 +1124,15 @@ edit_sir <- function(x,
       },
       error = function(e) {
         txt_error()
-        stop(paste0(
+        stop(
-          "In row(s) ", paste(rows[seq_len(min(length(rows), 10))], collapse = ","),
+          paste0(
-          ifelse(length(rows) > 10, "...", ""),
+            "In row(s) ", paste(rows[seq_len(min(length(rows), 10))], collapse = ","),
-          " while writing value '", to,
+            ifelse(length(rows) > 10, "...", ""),
-          "' to column(s) `", paste(cols, collapse = "`, `"),
+            " while writing value '", to,
-          "`:\n", e$message
+            "' to column(s) `", paste(cols, collapse = "`, `"),
-        ),
+            "`:\n", e$message
-        call. = FALSE
+          ),
+          call. = FALSE
         )
       }
     )

R/first_isolate.R

@@ -144,13 +144,11 @@
 #'     filter(first_isolate())
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # short-hand version:
 #'   example_isolates %>%
 #'     filter_first_isolate(info = FALSE)
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # flag the first isolates per group:
 #'   example_isolates %>%
 #'     group_by(ward) %>%
@@ -244,18 +242,19 @@ first_isolate <- function(x = NULL,
     method <- "episode-based"
   }
   if (isTRUE(info) && message_not_thrown_before("first_isolate", "method")) {
-    message_(paste0(
+    message_(
-      "Determining first isolates ",
+      paste0(
-      ifelse(method %in% c("episode-based", "phenotype-based"),
+        "Determining first isolates ",
-        ifelse(is.infinite(episode_days),
+        ifelse(method %in% c("episode-based", "phenotype-based"),
-          "without a specified episode length",
+          ifelse(is.infinite(episode_days),
-          paste("using an episode length of", episode_days, "days")
+            "without a specified episode length",
-        ),
+            paste("using an episode length of", episode_days, "days")
-        ""
+          ),
-      )
+          ""
-    ),
+        )
-    as_note = FALSE,
+      ),
-    add_fn = font_black
+      as_note = FALSE,
+      add_fn = font_black
     )
   }
 
@@ -469,15 +468,17 @@ first_isolate <- function(x = NULL,
   x$other_pat_or_mo <- !(x$newvar_patient_id == pm_lag(x$newvar_patient_id) & x$newvar_genus_species == pm_lag(x$newvar_genus_species))
 
   x$episode_group <- paste(x$newvar_patient_id, x$newvar_genus_species)
-  x$more_than_episode_ago <- unlist(lapply(split(
+  x$more_than_episode_ago <- unlist(
-    x$newvar_date,
+    lapply(
-    x$episode_group
+      split(
-  ),
+        x$newvar_date,
-  exec_episode, # this will skip meet_criteria() in is_new_episode(), saving time
+        x$episode_group
-  type = "logical",
+      ),
-  episode_days = episode_days
+      exec_episode, # this will skip meet_criteria() in is_new_episode(), saving time
-  ),
+      type = "logical",
-  use.names = FALSE
+      episode_days = episode_days
+    ),
+    use.names = FALSE
   )
 
   if (!is.null(col_keyantimicrobials)) {
@@ -606,21 +607,22 @@ first_isolate <- function(x = NULL,
     }
     # mark up number of found
     n_found <- format(n_found, big.mark = big.mark, decimal.mark = decimal.mark)
-    message_(paste0(
+    message_(
-      "=> Found ",
+      paste0(
-      font_bold(paste0(
+        "=> Found ",
-        n_found,
+        font_bold(paste0(
-        ifelse(method == "isolate-based", "", paste0(" '", method, "'")),
+          n_found,
-        " first isolates"
+          ifelse(method == "isolate-based", "", paste0(" '", method, "'")),
-      )),
+          " first isolates"
-      " (",
+        )),
-      ifelse(p_found_total != p_found_scope,
+        " (",
-        paste0(p_found_scope, " within scope and "),
+        ifelse(p_found_total != p_found_scope,
-        ""
+          paste0(p_found_scope, " within scope and "),
+          ""
+        ),
+        p_found_total, " of total where a microbial ID was available)"
       ),
-      p_found_total, " of total where a microbial ID was available)"
+      add_fn = font_black, as_note = FALSE
-    ),
-    add_fn = font_black, as_note = FALSE
     )
   }
 

R/ggplot_pca.R

@@ -414,13 +414,14 @@ pca_calculations <- function(pca_model,
       sigma <- var(cbind(x$xvar, x$yvar))
       mu <- c(mean(x$xvar), mean(x$yvar))
       ed <- sqrt(qchisq(ellipse_prob, df = 2))
-      data.frame(sweep(circle %*% chol(sigma) * ed,
+      data.frame(
-        MARGIN = 2,
+        sweep(circle %*% chol(sigma) * ed,
-        STATS = mu,
+          MARGIN = 2,
-        FUN = "+"
+          STATS = mu,
-      ),
+          FUN = "+"
-      groups = x$groups[1],
+        ),
-      stringsAsFactors = FALSE
+        groups = x$groups[1],
+        stringsAsFactors = FALSE
       )
     })
     ell <- do.call(rbind, df.groups)

R/ggplot_sir.R

@@ -71,13 +71,11 @@
 #' @examples
 #' \donttest{
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # get antimicrobial results for drugs against a UTI:
 #'   ggplot(example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)) +
 #'     geom_sir()
 #' }
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # prettify the plot using some additional functions:
 #'   df <- example_isolates %>% select(AMX, NIT, FOS, TMP, CIP)
 #'   ggplot(df) +
@@ -88,21 +86,18 @@
 #'     theme_sir()
 #' }
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # or better yet, simplify this using the wrapper function - a single command:
 #'   example_isolates %>%
 #'     select(AMX, NIT, FOS, TMP, CIP) %>%
 #'     ggplot_sir()
 #' }
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # get only proportions and no counts:
 #'   example_isolates %>%
 #'     select(AMX, NIT, FOS, TMP, CIP) %>%
 #'     ggplot_sir(datalabels = FALSE)
 #' }
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # add other ggplot2 arguments as you like:
 #'   example_isolates %>%
 #'     select(AMX, NIT, FOS, TMP, CIP) %>%
@@ -115,14 +110,12 @@
 #'     )
 #' }
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # you can alter the colours with colour names:
 #'   example_isolates %>%
 #'     select(AMX) %>%
 #'     ggplot_sir(colours = c(SI = "yellow"))
 #' }
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # but you can also use the built-in colour-blind friendly colours for
 #'   # your plots, where "S" is green, "I" is yellow and "R" is red:
 #'   data.frame(
@@ -135,7 +128,6 @@
 #'     scale_sir_colours(Value4 = "S", Value5 = "I", Value6 = "R")
 #' }
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # resistance of ciprofloxacine per age group
 #'   example_isolates %>%
 #'     mutate(first_isolate = first_isolate()) %>%
@@ -149,14 +141,12 @@
 #'     ggplot_sir(x = "age_group")
 #' }
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # a shorter version which also adjusts data label colours:
 #'   example_isolates %>%
 #'     select(AMX, NIT, FOS, TMP, CIP) %>%
 #'     ggplot_sir(colours = FALSE)
 #' }
 #' if (require("ggplot2") && require("dplyr")) {
-#'
 #'   # it also supports groups (don't forget to use the group var on `x` or `facet`):
 #'   example_isolates %>%
 #'     filter(mo_is_gram_negative(), ward != "Outpatient") %>%

R/guess_ab_col.R

@@ -274,14 +274,15 @@ get_column_abx <- function(x,
       }
       if (names(out[i]) %in% names(duplicates)) {
         already_set_as <- out[unname(out) == unname(out[i])][1L]
-        warning_(paste0(
+        warning_(
-          "Column '", font_bold(out[i]), "' will not be used for ",
+          paste0(
-          names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
+            "Column '", font_bold(out[i]), "' will not be used for ",
-          ", as it is already set for ",
+            names(out)[i], " (", ab_name(names(out)[i], tolower = TRUE, language = NULL), ")",
-          names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")"
+            ", as it is already set for ",
-        ),
+            names(already_set_as), " (", ab_name(names(already_set_as), tolower = TRUE, language = NULL), ")"
-        add_fn = font_red,
+          ),
-        immediate = verbose
+          add_fn = font_red,
+          immediate = verbose
         )
       }
     }
@@ -307,11 +308,12 @@ get_column_abx <- function(x,
     if (isTRUE(info) && !all(soft_dependencies %in% names(out))) {
       # missing a soft dependency may lower the reliability
       missing <- soft_dependencies[!soft_dependencies %in% names(out)]
-      missing_msg <- vector_and(paste0(
+      missing_msg <- vector_and(
-        ab_name(missing, tolower = TRUE, language = NULL),
+        paste0(
-        " (", font_bold(missing, collapse = NULL), ")"
+          ab_name(missing, tolower = TRUE, language = NULL),
-      ),
+          " (", font_bold(missing, collapse = NULL), ")"
-      quotes = FALSE
+        ),
+        quotes = FALSE
       )
       message_(
         "Reliability would be improved if these antimicrobial results would be available too: ",
@@ -355,10 +357,11 @@ generate_warning_abs_missing <- function(missing, any = FALSE) {
   } else {
     any_txt <- c("", "are")
   }
-  warning_(paste0(
+  warning_(
-    "Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
+    paste0(
-    vector_and(missing, quotes = FALSE)
+      "Introducing NAs since", any_txt[1], " these antimicrobials ", any_txt[2], " required: ",
-  ),
+      vector_and(missing, quotes = FALSE)
-  immediate = TRUE
+    ),
+    immediate = TRUE
   )
 }

R/italicise_taxonomy.R

@@ -73,41 +73,44 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) {
       search_strings <- gsub("[^a-zA-Z-]", "", s_split)
 
       ind_species <- search_strings != "" &
-        search_strings %in% AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
+        search_strings %in% AMR_env$MO_lookup[
-          "family",
+          which(AMR_env$MO_lookup$rank %in% c(
-          "genus",
+            "family",
+            "genus",
+            "species",
+            "subspecies",
+            "infraspecies",
+            "subsp."
+          )),
           "species",
-          "subspecies",
+          drop = TRUE
-          "infraspecies",
-          "subsp."
-        )),
-        "species",
-        drop = TRUE
         ]
 
       ind_fullname <- search_strings != "" &
         search_strings %in% c(
-          AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
+          AMR_env$MO_lookup[
-            "family",
+            which(AMR_env$MO_lookup$rank %in% c(
-            "genus",
+              "family",
-            "species",
+              "genus",
-            "subspecies",
+              "species",
-            "infraspecies",
+              "subspecies",
-            "subsp."
+              "infraspecies",
-          )),
+              "subsp."
-          "fullname",
+            )),
-          drop = TRUE
+            "fullname",
+            drop = TRUE
           ],
-          AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c(
+          AMR_env$MO_lookup[
-            "family",
+            which(AMR_env$MO_lookup$rank %in% c(
-            "genus",
+              "family",
-            "species",
+              "genus",
+              "species",
+              "subspecies",
+              "infraspecies",
+              "subsp."
+            )),
             "subspecies",
-            "infraspecies",
+            drop = TRUE
-            "subsp."
-          )),
-          "subspecies",
-          drop = TRUE
           ]
         )
 

R/join_microorganisms.R

@@ -128,7 +128,7 @@ anti_join_microorganisms <- function(x, by = NULL, ...) {
 
 join_microorganisms <- function(type, x, by, suffix, ...) {
   add_MO_lookup_to_AMR_env()
-  
+
   if (!is.data.frame(x)) {
     if (pkg_is_available("tibble", also_load = FALSE)) {
       x <- import_fn("tibble", "tibble")(mo = x)

R/mdro.R

@@ -193,17 +193,17 @@ mdro <- function(x = NULL,
   meet_criteria(combine_SI, allow_class = "logical", has_length = 1)
   meet_criteria(verbose, allow_class = "logical", has_length = 1)
   meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
-  
+
   if (!any(is_sir_eligible(x))) {
     stop_("There were no possible SIR columns found in the data set. Transform columns with `as.sir()` for valid antimicrobial interpretations.")
   }
-  
+
   info.bak <- info
   # don't thrown info's more than once per call
   if (isTRUE(info)) {
     info <- message_not_thrown_before("mdro")
   }
-  
+
   if (interactive() && isTRUE(verbose) && isTRUE(info)) {
     txt <- paste0(
       "WARNING: In Verbose mode, the mdro() function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.",
@@ -221,7 +221,7 @@ mdro <- function(x = NULL,
       return(x)
     }
   }
-  
+
   group_msg <- ""
   if (isTRUE(info.bak)) {
     # print group name if used in dplyr::group_by()
@@ -243,15 +243,15 @@ mdro <- function(x = NULL,
       }
     }
   }
-  
+
   # force regular [data.frame], not a tibble or data.table
   x <- as.data.frame(x, stringsAsFactors = FALSE)
-  
+
   if (pct_required_classes > 1) {
     # allow pct_required_classes = 75 -> pct_required_classes = 0.75
     pct_required_classes <- pct_required_classes / 100
   }
-  
+
   guideline.bak <- guideline
   if (is.list(guideline)) {
     # Custom MDRO guideline ---------------------------------------------------
@@ -260,8 +260,8 @@ mdro <- function(x = NULL,
       txt <- paste0(
         "Determining MDROs based on custom rules",
         ifelse(isTRUE(attributes(guideline)$as_factor),
-               paste0(", resulting in factor levels: ", paste0(attributes(guideline)$values, collapse = " < ")),
+          paste0(", resulting in factor levels: ", paste0(attributes(guideline)$values, collapse = " < ")),
-               ""
+          ""
         ),
         "."
       )
@@ -314,7 +314,7 @@ mdro <- function(x = NULL,
     "invalid guideline: ", guideline.bak
   )
   guideline <- list(code = guideline)
-  
+
   # try to find columns based on type
   # -- mo
   if (is.null(col_mo)) {
@@ -329,7 +329,7 @@ mdro <- function(x = NULL,
     col_mo <- "mo"
   }
   stop_if(is.null(col_mo), "`col_mo` must be set")
-  
+
   if (guideline$code == "cmi2012") {
     guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance."
     guideline$author <- "Magiorakos AP, Srinivasan A, Carey RB, ..., Vatopoulos A, Weber JT, Monnet DL"
@@ -360,7 +360,7 @@ mdro <- function(x = NULL,
     guideline$version <- "WHO/HTM/TB/2014.11, 2014"
     guideline$source_url <- font_url("https://www.who.int/publications/i/item/9789241548809", "Direct download")
     guideline$type <- "MDR-TB's"
-    
+
     # support per country:
   } else if (guideline$code == "mrgn") {
     guideline$name <- "Cross-border comparison of the Dutch and German guidelines on multidrug-resistant Gram-negative microorganisms"
@@ -377,7 +377,7 @@ mdro <- function(x = NULL,
   } else {
     stop("This guideline is currently unsupported: ", guideline$code, call. = FALSE)
   }
-  
+
   if (guideline$code == "cmi2012") {
     cols_ab <- get_column_abx(
       x = x,
@@ -456,7 +456,7 @@ mdro <- function(x = NULL,
     }
     cols_ab <- c(cols_ab, c(AMP = unname(cols_ab[names(cols_ab) == "AMX"])))
   }
-  
+
   # nolint start
   AMC <- cols_ab["AMC"]
   AMK <- cols_ab["AMK"]
@@ -601,13 +601,13 @@ mdro <- function(x = NULL,
   abx_tb <- abx_tb[!is.na(abx_tb)]
   stop_if(guideline$code == "tb" & length(abx_tb) == 0, "no antimycobacterials found in data set")
   # nolint end
-  
+
   if (isTRUE(combine_SI)) {
     search_result <- "R"
   } else {
     search_result <- c("R", "I")
   }
-  
+
   if (isTRUE(info)) {
     if (isTRUE(combine_SI)) {
       cat(font_red("\nOnly results with 'R' are considered as resistance. Use `combine_SI = FALSE` to also consider 'I' as resistance.\n"))
@@ -615,18 +615,18 @@ mdro <- function(x = NULL,
       cat(font_red("\nResults with 'R' or 'I' are considered as resistance. Use `combine_SI = TRUE` to only consider 'R' as resistance.\n"))
     }
     cat("\n", word_wrap("Determining multidrug-resistant organisms (MDRO), according to:"), "\n",
-        word_wrap(paste0(font_bold("Guideline: "), font_italic(guideline$name)), extra_indent = 11, as_note = FALSE), "\n",
+      word_wrap(paste0(font_bold("Guideline: "), font_italic(guideline$name)), extra_indent = 11, as_note = FALSE), "\n",
-        word_wrap(paste0(font_bold("Author(s): "), guideline$author), extra_indent = 11, as_note = FALSE), "\n",
+      word_wrap(paste0(font_bold("Author(s): "), guideline$author), extra_indent = 11, as_note = FALSE), "\n",
-        ifelse(!is.na(guideline$version),
+      ifelse(!is.na(guideline$version),
-               paste0(word_wrap(paste0(font_bold("Version:   "), guideline$version), extra_indent = 11, as_note = FALSE), "\n"),
+        paste0(word_wrap(paste0(font_bold("Version:   "), guideline$version), extra_indent = 11, as_note = FALSE), "\n"),
-               ""
+        ""
-        ),
+      ),
-        paste0(font_bold("Source:    "), guideline$source_url),
+      paste0(font_bold("Source:    "), guideline$source_url),
-        "\n\n",
+      "\n\n",
-        sep = ""
+      sep = ""
     )
   }
-  
+
   ab_missing <- function(ab) {
     isTRUE(ab %in% c(NULL, NA)) | length(ab) == 0
   }
@@ -638,7 +638,7 @@ mdro <- function(x = NULL,
     out[is.na(out)] <- FALSE
     out
   }
-  
+
   # antibiotic classes
   # nolint start
   aminoglycosides <- c(TOB, GEN)
@@ -649,17 +649,18 @@ mdro <- function(x = NULL,
   carbapenems <- c(DOR, ETP, IPM, MEM, MEV)
   fluoroquinolones <- c(CIP, ENX, FLE, GAT, GEM, GRX, LVX, LOM, MFX, NOR, OFX, PAZ, PEF, PRU, RFL, SPX, TMX, TVA)
   # nolint end
-  
+
   # helper function for editing the table
   trans_tbl <- function(to, rows, cols, any_all) {
     cols <- cols[!ab_missing(cols)]
     cols <- cols[!is.na(cols)]
     if (length(rows) > 0 && length(cols) > 0) {
-      x[, cols] <- as.data.frame(lapply(
+      x[, cols] <- as.data.frame(
-        x[, cols, drop = FALSE],
+        lapply(
-        function(col) as.sir(col)
+          x[, cols, drop = FALSE],
-      ),
+          function(col) as.sir(col)
-      stringsAsFactors = FALSE
+        ),
+        stringsAsFactors = FALSE
       )
       x[rows, "columns_nonsusceptible"] <<- vapply(
         FUN.VALUE = character(1),
@@ -670,22 +671,23 @@ mdro <- function(x = NULL,
             x[row, group_vct, drop = FALSE],
             function(y) y %in% search_result
           )
-          paste(sort(c(
+          paste(
-            unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)),
+            sort(c(
-            names(cols_nonsus)[cols_nonsus]
+              unlist(strsplit(x[row, "columns_nonsusceptible", drop = TRUE], ", ", fixed = TRUE)),
-          )),
+              names(cols_nonsus)[cols_nonsus]
-          collapse = ", "
+            )),
+            collapse = ", "
           )
         }
       )
-      
+
       if (any_all == "any") {
         search_function <- any
       } else if (any_all == "all") {
         search_function <- all
       }
       x_transposed <- as.list(as.data.frame(t(x[, cols, drop = FALSE]),
-                                            stringsAsFactors = FALSE
+        stringsAsFactors = FALSE
       ))
       rows_affected <- vapply(
         FUN.VALUE = logical(1),
@@ -704,7 +706,7 @@ mdro <- function(x = NULL,
       )
     }
   }
-  
+
   trans_tbl2 <- function(txt, rows, lst) {
     if (isTRUE(info)) {
       message_(txt, "...", appendLF = FALSE, as_note = FALSE)
@@ -714,12 +716,13 @@ mdro <- function(x = NULL,
       lst_vector <- unlist(lst)[!is.na(unlist(lst))]
       # keep only unique ones:
       lst_vector <- lst_vector[!duplicated(paste(lst_vector, names(lst_vector)))]
-      
+
-      x[, lst_vector] <- as.data.frame(lapply(
+      x[, lst_vector] <- as.data.frame(
-        x[, lst_vector, drop = FALSE],
+        lapply(
-        function(col) as.sir(col)
+          x[, lst_vector, drop = FALSE],
-      ),
+          function(col) as.sir(col)
-      stringsAsFactors = FALSE
+        ),
+        stringsAsFactors = FALSE
       )
       x[rows, "classes_in_guideline"] <<- length(lst)
       x[rows, "classes_available"] <<- vapply(
@@ -733,7 +736,7 @@ mdro <- function(x = NULL,
           ))
         }
       )
-      
+
       if (isTRUE(verbose)) {
         x[rows, "columns_nonsusceptible"] <<- vapply(
           FUN.VALUE = character(1),
@@ -748,30 +751,31 @@ mdro <- function(x = NULL,
         FUN.VALUE = double(1),
         rows,
         function(row, group_tbl = lst) {
-          sum(vapply(
+          sum(
-            FUN.VALUE = logical(1),
+            vapply(
-            group_tbl,
+              FUN.VALUE = logical(1),
-            function(group) {
+              group_tbl,
-              any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
+              function(group) {
-            }
+                any(unlist(x[row, group[!is.na(group)], drop = TRUE]) %in% search_result, na.rm = TRUE)
-          ),
+              }
-          na.rm = TRUE
+            ),
+            na.rm = TRUE
           )
         }
       )
       # for PDR; all drugs are R (or I if combine_SI = FALSE)
       x_transposed <- as.list(as.data.frame(t(x[rows, lst_vector, drop = FALSE]),
-                                            stringsAsFactors = FALSE
+        stringsAsFactors = FALSE
       ))
       row_filter <- vapply(FUN.VALUE = logical(1), x_transposed, function(y) all(y %in% search_result, na.rm = TRUE))
       x[which(row_filter), "classes_affected"] <<- 999
     }
-    
+
     if (isTRUE(info)) {
       message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
     }
   }
-  
+
   x[, col_mo] <- as.mo(as.character(x[, col_mo, drop = TRUE]))
   # rename col_mo to prevent interference with joined columns
   colnames(x)[colnames(x) == col_mo] <- ".col_mo"
@@ -782,12 +786,12 @@ mdro <- function(x = NULL,
   x$row_number <- seq_len(nrow(x))
   x$reason <- paste0("not covered by ", toupper(guideline$code), " guideline")
   x$columns_nonsusceptible <- ""
-  
+
   if (guideline$code == "cmi2012") {
     # CMI, 2012 ---------------------------------------------------------------
     # Non-susceptible = R and I
     # (see header 'Approaches to Creating Definitions for MDR, XDR and PDR' in paper)
-    
+
     # take amoxicillin if ampicillin is unavailable
     if (is.na(AMP) && !is.na(AMX)) {
       if (isTRUE(verbose)) {
@@ -808,87 +812,87 @@ mdro <- function(x = NULL,
       }
       CTX <- CRO
     }
-    
+
     # intrinsic resistant must not be considered for the determination of MDR,
     # so let's just remove them, meticulously following the paper
     x[which(x$genus == "Enterococcus" & x$species == "faecium"), ab_NA(IPM)] <- NA
     x[which(x$genus == "Enterococcus" & x$species == "faecalis"), ab_NA(QDA)] <- NA
     x[which((x$genus == "Providencia" & x$species == "rettgeri") |
-              (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(GEN, TOB, NET))] <- NA
+      (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(GEN, TOB, NET))] <- NA
     x[which(x$genus == "Escherichia" & x$species == "hermannii"), ab_NA(c(TCC, TZP))] <- NA
     x[which((x$genus == "Citrobacter" & x$species == "freundii") |
-              (x$genus == "Enterobacter" & x$species == "aerogenes") |
+      (x$genus == "Enterobacter" & x$species == "aerogenes") |
-              (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
+      (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
-            | (x$genus == "Enterobacter" & x$species == "cloacae") |
+    | (x$genus == "Enterobacter" & x$species == "cloacae") |
-              (x$genus == "Hafnia" & x$species == "alvei") |
+      (x$genus == "Hafnia" & x$species == "alvei") |
-              (x$genus == "Morganella" & x$species == "morganii") |
+      (x$genus == "Morganella" & x$species == "morganii") |
-              (x$genus == "Proteus" & x$species == "penneri") |
+      (x$genus == "Proteus" & x$species == "penneri") |
-              (x$genus == "Proteus" & x$species == "vulgaris") |
+      (x$genus == "Proteus" & x$species == "vulgaris") |
-              (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CZO)] <- NA
+      (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CZO)] <- NA
     x[which((x$genus == "Morganella" & x$species == "morganii") |
-              (x$genus == "Proteus" & x$species == "penneri") |
+      (x$genus == "Proteus" & x$species == "penneri") |
-              (x$genus == "Proteus" & x$species == "vulgaris") |
+      (x$genus == "Proteus" & x$species == "vulgaris") |
-              (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CXM)] <- NA
+      (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CXM)] <- NA
     x[which((x$genus == "Morganella" & x$species == "morganii") |
-              (x$genus == "Proteus" & x$species == "mirabilis") |
+      (x$genus == "Proteus" & x$species == "mirabilis") |
-              (x$genus == "Proteus" & x$species == "penneri") |
+      (x$genus == "Proteus" & x$species == "penneri") |
-              (x$genus == "Proteus" & x$species == "vulgaris") |
+      (x$genus == "Proteus" & x$species == "vulgaris") |
-              (x$genus == "Providencia" & x$species == "rettgeri") |
+      (x$genus == "Providencia" & x$species == "rettgeri") |
-              (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TGC)] <- NA
+      (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TGC)] <- NA
     x[which((x$genus == "Citrobacter" & x$species == "koseri") |
-              (x$genus == "Citrobacter" & x$species == "freundii") |
+      (x$genus == "Citrobacter" & x$species == "freundii") |
-              (x$genus == "Enterobacter" & x$species == "aerogenes") |
+      (x$genus == "Enterobacter" & x$species == "aerogenes") |
-              (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
+      (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
-            | (x$genus == "Enterobacter" & x$species == "cloacae") |
+    | (x$genus == "Enterobacter" & x$species == "cloacae") |
-              (x$genus == "Escherichia" & x$species == "hermannii") |
+      (x$genus == "Escherichia" & x$species == "hermannii") |
-              (x$genus == "Hafnia" & x$species == "alvei") |
+      (x$genus == "Hafnia" & x$species == "alvei") |
-              (x$genus == "Klebsiella") |
+      (x$genus == "Klebsiella") |
-              (x$genus == "Morganella" & x$species == "morganii") |
+      (x$genus == "Morganella" & x$species == "morganii") |
-              (x$genus == "Proteus" & x$species == "penneri") |
+      (x$genus == "Proteus" & x$species == "penneri") |
-              (x$genus == "Proteus" & x$species == "vulgaris") |
+      (x$genus == "Proteus" & x$species == "vulgaris") |
-              (x$genus == "Providencia" & x$species == "rettgeri") |
+      (x$genus == "Providencia" & x$species == "rettgeri") |
-              (x$genus == "Providencia" & x$species == "stuartii") |
+      (x$genus == "Providencia" & x$species == "stuartii") |
-              (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMP)] <- NA
+      (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMP)] <- NA
     x[which((x$genus == "Citrobacter" & x$species == "freundii") |
-              (x$genus == "Enterobacter" & x$species == "aerogenes") |
+      (x$genus == "Enterobacter" & x$species == "aerogenes") |
-              (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
+      (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
-            | (x$genus == "Enterobacter" & x$species == "cloacae") |
+    | (x$genus == "Enterobacter" & x$species == "cloacae") |
-              (x$genus == "Hafnia" & x$species == "alvei") |
+      (x$genus == "Hafnia" & x$species == "alvei") |
-              (x$genus == "Morganella" & x$species == "morganii") |
+      (x$genus == "Morganella" & x$species == "morganii") |
-              (x$genus == "Providencia" & x$species == "rettgeri") |
+      (x$genus == "Providencia" & x$species == "rettgeri") |
-              (x$genus == "Providencia" & x$species == "stuartii") |
+      (x$genus == "Providencia" & x$species == "stuartii") |
-              (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMC)] <- NA
+      (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMC)] <- NA
     x[which((x$genus == "Citrobacter" & x$species == "freundii") |
-              (x$genus == "Citrobacter" & x$species == "koseri") |
+      (x$genus == "Citrobacter" & x$species == "koseri") |
-              (x$genus == "Enterobacter" & x$species == "aerogenes") |
+      (x$genus == "Enterobacter" & x$species == "aerogenes") |
-              (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
+      (x$genus == "Klebsiella" & x$species == "aerogenes") # new name (2017)
-            | (x$genus == "Enterobacter" & x$species == "cloacae") |
+    | (x$genus == "Enterobacter" & x$species == "cloacae") |
-              (x$genus == "Hafnia" & x$species == "alvei") |
+      (x$genus == "Hafnia" & x$species == "alvei") |
-              (x$genus == "Providencia" & x$species == "rettgeri") |
+      (x$genus == "Providencia" & x$species == "rettgeri") |
-              (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(SAM)] <- NA
+      (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(SAM)] <- NA
     x[which((x$genus == "Morganella" & x$species == "morganii") |
-              (x$genus == "Proteus" & x$species == "mirabilis") |
+      (x$genus == "Proteus" & x$species == "mirabilis") |
-              (x$genus == "Proteus" & x$species == "penneri") |
+      (x$genus == "Proteus" & x$species == "penneri") |
-              (x$genus == "Proteus" & x$species == "vulgaris") |
+      (x$genus == "Proteus" & x$species == "vulgaris") |
-              (x$genus == "Providencia" & x$species == "rettgeri") |
+      (x$genus == "Providencia" & x$species == "rettgeri") |
-              (x$genus == "Providencia" & x$species == "stuartii") |
+      (x$genus == "Providencia" & x$species == "stuartii") |
-              (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(COL)] <- NA
+      (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(COL)] <- NA
     x[which((x$genus == "Morganella" & x$species == "morganii") |
-              (x$genus == "Proteus" & x$species == "mirabilis") |
+      (x$genus == "Proteus" & x$species == "mirabilis") |
-              (x$genus == "Proteus" & x$species == "penneri") |
+      (x$genus == "Proteus" & x$species == "penneri") |
-              (x$genus == "Proteus" & x$species == "vulgaris") |
+      (x$genus == "Proteus" & x$species == "vulgaris") |
-              (x$genus == "Providencia" & x$species == "rettgeri") |
+      (x$genus == "Providencia" & x$species == "rettgeri") |
-              (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TCY)] <- NA
+      (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TCY)] <- NA
     x[which((x$genus == "Morganella" & x$species == "morganii") |
-              (x$genus == "Proteus" & x$species == "penneri") |
+      (x$genus == "Proteus" & x$species == "penneri") |
-              (x$genus == "Proteus" & x$species == "vulgaris") |
+      (x$genus == "Proteus" & x$species == "vulgaris") |
-              (x$genus == "Providencia" & x$species == "rettgeri") |
+      (x$genus == "Providencia" & x$species == "rettgeri") |
-              (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(DOX, MNO))] <- NA
+      (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(DOX, MNO))] <- NA
-    
+
     x$classes_in_guideline <- NA_integer_
     x$classes_available <- NA_integer_
     x$classes_affected <- NA_integer_
-    
+
     # now add the MDR levels to the data
     trans_tbl(
       2,
@@ -990,7 +994,7 @@ mdro <- function(x = NULL,
         c(TCY, DOX, MNO)
       )
     )
-    
+
     # now set MDROs:
     # MDR (=2): >=3 classes affected
     x[which(x$classes_affected >= 3), "MDRO"] <- 2
@@ -1002,7 +1006,7 @@ mdro <- function(x = NULL,
         " out of ", x$classes_available[which(x$classes_affected >= 3)], " available classes"
       )
     }
-    
+
     # XDR (=3): all but <=2 classes affected
     x[which((x$classes_in_guideline - x$classes_affected) <= 2), "MDRO"] <- 3
     if (isTRUE(verbose)) {
@@ -1011,7 +1015,7 @@ mdro <- function(x = NULL,
         " out of ", x$classes_in_guideline[which(x$MDRO == 3)], " classes)"
       )
     }
-    
+
     # PDR (=4): all drugs are R
     x[which(x$classes_affected == 999 & x$classes_in_guideline == x$classes_available), "MDRO"] <- 4
     if (isTRUE(verbose)) {
@@ -1022,7 +1026,7 @@ mdro <- function(x = NULL,
         ifelse(!isTRUE(combine_SI), " or I", "")
       )
     }
-    
+
     # not enough classes available
     x[which(x$MDRO %in% c(1, 3) & x$classes_available < floor(x$classes_in_guideline * pct_required_classes)), "MDRO"] <- -1
     if (isTRUE(verbose)) {
@@ -1032,18 +1036,18 @@ mdro <- function(x = NULL,
         " (~", percentage(pct_required_classes), " of ", x$classes_in_guideline[which(x$MDRO == -1)], ")"
       )
     }
-    
+
     # add antibiotic names of resistant ones to verbose output
   }
-  
+
   if (guideline$code == "eucast3.1") {
     # EUCAST 3.1 --------------------------------------------------------------
     # Table 5
     trans_tbl(
       3,
       which(x$order == "Enterobacterales" |
-              (x$genus == "Pseudomonas" & x$species == "aeruginosa") |
+        (x$genus == "Pseudomonas" & x$species == "aeruginosa") |
-              x$genus == "Acinetobacter"),
+        x$genus == "Acinetobacter"),
       COL,
       "all"
     )
@@ -1128,17 +1132,17 @@ mdro <- function(x = NULL,
       "any"
     )
   }
-  
+
   if (guideline$code == "eucast3.2") {
     # EUCAST 3.2 --------------------------------------------------------------
     # Table 6
     trans_tbl(
       3,
       which((x$order == "Enterobacterales" &
-               !x$family == "Morganellaceae" &
+        !x$family == "Morganellaceae" &
-               !(x$genus == "Serratia" & x$species == "marcescens")) |
+        !(x$genus == "Serratia" & x$species == "marcescens")) |
-              (x$genus == "Pseudomonas" & x$species == "aeruginosa") |
+        (x$genus == "Pseudomonas" & x$species == "aeruginosa") |
-              x$genus == "Acinetobacter"),
+        x$genus == "Acinetobacter"),
       COL,
       "all"
     )
@@ -1229,7 +1233,7 @@ mdro <- function(x = NULL,
       "any"
     )
   }
-  
+
   if (guideline$code == "eucast3.3") {
     # EUCAST 3.3 --------------------------------------------------------------
     # note: this guideline is equal to EUCAST 3.2 - no MDRO insights changed
@@ -1237,10 +1241,10 @@ mdro <- function(x = NULL,
     trans_tbl(
       3,
       which((x$order == "Enterobacterales" &
-               !x$family == "Morganellaceae" &
+        !x$family == "Morganellaceae" &
-               !(x$genus == "Serratia" & x$species == "marcescens")) |
+        !(x$genus == "Serratia" & x$species == "marcescens")) |
-              (x$genus == "Pseudomonas" & x$species == "aeruginosa") |
+        (x$genus == "Pseudomonas" & x$species == "aeruginosa") |
-              x$genus == "Acinetobacter"),
+        x$genus == "Acinetobacter"),
       COL,
       "all"
     )
@@ -1331,72 +1335,72 @@ mdro <- function(x = NULL,
       "any"
     )
   }
-  
+
   if (guideline$code == "mrgn") {
     # Germany -----------------------------------------------------------------
-    
+
     # Table 1
     trans_tbl(
       2, # 3MRGN
       which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
-               (x$genus == "Acinetobacter" & x$species == "baumannii")) &
+        (x$genus == "Acinetobacter" & x$species == "baumannii")) &
-              try_ab(x[, PIP, drop = TRUE] == "R") &
+        try_ab(x[, PIP, drop = TRUE] == "R") &
-              (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) &
+        (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) &
-              (try_ab(x[, IPM, drop = TRUE] != "R") | try_ab(x[, MEM, drop = TRUE] != "R")) &
+        (try_ab(x[, IPM, drop = TRUE] != "R") | try_ab(x[, MEM, drop = TRUE] != "R")) &
-              try_ab(x[, CIP, drop = TRUE] == "R")),
+        try_ab(x[, CIP, drop = TRUE] == "R")),
       c(PIP, CTX, CAZ, IPM, MEM, CIP),
       "any"
     )
-    
+
     trans_tbl(
       3, # 4MRGN, overwrites 3MRGN if applicable
       which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
-               (x$genus == "Acinetobacter" & x$species == "baumannii")) &
+        (x$genus == "Acinetobacter" & x$species == "baumannii")) &
-              try_ab(x[, PIP, drop = TRUE] == "R") &
+        try_ab(x[, PIP, drop = TRUE] == "R") &
-              (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) &
+        (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) &
-              (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) &
+        (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) &
-              try_ab(x[, CIP, drop = TRUE] == "R")),
+        try_ab(x[, CIP, drop = TRUE] == "R")),
       c(PIP, CTX, CAZ, IPM, MEM, CIP),
       "any"
     )
-    
+
     trans_tbl(
       3, # 4MRGN, overwrites 3MRGN if applicable
       which((x$order == "Enterobacterales" | # following in fact the old Enterobacteriaceae classification
-               (x$genus == "Acinetobacter" & x$species == "baumannii")) &
+        (x$genus == "Acinetobacter" & x$species == "baumannii")) &
-              (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R"))),
+        (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R"))),
       c(IPM, MEM),
       "any"
     )
-    
+
     trans_tbl(
       2, # 3MRGN, if only 1 group is S
       which(x$genus == "Pseudomonas" & x$species == "aeruginosa" &
-              try_ab(x[, PIP, drop = TRUE] == "S") +
+        try_ab(x[, PIP, drop = TRUE] == "S") +
-              try_ab(x[, CTX, drop = TRUE] == "S") +
+          try_ab(x[, CTX, drop = TRUE] == "S") +
-              try_ab(x[, CAZ, drop = TRUE] == "S") +
+          try_ab(x[, CAZ, drop = TRUE] == "S") +
-              try_ab(x[, IPM, drop = TRUE] == "S") +
+          try_ab(x[, IPM, drop = TRUE] == "S") +
-              try_ab(x[, MEM, drop = TRUE] == "S") +
+          try_ab(x[, MEM, drop = TRUE] == "S") +
-              try_ab(x[, CIP, drop = TRUE] == "S") == 1),
+          try_ab(x[, CIP, drop = TRUE] == "S") == 1),
       c(PIP, CTX, CAZ, IPM, MEM, CIP),
       "any"
     )
-    
+
     trans_tbl(
       3, # 4MRGN otherwise
       which((x$genus == "Pseudomonas" & x$species == "aeruginosa") &
-              try_ab(x[, PIP, drop = TRUE] == "R") &
+        try_ab(x[, PIP, drop = TRUE] == "R") &
-              (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) &
+        (try_ab(x[, CTX, drop = TRUE] == "R") | try_ab(x[, CAZ, drop = TRUE] == "R")) &
-              (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) &
+        (try_ab(x[, IPM, drop = TRUE] == "R") | try_ab(x[, MEM, drop = TRUE] == "R")) &
-              try_ab(x[, CIP, drop = TRUE] == "R")),
+        try_ab(x[, CIP, drop = TRUE] == "R")),
       c(PIP, CTX, CAZ, IPM, MEM, CIP),
       "any"
     )
-    
+
     x[which(x$MDRO == 2), "reason"] <- "3MRGN"
     x[which(x$MDRO == 3), "reason"] <- "4MRGN"
   }
-  
+
   if (guideline$code == "brmo") {
     # Netherlands -------------------------------------------------------------
     aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
@@ -1409,7 +1413,7 @@ mdro <- function(x = NULL,
     if (length(ESBLs) != 2) {
       ESBLs <- character(0)
     }
-    
+
     # Table 1
     trans_tbl(
       3,
@@ -1417,21 +1421,21 @@ mdro <- function(x = NULL,
       c(aminoglycosides, fluoroquinolones),
       "all"
     )
-    
+
     trans_tbl(
       2,
       which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification
       carbapenems,
       "any"
     )
-    
+
     trans_tbl(
       2,
       which(x$order == "Enterobacterales"), # following in fact the old Enterobacteriaceae classification
       ESBLs,
       "all"
     )
-    
+
     # Table 2
     trans_tbl(
       2,
@@ -1445,19 +1449,19 @@ mdro <- function(x = NULL,
       c(aminoglycosides, fluoroquinolones),
       "all"
     )
-    
+
     trans_tbl(
       3,
       which(x$genus == "Stenotrophomonas" & x$species == "maltophilia"),
       SXT,
       "all"
     )
-    
+
     if (!ab_missing(MEM) && !ab_missing(IPM) &&
-        !ab_missing(GEN) && !ab_missing(TOB) &&
+      !ab_missing(GEN) && !ab_missing(TOB) &&
-        !ab_missing(CIP) &&
+      !ab_missing(CIP) &&
-        !ab_missing(CAZ) &&
+      !ab_missing(CAZ) &&
-        !ab_missing(TZP)) {
+      !ab_missing(TZP)) {
       x$psae <- 0
       x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, MEM, drop = TRUE] == "R" | x[, IPM, drop = TRUE] == "R"), "psae"]
       x[which(x[, GEN, drop = TRUE] == "R" & x[, TOB, drop = TRUE] == "R"), "psae"] <- 1 + x[which(x[, GEN, drop = TRUE] == "R" & x[, TOB, drop = TRUE] == "R"), "psae"]
@@ -1477,7 +1481,7 @@ mdro <- function(x = NULL,
       x$genus == "Pseudomonas" & x$species == "aeruginosa" &
         x$psae >= 3
     ), "reason"] <- paste0("at least 3 classes contain R", ifelse(!isTRUE(combine_SI), " or I", ""))
-    
+
     # Table 3
     trans_tbl(
       3,
@@ -1498,7 +1502,7 @@ mdro <- function(x = NULL,
       "all"
     )
   }
-  
+
   if (guideline$code == "tb") {
     # Tuberculosis ------------------------------------------------------------
     prepare_drug <- function(ab) {
@@ -1535,7 +1539,7 @@ mdro <- function(x = NULL,
         ab != "R"
       }
     }
-    
+
     x$mono_count <- 0
     x[drug_is_R(INH), "mono_count"] <- x[drug_is_R(INH), "mono_count", drop = TRUE] + 1
     x[drug_is_R(RIF), "mono_count"] <- x[drug_is_R(RIF), "mono_count", drop = TRUE] + 1
@@ -1543,7 +1547,7 @@ mdro <- function(x = NULL,
     x[drug_is_R(PZA), "mono_count"] <- x[drug_is_R(PZA), "mono_count", drop = TRUE] + 1
     x[drug_is_R(RIB), "mono_count"] <- x[drug_is_R(RIB), "mono_count", drop = TRUE] + 1
     x[drug_is_R(RFP), "mono_count"] <- x[drug_is_R(RFP), "mono_count", drop = TRUE] + 1
-    
+
     x$mono <- x$mono_count > 0
     x$poly <- x$mono_count > 1 & drug_is_not_R(RIF) & drug_is_not_R(INH)
     x$mdr <- drug_is_R(RIF) & drug_is_R(INH)
@@ -1551,19 +1555,19 @@ mdro <- function(x = NULL,
     x$second <- drug_is_R(CAP) | drug_is_R(KAN) | drug_is_R(AMK)
     x$xdr <- x$mdr & x$xdr & x$second
     x$MDRO <- ifelse(x$xdr, 5,
-                     ifelse(x$mdr, 4,
+      ifelse(x$mdr, 4,
-                            ifelse(x$poly, 3,
+        ifelse(x$poly, 3,
-                                   ifelse(x$mono, 2,
+          ifelse(x$mono, 2,
-                                          1
+            1
-                                   )
+          )
-                            )
+        )
-                     )
+      )
     )
     # keep all real TB, make other species NA
     x$MDRO <- ifelse(x$fullname == "Mycobacterium tuberculosis", x$MDRO, NA_real_)
     x$reason <- "PDR/MDR/XDR criteria were met"
   }
-  
+
   # some more info on negative results
   if (isTRUE(verbose)) {
     if (guideline$code == "cmi2012") {
@@ -1579,7 +1583,7 @@ mdro <- function(x = NULL,
       x[which(x$MDRO == 1), "reason"] <- "too few antibiotics are R"
     }
   }
-  
+
   if (isTRUE(info.bak)) {
     cat(group_msg)
     if (sum(!is.na(x$MDRO)) == 0) {
@@ -1591,11 +1595,11 @@ mdro <- function(x = NULL,
       )))
     }
   }
-  
+
   # Fill in blanks ----
   # for rows that have no results
   x_transposed <- as.list(as.data.frame(t(x[, cols_ab, drop = FALSE]),
-                                        stringsAsFactors = FALSE
+    stringsAsFactors = FALSE
   ))
   rows_empty <- which(vapply(
     FUN.VALUE = logical(1),
@@ -1609,7 +1613,7 @@ mdro <- function(x = NULL,
   } else {
     cat("\n")
   }
-  
+
   # Results ----
   if (guideline$code == "cmi2012") {
     if (any(x$MDRO == -1, na.rm = TRUE)) {
@@ -1656,7 +1660,7 @@ mdro <- function(x = NULL,
       ordered = TRUE
     )
   }
-  
+
   if (isTRUE(verbose)) {
     colnames(x)[colnames(x) == col_mo] <- "microorganism"
     x$microorganism <- mo_name(x$microorganism, language = NULL)
@@ -1678,9 +1682,9 @@ mdro <- function(x = NULL,
 #' @export
 custom_mdro_guideline <- function(..., as_factor = TRUE) {
   meet_criteria(as_factor, allow_class = "logical", has_length = 1)
-  
+
   dots <- tryCatch(list(...),
-                   error = function(e) "error"
+    error = function(e) "error"
   )
   stop_if(
     identical(dots, "error"),
@@ -1694,7 +1698,7 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) {
       inherits(dots[[i]], "formula"),
       "rule ", i, " must be a valid formula input (e.g., using '~'), see `?mdro`"
     )
-    
+
     # Query
     qry <- dots[[i]][[2]]
     if (inherits(qry, "call")) {
@@ -1710,14 +1714,14 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) {
     qry <- gsub(" *([&|+-/*^><==]+) *", " \\1 ", qry)
     qry <- gsub("'", "\"", qry, fixed = TRUE)
     out[[i]]$query <- as.expression(qry)
-    
+
     # Value
     val <- tryCatch(eval(dots[[i]][[3]]), error = function(e) NULL)
     stop_if(is.null(val), "rule ", i, " must return a valid value, it now returns an error: ", tryCatch(eval(dots[[i]][[3]]), error = function(e) e$message))
     stop_if(length(val) > 1, "rule ", i, " must return a value of length 1, not ", length(val))
     out[[i]]$value <- as.character(val)
   }
-  
+
   names(out) <- paste0("rule", seq_len(n_dots))
   out <- set_clean_class(out, new_class = c("custom_mdro_guideline", "list"))
   attr(out, "values") <- unname(c("Negative", vapply(FUN.VALUE = character(1), unclass(out), function(x) x$value)))
@@ -1739,8 +1743,8 @@ c.custom_mdro_guideline <- function(x, ..., as_factor = NULL) {
   }
   for (g in list(...)) {
     stop_ifnot(inherits(g, "custom_mdro_guideline"),
-               "for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`",
+      "for combining custom MDRO guidelines, all rules must be created with `custom_mdro_guideline()`",
-               call = FALSE
+      call = FALSE
     )
     vals <- attributes(x)$values
     if (!all(attributes(g)$values %in% vals)) {
@@ -1790,28 +1794,28 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
   reasons <- character(length = NROW(df))
   for (i in seq_len(n_dots)) {
     qry <- tryCatch(eval(parse(text = guideline[[i]]$query), envir = df, enclos = parent.frame()),
-                    error = function(e) {
+      error = function(e) {
-                      AMR_env$err_msg <- e$message
+        AMR_env$err_msg <- e$message
-                      return("error")
+        return("error")
-                    }
+      }
     )
     if (identical(qry, "error")) {
       warning_("in `custom_mdro_guideline()`: rule ", i,
-               " (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
+        " (`", as.character(guideline[[i]]$query), "`) was ignored because of this error message: ",
-               AMR_env$err_msg,
+        AMR_env$err_msg,
-               call = FALSE,
+        call = FALSE,
-               add_fn = font_red
+        add_fn = font_red
       )
       next
     }
     stop_ifnot(is.logical(qry), "in custom_mdro_guideline(): rule ", i, " (`", guideline[[i]]$query,
-               "`) must return `TRUE` or `FALSE`, not ",
+      "`) must return `TRUE` or `FALSE`, not ",
-               format_class(class(qry), plural = FALSE),
+      format_class(class(qry), plural = FALSE),
-               call = FALSE
+      call = FALSE
     )
-    
+
     new_mdros <- which(qry == TRUE & out == "")
-    
+
     if (isTRUE(info)) {
       cat(word_wrap(
         "- Custom MDRO rule ", i, ": `", as.character(guideline[[i]]$query),
@@ -1827,11 +1831,11 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
   }
   out[out == ""] <- "Negative"
   reasons[out == "Negative"] <- "no rules matched"
-  
+
   if (isTRUE(attributes(guideline)$as_factor)) {
     out <- factor(out, levels = attributes(guideline)$values, ordered = TRUE)
   }
-  
+
   columns_nonsusceptible <- as.data.frame(t(df[, is.sir(df), drop = FALSE] == "R"))
   columns_nonsusceptible <- vapply(
     FUN.VALUE = character(1),
@@ -1839,7 +1843,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
     function(x) paste0(rownames(columns_nonsusceptible)[which(x)], collapse = " ")
   )
   columns_nonsusceptible[is.na(out)] <- NA_character_
-  
+
   data.frame(
     row_number = seq_len(NROW(df)),
     MDRO = out,

R/mean_amr_distance.R

@@ -49,13 +49,13 @@
 #' sir <- random_sir(10)
 #' sir
 #' mean_amr_distance(sir)
-#' 
+#'
 #' mic <- random_mic(10)
 #' mic
 #' mean_amr_distance(mic)
 #' # equal to the Z-score of their log2:
 #' (log2(mic) - mean(log2(mic))) / sd(log2(mic))
-#' 
+#'
 #' disk <- random_disk(10)
 #' disk
 #' mean_amr_distance(disk)
@@ -143,7 +143,7 @@ mean_amr_distance.data.frame <- function(x, ..., combine_SI = TRUE) {
   df_classes <- colnames(df)[vapply(FUN.VALUE = logical(1), df, function(x) is.disk(x) | is.mic(x) | is.disk(x), USE.NAMES = FALSE)]
   df_antibiotics <- unname(get_column_abx(df, info = FALSE))
   df <- df[, colnames(df)[colnames(df) %in% union(df_classes, df_antibiotics)], drop = FALSE]
-  
+
   stop_if(ncol(df) < 2,
     "data set must contain at least two variables",
     call = -2
@@ -151,7 +151,7 @@ mean_amr_distance.data.frame <- function(x, ..., combine_SI = TRUE) {
   if (message_not_thrown_before("mean_amr_distance", "groups")) {
     message_("Calculating mean AMR distance based on columns ", vector_and(colnames(df), sort = FALSE))
   }
-  
+
   res <- vapply(
     FUN.VALUE = double(nrow(df)),
     df,

R/mic.R

@@ -230,13 +230,13 @@ as.mic <- function(x, na.rm = FALSE) {
         vector_and(quotes = TRUE)
       cur_col <- get_current_column()
       warning_("in `as.mic()`: ", na_after - na_before, " result",
-               ifelse(na_after - na_before > 1, "s", ""),
+        ifelse(na_after - na_before > 1, "s", ""),
-               ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
+        ifelse(is.null(cur_col), "", paste0(" in column '", cur_col, "'")),
-               " truncated (",
+        " truncated (",
-               round(((na_after - na_before) / length(x)) * 100),
+        round(((na_after - na_before) / length(x)) * 100),
-               "%) that were invalid MICs: ",
+        "%) that were invalid MICs: ",
-               list_missing,
+        list_missing,
-               call = FALSE
+        call = FALSE
       )
     }
 

R/mo.R

@@ -183,12 +183,12 @@ as.mo <- function(x,
   x <- replace_ignore_pattern(x, ignore_pattern)
 
   x_lower <- tolower(x)
-  
+
   complexes <- x[trimws2(x_lower) %like_case% " (complex|group)$"]
   if (length(complexes) > 0 && identical(remove_from_input, mo_cleaning_regex()) && !any(AMR_env$MO_lookup$fullname[which(AMR_env$MO_lookup$source == "Added by user")] %like% "(group|complex)", na.rm = TRUE)) {
     warning_("in `as.mo()`: 'complex' and 'group' were ignored from the input in ", length(complexes), " case", ifelse(length(complexes) > 1, "s", ""), ", as they are currently not supported.\nYou can add your own microorganism with `add_custom_microorganisms()`.", call = FALSE)
   }
-  
+
   # WHONET: xxx = no growth
   x[x_lower %in% c("", "xxx", "na", "nan")] <- NA_character_
 
@@ -274,7 +274,7 @@ as.mo <- function(x,
 
       # take out the parts, split by space
       x_parts <- strsplit(gsub("-", " ", x_out, fixed = TRUE), " ", fixed = TRUE)[[1]]
-      
+
       # do a pre-match on first character (and if it contains a space, first chars of first two terms)
       if (length(x_parts) %in% c(2, 3)) {
         # for genus + species + subspecies
@@ -313,13 +313,13 @@ as.mo <- function(x,
       } else {
         minimum_matching_score_current <- minimum_matching_score
       }
-      
+
       if (sum(m >= minimum_matching_score_current) > 10) {
         # at least 10 are left over, make the ones under `m` NA
-        m[m < minimum_matching_score_current] <- NA_real_  
+        m[m < minimum_matching_score_current] <- NA_real_
       }
-      
+
-      top_hits <- mo_to_search[order(m, decreasing = TRUE, na.last = NA)] # na.last = NA will remove the NAs  
+      top_hits <- mo_to_search[order(m, decreasing = TRUE, na.last = NA)] # na.last = NA will remove the NAs
       if (length(top_hits) == 0) {
         warning_("No hits found for \"", x_search, "\" with minimum_matching_score = ", ifelse(is.null(minimum_matching_score), paste0("NULL (=", round(min(minimum_matching_score_current, na.rm = TRUE), 3), ")"), minimum_matching_score), ". Try setting this value lower or even to 0.", call = FALSE)
         result_mo <- NA_character_
@@ -365,18 +365,19 @@ as.mo <- function(x,
           plural <- c("s", "these uncertainties")
         }
         if (length(AMR_env$mo_uncertainties$original_input) <= 3) {
-          examples <- vector_and(paste0(
+          examples <- vector_and(
-            '"', AMR_env$mo_uncertainties$original_input,
+            paste0(
-            '" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")"
+              '"', AMR_env$mo_uncertainties$original_input,
-          ),
+              '" (assumed ', italicise(AMR_env$mo_uncertainties$fullname), ")"
-          quotes = FALSE
+            ),
+            quotes = FALSE
           )
         } else {
           examples <- paste0(nr2char(length(AMR_env$mo_uncertainties$original_input)), " microorganism", plural[1])
         }
         msg <- c(msg, paste0(
           "Microorganism translation was uncertain for ", examples,
-          ". Run `mo_uncertainties()` to review ", plural[2], ", or use `add_custom_microorganisms()` to add own entries."
+          ". Run `mo_uncertainties()` to review ", plural[2], ", or use `add_custom_microorganisms()` to add custom entries."
         ))
 
         for (m in msg) {
@@ -442,7 +443,7 @@ as.mo <- function(x,
   # Apply Lancefield ----
   if (isTRUE(Lancefield) || Lancefield == "all") {
     # (using `%like_case%` to also match subspecies)
-    
+
     # group A - S. pyogenes
     out[out %like_case% "^B_STRPT_PYGN(_|$)"] <- "B_STRPT_GRPA"
     # group B - S. agalactiae
@@ -560,7 +561,7 @@ pillar_shaft.mo <- function(x, ...) {
   # markup NA and UNKNOWN
   out[is.na(x)] <- font_na("  NA")
   out[x == "UNKNOWN"] <- font_na("  UNKNOWN")
-  
+
   # markup manual codes
   out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo] <- font_blue(out[x %in% AMR_env$MO_lookup$mo & !x %in% AMR::microorganisms$mo], collapse = NULL)
 
@@ -577,10 +578,11 @@ pillar_shaft.mo <- function(x, ...) {
   if (!all(x %in% all_mos) ||
     (!is.null(df) && !all(unlist(df[, which(mo_cols), drop = FALSE]) %in% all_mos))) {
     # markup old mo codes
-    out[!x %in% all_mos] <- font_italic(font_na(x[!x %in% all_mos],
+    out[!x %in% all_mos] <- font_italic(
+      font_na(x[!x %in% all_mos],
+        collapse = NULL
+      ),
       collapse = NULL
-    ),
-    collapse = NULL
     )
     # throw a warning with the affected column name(s)
     if (!is.null(mo_cols)) {
@@ -797,7 +799,7 @@ print.mo_uncertainties <- function(x, ...) {
     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))
   }
-  
+
   add_MO_lookup_to_AMR_env()
 
   cat(word_wrap("Matching scores are based on the resemblance between the input and the full taxonomic name, and the pathogenicity in humans. See `?mo_matching_score`.\n\n", add_fn = font_blue))
@@ -819,7 +821,7 @@ print.mo_uncertainties <- function(x, ...) {
     text[scores < 0.5] <- font_red_bg(text[scores < 0.5], collapse = NULL)
     text
   }
-  
+
   txt <- ""
   for (i in seq_len(nrow(x))) {
     if (x[i, ]$candidates != "") {
@@ -835,21 +837,23 @@ print.mo_uncertainties <- function(x, ...) {
       candidates_formatted <- candidates_formatted[order(1 - scores)]
       scores_formatted <- scores_formatted[order(1 - scores)]
 
-      candidates <- word_wrap(paste0(
+      candidates <- word_wrap(
-        "Also matched: ",
+        paste0(
-        vector_and(paste0(
+          "Also matched: ",
-          candidates_formatted,
+          vector_and(
-          font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
+            paste0(
+              candidates_formatted,
+              font_blue(paste0(" (", scores_formatted, ")"), collapse = NULL)
+            ),
+            quotes = FALSE, sort = FALSE
+          ),
+          ifelse(n_candidates == 25,
+            font_grey(" [showing first 25]"),
+            ""
+          )
         ),
-        quotes = FALSE, sort = FALSE
+        extra_indent = nchar("Also matched: "),
-        ),
+        width = 0.9 * getOption("width", 100)
-        ifelse(n_candidates == 25,
-          font_grey(" [showing first 25]"),
-          ""
-        )
-      ),
-      extra_indent = nchar("Also matched: "),
-      width = 0.9 * getOption("width", 100)
       )
     } else {
       candidates <- ""
@@ -954,17 +958,17 @@ convert_colloquial_input <- function(x) {
   out[x %like_case% "mil+er+i gr"] <- "B_STRPT_MILL"
   out[x %like_case% "((strepto|^s).* viridans|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI"
   out[x %like_case% "(viridans.* (strepto|^s).*|^vgs[^a-z]*$)"] <- "B_STRPT_VIRI"
-  
+
   # Salmonella in different languages, like "Salmonella grupo B"
   out[x %like_case% "salmonella.* [bcd]$"] <- gsub(".*salmonella.* ([bcd])$",
-                                                               "B_SLMNL_GRP\\U\\1",
+    "B_SLMNL_GRP\\U\\1",
-                                                               x[x %like_case% "salmonella.* [bcd]$"],
+    x[x %like_case% "salmonella.* [bcd]$"],
-                                                               perl = TRUE
+    perl = TRUE
   )
   out[x %like_case% "group [bcd] salmonella"] <- gsub(".*group ([bcd]) salmonella*",
-                                                                  "B_SLMNL_GRP\\U\\1",
+    "B_SLMNL_GRP\\U\\1",
-                                                                  x[x %like_case% "group [bcd] salmonella"],
+    x[x %like_case% "group [bcd] salmonella"],
-                                                                  perl = TRUE
+    perl = TRUE
   )
 
   # CoNS/CoPS in different languages (support for German, Dutch, Spanish, Portuguese)
@@ -999,10 +1003,14 @@ convert_colloquial_input <- function(x) {
 
 italicise <- function(x) {
   out <- font_italic(x, collapse = NULL)
-  out[x %like_case% "Salmonella [A-Z]"] <- paste(font_italic("Salmonella"), 
+  out[x %like_case% "Salmonella [A-Z]"] <- paste(
-                                                 gsub("Salmonella ", "", x[x %like_case% "Salmonella [A-Z]"]))
+    font_italic("Salmonella"),
-  out[x %like_case% "Streptococcus [A-Z]"] <- paste(font_italic("Streptococcus"), 
+    gsub("Salmonella ", "", x[x %like_case% "Salmonella [A-Z]"])
-                                                    gsub("Streptococcus ", "", x[x %like_case% "Streptococcus [A-Z]"]))
+  )
+  out[x %like_case% "Streptococcus [A-Z]"] <- paste(
+    font_italic("Streptococcus"),
+    gsub("Streptococcus ", "", x[x %like_case% "Streptococcus [A-Z]"])
+  )
   if (has_colour()) {
     out <- gsub("(Group|group|Complex|complex)(\033\\[23m)?", "\033[23m\\1", out, perl = TRUE)
   }

R/mo_matching_score.R

@@ -34,13 +34,13 @@
 #' @param x Any user input value(s)
 #' @param n A full taxonomic name, that exists in [`microorganisms$fullname`][microorganisms]
 #' @note This algorithm was originally described in: Berends MS *et al.* (2022). **AMR: An R Package for Working with Antimicrobial Resistance Data**. *Journal of Statistical Software*, 104(3), 1-31; \doi{10.18637/jss.v104.i03}.
-#' 
+#'
 #' Later, the work of Bartlett A *et al.* about bacterial pathogens infecting humans (2022, \doi{10.1099/mic.0.001269}) was incorporated.
 #' @section Matching Score for Microorganisms:
 #' With ambiguous user input in [as.mo()] and all the [`mo_*`][mo_property()] functions, the returned results are chosen based on their matching score using [mo_matching_score()]. This matching score \eqn{m}, is calculated as:
 #'
 #' \ifelse{latex}{\deqn{m_{(x, n)} = \frac{l_{n} - 0.5 \cdot \min \begin{cases}l_{n} \\ \textrm{lev}(x, n)\end{cases}}{l_{n} \cdot p_{n} \cdot k_{n}}}}{
-#' 
+#'
 #' \ifelse{html}{\figure{mo_matching_score.png}{options: width="300" alt="mo matching score"}}{m(x, n) = ( l_n * min(l_n, lev(x, n) ) ) / ( l_n * p_n * k_n )}}
 #'
 #' where:
@@ -53,12 +53,12 @@
 #' * \eqn{k_n} is the taxonomic kingdom of \eqn{n}, set as Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5.
 #'
 #' The grouping into human pathogenic prevalence \eqn{p} is based on recent work from Bartlett *et al.* (2022, \doi{10.1099/mic.0.001269}) who extensively studied medical-scientific literature to categorise all bacterial species into these groups:
-#' 
+#'
 #' - **Established**, if a taxonomic species has infected at least three persons in three or more references. These records have `prevalence = 1.0` in the [microorganisms] data set;
 #' - **Putative**, if a taxonomic species has fewer than three known cases. These records have `prevalence = 1.25` in the [microorganisms] data set.
-#' 
+#'
 #' Furthermore,
-#' 
+#'
 #' - Any genus present in the **established** list also has `prevalence = 1.0` in the [microorganisms] data set;
 #' - Any other genus present in the **putative** list has `prevalence = 1.25` in the [microorganisms] data set;
 #' - Any other species or subspecies of which the genus is present in the two aforementioned groups, has `prevalence = 1.5` in the [microorganisms] data set;
@@ -72,7 +72,7 @@
 #' @inheritSection AMR Reference Data Publicly Available
 #' @examples
 #' mo_reset_session()
-#' 
+#'
 #' as.mo("E. coli")
 #' mo_uncertainties()
 #'
@@ -95,7 +95,7 @@ mo_matching_score <- function(x, n) {
 
   # force a capital letter, so this conversion will not count as a substitution
   substr(x, 1, 1) <- toupper(substr(x, 1, 1))
-  
+
   # n is always a taxonomically valid full name
   if (length(n) == 1) {
     n <- rep(n, length(x))
@@ -103,7 +103,7 @@ mo_matching_score <- function(x, n) {
   if (length(x) == 1) {
     x <- rep(x, length(n))
   }
-  
+
   # length of fullname
   l_n <- nchar(n)
   lev <- double(length = length(x))
@@ -126,7 +126,7 @@ mo_matching_score <- function(x, n) {
   p_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "prevalence", drop = TRUE]
   # kingdom index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5)
   k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "kingdom_index", drop = TRUE]
-  
+
   # matching score:
   (l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n)
 }

R/mo_property.R

@@ -133,7 +133,6 @@
 #' mo_fullname("K. pneu rh")
 #' mo_shortname("K. pneu rh")
 #'
-#'
 #' \donttest{
 #' # Becker classification, see ?as.mo ----------------------------------------
 #'
@@ -158,7 +157,7 @@
 #' mo_gramstain("Klebsiella pneumoniae", language = "es") # Spanish
 #' mo_gramstain("Klebsiella pneumoniae", language = "el") # Greek
 #' mo_gramstain("Klebsiella pneumoniae", language = "uk") # Ukrainian
-#' 
+#'
 #' # mo_type is equal to mo_kingdom, but mo_kingdom will remain untranslated
 #' mo_kingdom("Klebsiella pneumoniae")
 #' mo_type("Klebsiella pneumoniae")
@@ -426,17 +425,23 @@ mo_pathogenicity <- function(x, language = get_AMR_locale(), keep_synonyms = get
   kngd <- AMR_env$MO_lookup$kingdom[match(x.mo, AMR_env$MO_lookup$mo)]
   rank <- AMR_env$MO_lookup$rank[match(x.mo, AMR_env$MO_lookup$mo)]
 
-  out <- factor(ifelse(prev == 1 & kngd == "Bacteria" & rank != "genus",
+  out <- factor(
-                       "Pathogenic",
+    ifelse(prev == 1 & kngd == "Bacteria" & rank != "genus",
-                       ifelse(prev < 2 & kngd == "Fungi",
+      "Pathogenic",
-                              "Potentially pathogenic",
+      ifelse(prev < 2 & kngd == "Fungi",
-                              ifelse(prev == 2 & kngd == "Bacteria",
+        "Potentially pathogenic",
-                                     "Non-pathogenic",
+        ifelse(prev == 2 & kngd == "Bacteria",
-                                     ifelse(kngd == "Bacteria",
+          "Non-pathogenic",
-                                            "Potentially pathogenic",
+          ifelse(kngd == "Bacteria",
-                                            "Unknown")))),
+            "Potentially pathogenic",
-                levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
+            "Unknown"
-                ordered = TRUE)
+          )
+        )
+      )
+    ),
+    levels = c("Pathogenic", "Potentially pathogenic", "Non-pathogenic", "Unknown"),
+    ordered = TRUE
+  )
 
   load_mo_uncertainties(metadata)
   out
@@ -727,7 +732,7 @@ mo_synonyms <- function(x, language = get_AMR_locale(), keep_synonyms = getOptio
   meet_criteria(x, allow_NA = TRUE)
   language <- validate_language(language)
   meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
-  
+
   add_MO_lookup_to_AMR_env()
 
   x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
@@ -815,7 +820,7 @@ mo_url <- function(x, open = FALSE, language = get_AMR_locale(), keep_synonyms =
   meet_criteria(open, allow_class = "logical", has_length = 1)
   language <- validate_language(language)
   meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
-  
+
   add_MO_lookup_to_AMR_env()
 
   x.mo <- as.mo(x = x, language = language, keep_synonyms = keep_synonyms, ... = ...)
@@ -862,7 +867,7 @@ mo_property <- function(x, property = "fullname", language = get_AMR_locale(), k
 
 mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ...) {
   add_MO_lookup_to_AMR_env()
-  
+
   # try to catch an error when inputting an invalid argument
   # so the 'call.' can be set to FALSE
   tryCatch(x[1L] %in% unlist(AMR_env$MO_lookup[1, property, drop = TRUE]),

R/mo_source.R

@@ -262,7 +262,7 @@ get_mo_source <- function(destination = getOption("AMR_mo_source", "~/mo_source.
 
 check_validity_mo_source <- function(x, refer_to_name = "`reference_df`", stop_on_error = TRUE) {
   add_MO_lookup_to_AMR_env()
-  
+
   if (paste(deparse(substitute(x)), collapse = "") == "get_mo_source()") {
     return(TRUE)
   }

R/proportion.R

@@ -140,7 +140,6 @@
 #'     )
 #' }
 #' if (require("dplyr")) {
-#'
 #'   # scoped dplyr verbs with antibiotic selectors
 #'   # (you could also use across() of course)
 #'   example_isolates %>%

R/resistance_predict.R

@@ -274,7 +274,7 @@ resistance_predict <- function(x,
   df_prediction$value <- ifelse(df_prediction$value > 1, 1, pmax(df_prediction$value, 0))
   df_prediction <- df_prediction[order(df_prediction$year), , drop = FALSE]
 
-  out <- as_original_data_class(df_prediction, class(x.bak))  # will remove tibble groups
+  out <- as_original_data_class(df_prediction, class(x.bak)) # will remove tibble groups
   structure(out,
     class = c("resistance_predict", class(out)),
     I_as_S = I_as_S,

R/sir.R

@@ -64,16 +64,16 @@
 #'      ```
 #' 4. For **interpreting a complete data set**, with automatic determination of MIC values, disk diffusion diameters, microorganism names or codes, and antimicrobial test results. This is done very simply by running `as.sir(your_data)`.
 #'
-#' For points 2, 3 and 4: Use [sir_interpretation_history()] to retrieve a [data.frame] (or [tibble][tibble::tibble()] if the `tibble` package is installed) with all results of the last [as.sir()] call.
+#' **For points 2, 3 and 4: Use [sir_interpretation_history()]** to retrieve a [data.frame] (or [tibble][tibble::tibble()] if the `tibble` package is installed) with all results of the last [as.sir()] call.
 #'
 #' ### Supported Guidelines
 #'
 #' For interpreting MIC values as well as disk diffusion diameters, currently implemented guidelines are EUCAST (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline)))`) and CLSI (`r min(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`-`r max(as.integer(gsub("[^0-9]", "", subset(clinical_breakpoints, guideline %like% "CLSI")$guideline)))`).
 #'
 #' Thus, the `guideline` argument must be set to e.g., ``r paste0('"', subset(clinical_breakpoints, guideline %like% "EUCAST")$guideline[1], '"')`` or ``r paste0('"', subset(clinical_breakpoints, guideline %like% "CLSI")$guideline[1], '"')``. By simply using `"EUCAST"` (the default) or `"CLSI"` as input, the latest included version of that guideline will automatically be selected. You can set your own data set using the `reference_data` argument. The `guideline` argument will then be ignored.
-#' 
+#'
 #' You can set the default guideline with the `AMR_guideline` [option][options()] (e.g. in your `.Rprofile` file), such as:
-#' 
+#'
 #' ```
 #'   options(AMR_guideline = "CLSI")
 #'   options(AMR_guideline = "CLSI 2018")
@@ -104,7 +104,7 @@
 #'   A microorganism is categorised as "Susceptible, Increased exposure*" when there is a high likelihood of therapeutic success because exposure to the agent is increased by adjusting the dosing regimen or by its concentration at the site of infection.
 #' - **R = Resistant**\cr
 #'   A microorganism is categorised as "Resistant" when there is a high likelihood of therapeutic failure even when there is increased exposure.
-#'   
+#'
 #'   * *Exposure* is a function of how the mode of administration, dose, dosing interval, infusion time, as well as distribution and excretion of the antimicrobial agent will influence the infecting organism at the site of infection.
 #'
 #' This AMR package honours this insight. Use [susceptibility()] (equal to [proportion_SI()]) to determine antimicrobial susceptibility and [count_susceptible()] (equal to [count_SI()]) to count susceptible isolates.
@@ -297,7 +297,7 @@ as.sir.default <- function(x, ...) {
 
   x.bak <- x
   x <- as.character(x) # this is needed to prevent the vctrs pkg from throwing an error
-  
+
   if (inherits(x.bak, c("integer", "numeric", "double")) && all(x %in% c(1:3, NA))) {
     # support haven package for importing e.g., from SPSS - it adds the 'labels' attribute
     lbls <- attributes(x.bak)$labels
@@ -328,7 +328,7 @@ as.sir.default <- function(x, ...) {
     x <- trimws2(as.character(unlist(x)))
     x[x %in% c(NA, "", "-", "NULL")] <- NA_character_
     x.bak <- x
-    
+
     na_before <- length(x[is.na(x)])
 
     # correct for translations
@@ -768,13 +768,13 @@ as_sir_method <- function(method_short,
   if (length(uti) == 1) {
     uti <- rep(uti, length(x))
   }
-  
+
   if (isTRUE(add_intrinsic_resistance) && guideline_coerced %unlike% "EUCAST") {
     if (message_not_thrown_before("as.sir", "intrinsic")) {
       warning_("in `as.sir()`: using 'add_intrinsic_resistance' is only useful when using EUCAST guidelines, since the rules for intrinsic resistance are based on EUCAST.")
     }
   }
-  
+
   agent_formatted <- paste0("'", font_bold(ab.bak), "'")
   agent_name <- ab_name(ab, tolower = TRUE, language = NULL)
   if (generalise_antibiotic_name(ab.bak) == generalise_antibiotic_name(agent_name)) {
@@ -801,27 +801,31 @@ as_sir_method <- function(method_short,
     appendLF = FALSE,
     as_note = FALSE
   )
-  
+
   msg_note <- function(messages) {
     for (i in seq_len(length(messages))) {
       messages[i] <- word_wrap(extra_indent = 5, messages[i])
     }
-    message(font_green(font_bold(" Note:\n")),
+    message(
-            paste0("   ", font_black(AMR_env$bullet_icon)," ", font_black(messages, collapse = NULL) , collapse = "\n"))
+      font_green(font_bold(" Note:\n")),
+      paste0("   ", font_black(AMR_env$bullet_icon), " ", font_black(messages, collapse = NULL), collapse = "\n")
+    )
   }
 
   method <- method_short
 
   metadata_mo <- get_mo_uncertainties()
 
-  df <- data.frame(values = x,
+  df <- data.frame(
-                   mo = mo,
+    values = x,
-                   result = NA_sir_,
+    mo = mo,
-                   uti = uti,
+    result = NA_sir_,
-                   stringsAsFactors = FALSE)
+    uti = uti,
+    stringsAsFactors = FALSE
+  )
   if (method == "mic") {
     # when as.sir.mic is called directly
-    df$values <- as.mic(df$values) 
+    df$values <- as.mic(df$values)
   } else if (method == "disk") {
     # when as.sir.disk is called directly
     df$values <- as.disk(df$values)
@@ -832,7 +836,7 @@ as_sir_method <- function(method_short,
   method_coerced <- toupper(method)
   ab_coerced <- ab
   mo_coerced <- mo
-  
+
   if (identical(reference_data, AMR::clinical_breakpoints)) {
     breakpoints <- reference_data %pm>%
       subset(guideline == guideline_coerced & method == method_coerced & ab == ab_coerced)
@@ -845,30 +849,31 @@ as_sir_method <- function(method_short,
     breakpoints <- reference_data %pm>%
       subset(method == method_coerced & ab == ab_coerced)
   }
-  
+
   msgs <- character(0)
   if (nrow(breakpoints) == 0) {
     # apparently no breakpoints found
-    msg_note(paste0("No ", method_coerced, " breakpoints available for ",
+    msg_note(paste0(
-                    suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
+      "No ", method_coerced, " breakpoints available for ",
-                    " (", ab_coerced, ")"))
+      suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
+      " (", ab_coerced, ")"
+    ))
     load_mo_uncertainties(metadata_mo)
     return(rep(NA_sir_, nrow(df)))
   }
-  
+
   if (guideline_coerced %like% "EUCAST") {
     any_is_intrinsic_resistant <- FALSE
     add_intrinsic_resistance_to_AMR_env()
   }
-  
+
   # run the rules
   for (mo_unique in unique(df$mo)) {
-    
     rows <- which(df$mo == mo_unique)
     values <- df[rows, "values", drop = TRUE]
     uti <- df[rows, "uti", drop = TRUE]
     new_sir <- rep(NA_sir_, length(rows))
-    
+
     # find different mo properties
     mo_current_genus <- as.mo(mo_genus(mo_unique, language = NULL))
     mo_current_family <- as.mo(mo_family(mo_unique, language = NULL))
@@ -890,17 +895,21 @@ as_sir_method <- function(method_short,
     if (!mo_rank(mo_unique) %in% c("kingdom", "phylum", "class", "order")) {
       mo_formatted <- font_italic(mo_formatted)
     }
-    ab_formatted <- paste0(suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))), 
+    ab_formatted <- paste0(
-                           " (", ab_coerced, ")")
+      suppressMessages(suppressWarnings(ab_name(ab_coerced, language = NULL, tolower = TRUE))),
-    
+      " (", ab_coerced, ")"
-    # gather all available breakpoints for current MO and sort on taxonomic rank 
+    )
+
+    # gather all available breakpoints for current MO and sort on taxonomic rank
     # (this will prefer species breakpoints over order breakpoints)
     breakpoints_current <- breakpoints %pm>%
-      subset(mo %in% c(mo_current_genus, mo_current_family,
+      subset(mo %in% c(
-                       mo_current_order, mo_current_class,
+        mo_current_genus, mo_current_family,
-                       mo_current_becker, mo_current_lancefield,
+        mo_current_order, mo_current_class,
-                       mo_current_other))
+        mo_current_becker, mo_current_lancefield,
-    
+        mo_current_other
+      ))
+
     if (any(df[rows, "uti", drop = TRUE], na.rm = TRUE)) {
       breakpoints_current <- breakpoints_current %pm>%
         # be as specific as possible (i.e. prefer species over genus):
@@ -911,7 +920,7 @@ as_sir_method <- function(method_short,
         # sort UTI = FALSE first, then UTI = TRUE
         pm_arrange(rank_index, uti)
     }
-    
+
     # throw notes for different body sites
     if (nrow(breakpoints_current) == 1 && all(breakpoints_current$uti == TRUE) && any(uti %in% c(FALSE, NA)) && message_not_thrown_before("as.sir", "uti", ab_coerced)) {
       # only UTI breakpoints available
@@ -932,16 +941,15 @@ as_sir_method <- function(method_short,
       }
       msgs <- c(msgs, paste0("Multiple breakpoints available for ", ab_formatted, " in ", mo_formatted, " - assuming ", site, "."))
     }
-    
+
     # first check if mo is intrinsic resistant
     if (isTRUE(add_intrinsic_resistance) && guideline_coerced %like% "EUCAST" && paste(mo_unique, ab_coerced) %in% AMR_env$intrinsic_resistant) {
       msgs <- c(msgs, paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, ""))
       new_sir <- rep(as.sir("R"), length(rows))
-      
     } else {
       # then run the rules
       breakpoints_current <- breakpoints_current[1L, , drop = FALSE]
-      
+
       if (method == "mic") {
         new_sir <- quick_case_when(
           is.na(values) ~ NA_sir_,
@@ -953,7 +961,6 @@ as_sir_method <- function(method_short,
           # and NA otherwise
           TRUE ~ NA_sir_
         )
-        
       } else if (method == "disk") {
         new_sir <- quick_case_when(
           is.na(values) ~ NA_sir_,
@@ -988,10 +995,10 @@ as_sir_method <- function(method_short,
         )
       )
     }
-    
+
     df[rows, "result"] <- new_sir
   }
-  
+
   if (isTRUE(rise_warning)) {
     message(font_yellow(font_bold(" * WARNING *")))
   } else if (length(msgs) == 0) {
@@ -999,9 +1006,9 @@ as_sir_method <- function(method_short,
   } else {
     msg_note(sort(msgs))
   }
-  
+
   load_mo_uncertainties(metadata_mo)
-  
+
   df$result
 }
 
@@ -1027,6 +1034,9 @@ sir_interpretation_history <- function(clean = FALSE) {
     AMR_env$sir_interpretation_history <- out.bak
   }
 
+  # sort descending on time
+  out <- out[order(out$datetime, decreasing = TRUE), , drop = FALSE]
+
   if (pkg_is_available("tibble", also_load = FALSE)) {
     import_fn("as_tibble", "tibble")(out)
   } else {

R/translate.R

@@ -141,10 +141,11 @@ reset_AMR_locale <- function() {
 #' @export
 translate_AMR <- function(x, language = get_AMR_locale()) {
   translate_into_language(x,
-                          language = language,
+    language = language,
-                          only_unknown = FALSE,
+    only_unknown = FALSE,
-                          only_affect_ab_names = FALSE,
+    only_affect_ab_names = FALSE,
-                          only_affect_mo_names = FALSE)
+    only_affect_mo_names = FALSE
+  )
 }
 
 
@@ -170,14 +171,15 @@ find_language <- function(language, fallback = TRUE) {
   language <- Map(LANGUAGES_SUPPORTED_NAMES,
     LANGUAGES_SUPPORTED,
     f = function(l, n, check = language) {
-      grepl(paste0(
+      grepl(
-        "^(", l[1], "|", l[2], "|",
+        paste0(
-        n, "(_|$)|", toupper(n), "(_|$))"
+          "^(", l[1], "|", l[2], "|",
-      ),
+          n, "(_|$)|", toupper(n), "(_|$))"
-      check,
+        ),
-      ignore.case = TRUE,
+        check,
-      perl = TRUE,
+        ignore.case = TRUE,
-      useBytes = FALSE
+        perl = TRUE,
+        useBytes = FALSE
       )
     },
     USE.NAMES = TRUE
@@ -196,7 +198,6 @@ translate_into_language <- function(from,
                                     only_unknown = FALSE,
                                     only_affect_ab_names = FALSE,
                                     only_affect_mo_names = FALSE) {
-
   # get ISO-639-1 of language
   lang <- validate_language(language)
   if (lang == "en") {
@@ -260,10 +261,10 @@ translate_into_language <- function(from,
 
   # force UTF-8 for diacritics
   from_unique_translated <- enc2utf8(from_unique_translated)
-  
+
   # a kind of left join to get all results back
   out <- from_unique_translated[match(from.bak, from_unique)]
-  
+
   if (!identical(from.bak, out) && get_AMR_locale() == lang && message_not_thrown_before("translation", entire_session = TRUE) && interactive()) {
     message(word_wrap(
       "Assuming the ", LANGUAGES_SUPPORTED_NAMES[[lang]]$exonym, " language (",
@@ -271,6 +272,6 @@ translate_into_language <- function(from,
       add_fn = list(font_blue), as_note = TRUE
     ))
   }
-  
+
   out
 }

R/zz_deprecated.R

@@ -35,7 +35,8 @@
 #' @rdname AMR-deprecated
 #' @export
 NA_rsi_ <- set_clean_class(factor(NA_character_, levels = c("S", "I", "R"), ordered = TRUE),
-                           new_class = c("rsi", "ordered", "factor"))
+  new_class = c("rsi", "ordered", "factor")
+)
 #' @rdname AMR-deprecated
 #' @export
 as.rsi <- function(x, ...) {
@@ -197,14 +198,18 @@ deprecation_warning <- function(old = NULL, new = NULL, extra_msg = NULL) {
     env <- paste0("deprecated_", old)
     if (!env %in% names(AMR_env)) {
       AMR_env[[paste0("deprecated_", old)]] <- 1
-      warning_(ifelse(is.null(new), 
+      warning_(
-                      paste0("The `", old, "()` function is no longer in use"),
+        ifelse(is.null(new),
-                      paste0("The `", old, "()` function has been replaced with `", new, "()`")),
+          paste0("The `", old, "()` function is no longer in use"),
-               ", see `?AMR-deprecated`.",
+          paste0("The `", old, "()` function has been replaced with `", new, "()`")
-               ifelse(!is.null(extra_msg),
+        ),
-                      paste0(" ", extra_msg),
+        ", see `?AMR-deprecated`.",
-                      ""),
+        ifelse(!is.null(extra_msg),
-               "\nThis warning will be shown once per session.")
+          paste0(" ", extra_msg),
+          ""
+        ),
+        "\nThis warning will be shown once per session."
+      )
     }
   }
 }

R/zzz.R

@@ -192,18 +192,24 @@ if (utf8_supported && !is_latex) {
   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"))
-    tryCatch({
+    tryCatch(
-      suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
+      {
-      packageStartupMessage("OK.")
+        suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
-    }, error = function(e) packageStartupMessage("Failed: ", e$message))
+        packageStartupMessage("OK.")
+      },
+      error = function(e) packageStartupMessage("Failed: ", e$message)
+    )
   }
   # 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"))
-    tryCatch({
+    tryCatch(
-      suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
+      {
-      packageStartupMessage("OK.")
+        suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
-    }, error = function(e) packageStartupMessage("Failed: ", e$message))
+        packageStartupMessage("OK.")
+      },
+      error = function(e) packageStartupMessage("Failed: ", e$message)
+    )
   }
 }

data-raw/_pre_commit_hook.R

@@ -101,46 +101,48 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) {
   MO_staph <- AMR::microorganisms
   MO_staph <- MO_staph[which(MO_staph$genus == "Staphylococcus"), , drop = FALSE]
   if (type == "CoNS") {
-    MO_staph[which(MO_staph$species %in% c(
+    MO_staph[
-      "coagulase-negative", "argensis", "arlettae",
+      which(MO_staph$species %in% c(
-      "auricularis", "borealis", "caeli", "capitis", "caprae",
+        "coagulase-negative", "argensis", "arlettae",
-      "carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti",
+        "auricularis", "borealis", "caeli", "capitis", "caprae",
-      "croceilyticus",
+        "carnosus", "casei", "caseolyticus", "chromogenes", "cohnii", "condimenti",
-      "debuckii", "devriesei", "edaphicus", "epidermidis",
+        "croceilyticus",
-      "equorum", "felis", "fleurettii", "gallinarum",
+        "debuckii", "devriesei", "edaphicus", "epidermidis",
-      "haemolyticus", "hominis", "jettensis", "kloosii",
+        "equorum", "felis", "fleurettii", "gallinarum",
-      "lentus", "lugdunensis", "massiliensis", "microti",
+        "haemolyticus", "hominis", "jettensis", "kloosii",
-      "muscae", "nepalensis", "pasteuri", "petrasii",
+        "lentus", "lugdunensis", "massiliensis", "microti",
-      "pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus",
+        "muscae", "nepalensis", "pasteuri", "petrasii",
-      "pulvereri", "rostri", "saccharolyticus", "saprophyticus",
+        "pettenkoferi", "piscifermentans", "pragensis", "pseudoxylosus",
-      "sciuri", "simulans", "stepanovicii", "succinus",
+        "pulvereri", "rostri", "saccharolyticus", "saprophyticus",
-      "ureilyticus",
+        "sciuri", "simulans", "stepanovicii", "succinus",
-      "vitulinus", "vitulus", "warneri", "xylosus",
+        "ureilyticus",
-      "caledonicus", "canis",
+        "vitulinus", "vitulus", "warneri", "xylosus",
-      "durrellii", "lloydii",
+        "caledonicus", "canis",
-      "ratti", "taiwanensis", "veratri", "urealyticus"
+        "durrellii", "lloydii",
-    ) |
+        "ratti", "taiwanensis", "veratri", "urealyticus"
-      # old, now renamed to S. schleiferi (but still as synonym in our data of course):
+      ) |
-      (MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))),
+        # old, now renamed to S. schleiferi (but still as synonym in our data of course):
-    "mo",
+        (MO_staph$species == "schleiferi" & MO_staph$subspecies %in% c("schleiferi", ""))),
-    drop = TRUE
+      "mo",
+      drop = TRUE
     ]
   } else if (type == "CoPS") {
-    MO_staph[which(MO_staph$species %in% c(
+    MO_staph[
-      "coagulase-positive", "coagulans",
+      which(MO_staph$species %in% c(
-      "agnetis", "argenteus",
+        "coagulase-positive", "coagulans",
-      "cornubiensis",
+        "agnetis", "argenteus",
-      "delphini", "lutrae",
+        "cornubiensis",
-      "hyicus", "intermedius",
+        "delphini", "lutrae",
-      "pseudintermedius", "pseudointermedius",
+        "hyicus", "intermedius",
-      "schweitzeri", "simiae",
+        "pseudintermedius", "pseudointermedius",
-      "roterodami",
+        "schweitzeri", "simiae",
-      "singaporensis"
+        "roterodami",
-    ) |
+        "singaporensis"
-      # old, now renamed to S. coagulans (but still as synonym in our data of course):
+      ) |
-      (MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
+        # old, now renamed to S. coagulans (but still as synonym in our data of course):
-    "mo",
+        (MO_staph$species == "schleiferi" & MO_staph$subspecies == "coagulans")),
-    drop = TRUE
+      "mo",
+      drop = TRUE
     ]
   }
 }
@@ -254,14 +256,15 @@ create_AB_AV_lookup <- function(df) {
   }
   new_df$generalised_loinc <- lapply(new_df$loinc, generalise_antibiotic_name)
   new_df$generalised_all <- unname(lapply(
-    as.list(as.data.frame(t(new_df[,
+    as.list(as.data.frame(
-      c(
+      t(new_df[,
-        colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")],
+        c(
-        colnames(new_df)[colnames(new_df) %like% "generalised"]
+          colnames(new_df)[colnames(new_df) %in% c("ab", "av", "atc", "cid", "name")],
-      ),
+          colnames(new_df)[colnames(new_df) %like% "generalised"]
-      drop = FALSE
+        ),
-    ]),
+        drop = FALSE
-    stringsAsFactors = FALSE
+      ]),
+      stringsAsFactors = FALSE
     )),
     function(x) {
       x <- generalise_antibiotic_name(unname(unlist(x)))
@@ -472,7 +475,7 @@ suppressMessages(devtools::document(quiet = TRUE))
 if (!"styler" %in% rownames(utils::installed.packages())) {
   message("Package 'styler' not installed!")
 } else if (interactive()) {
-  # # only when sourcing this file ourselves
+  # only when sourcing this file ourselves
   # usethis::ui_info("Styling package")
   # styler::style_pkg(
   #   style = styler::tidyverse_style,

data-raw/create_survey_page.R

@@ -1,4 +1,3 @@
-
 license_text <- readLines("docs/LICENSE-text.html")
 license_text <- paste(license_text, collapse = "|||")
 license_text <- gsub("licen(s|c)e", "Survey", license_text, ignore.case = TRUE)

data-raw/read_EUCAST.R

@@ -66,33 +66,36 @@ read_EUCAST <- function(sheet, file, guideline_name) {
 
   # in the info header in the Excel file, EUCAST mentions which genera are targeted
   if (sheet %like% "anaerob.*Gram.*posi") {
-    sheet <- paste0(c(
+    sheet <- paste0(
-      "Actinomyces", "Bifidobacterium", "Clostridioides",
+      c(
-      "Clostridium", "Cutibacterium", "Eggerthella",
+        "Actinomyces", "Bifidobacterium", "Clostridioides",
-      "Eubacterium", "Lactobacillus", "Propionibacterium",
+        "Clostridium", "Cutibacterium", "Eggerthella",
-      "Staphylococcus saccharolyticus"
+        "Eubacterium", "Lactobacillus", "Propionibacterium",
-    ),
+        "Staphylococcus saccharolyticus"
-    collapse = "_"
+      ),
+      collapse = "_"
     )
   } else if (sheet %like% "anaerob.*Gram.*nega") {
-    sheet <- paste0(c(
+    sheet <- paste0(
-      "Bacteroides",
+      c(
-      "Bilophila",
+        "Bacteroides",
-      "Fusobacterium",
+        "Bilophila",
-      "Mobiluncus",
+        "Fusobacterium",
-      "Parabacteroides",
+        "Mobiluncus",
-      "Porphyromonas",
+        "Parabacteroides",
-      "Prevotella"
+        "Porphyromonas",
-    ),
+        "Prevotella"
-    collapse = "_"
+      ),
+      collapse = "_"
     )
   } else if (sheet == "Streptococcus A,B,C,G") {
-    sheet <- paste0(microorganisms %>%
+    sheet <- paste0(
-      filter(genus == "Streptococcus") %>%
+      microorganisms %>%
-      mutate(lancefield = mo_name(mo, Lancefield = TRUE)) %>%
+        filter(genus == "Streptococcus") %>%
-      filter(lancefield %like% "^Streptococcus group") %>%
+        mutate(lancefield = mo_name(mo, Lancefield = TRUE)) %>%
-      pull(fullname),
+        filter(lancefield %like% "^Streptococcus group") %>%
-    collapse = "_"
+        pull(fullname),
+      collapse = "_"
     )
   } else if (sheet %like% "PK.*PD") {
     sheet <- "UNKNOWN"

data-raw/reproduction_of_antibiotics.R

@@ -142,14 +142,15 @@ abx2 <- bind_rows(abx_atc1, abx_atc2)
 rm(abx_atc1)
 rm(abx_atc2)
 
-abx2$ab[is.na(abx2$ab)] <- toupper(abbreviate(gsub(
+abx2$ab[is.na(abx2$ab)] <- toupper(abbreviate(
-  "[/0-9-]",
+  gsub(
-  " ",
+    "[/0-9-]",
-  abx2$name[is.na(abx2$ab)]
+    " ",
-),
+    abx2$name[is.na(abx2$ab)]
-minlength = 3,
+  ),
-method = "left.kept",
+  minlength = 3,
-strict = TRUE
+  method = "left.kept",
+  strict = TRUE
 ))
 
 n_distinct(abx2$ab)
@@ -197,24 +198,26 @@ get_CID <- function(ab) {
     p$tick()
 
     CID[i] <- tryCatch(
-      data.table::fread(paste0(
+      data.table::fread(
-        "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
+        paste0(
-        URLencode(ab[i], reserved = TRUE),
+          "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
-        "/cids/TXT?name_type=complete"
+          URLencode(ab[i], reserved = TRUE),
-      ),
+          "/cids/TXT?name_type=complete"
-      showProgress = FALSE
+        ),
+        showProgress = FALSE
       )[[1]][1],
       error = function(e) NA_integer_
     )
     if (is.na(CID[i])) {
       # try with removing the text in brackets
       CID[i] <- tryCatch(
-        data.table::fread(paste0(
+        data.table::fread(
-          "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
+          paste0(
-          URLencode(trimws(gsub("[(].*[)]", "", ab[i])), reserved = TRUE),
+            "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
-          "/cids/TXT?name_type=complete"
+            URLencode(trimws(gsub("[(].*[)]", "", ab[i])), reserved = TRUE),
-        ),
+            "/cids/TXT?name_type=complete"
-        showProgress = FALSE
+          ),
+          showProgress = FALSE
         )[[1]][1],
         error = function(e) NA_integer_
       )
@@ -223,12 +226,13 @@ get_CID <- function(ab) {
       # try match on word and take the lowest CID value (sorted)
       ab[i] <- gsub("[^a-z0-9]+", " ", ab[i], ignore.case = TRUE)
       CID[i] <- tryCatch(
-        data.table::fread(paste0(
+        data.table::fread(
-          "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
+          paste0(
-          URLencode(ab[i], reserved = TRUE),
+            "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/",
-          "/cids/TXT?name_type=word"
+            URLencode(ab[i], reserved = TRUE),
-        ),
+            "/cids/TXT?name_type=word"
-        showProgress = FALSE
+          ),
+          showProgress = FALSE
         )[[1]][1],
         error = function(e) NA_integer_
       )
@@ -260,13 +264,14 @@ get_synonyms <- function(CID, clean = TRUE) {
     }
 
     synonyms_txt <- tryCatch(
-      data.table::fread(paste0(
+      data.table::fread(
-        "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/fastidentity/cid/",
+        paste0(
-        CID[i],
+          "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/fastidentity/cid/",
-        "/synonyms/TXT"
+          CID[i],
-      ),
+          "/synonyms/TXT"
-      sep = "\n",
+        ),
-      showProgress = FALSE
+        sep = "\n",
+        showProgress = FALSE
       )[[1]],
       error = function(e) NA_character_
     )

data-raw/reproduction_of_antivirals.R

@@ -106,31 +106,32 @@ antivirals <- antivirals %>%
     oral_units,
     iv_ddd,
     iv_units
-  ) %>% 
+  ) %>%
   AMR:::dataset_UTF8_to_ASCII()
 
 av_codes <- tibble(name = antivirals$name %>%
-                     strsplit("(, | and )") %>%
+  strsplit("(, | and )") %>%
-                     unlist() %>%
+  unlist() %>%
-                     unique() %>%
+  unique() %>%
-                     sort()) %>% 
+  sort()) %>%
-  mutate(av_1st = toupper(abbreviate(name, minlength = 3, use.classes = FALSE))) %>% 
+  mutate(av_1st = toupper(abbreviate(name, minlength = 3, use.classes = FALSE))) %>%
   filter(!name %in% c("acid", "dipivoxil", "disoproxil", "marboxil", "alafenamide"))
 
 replace_with_av_code <- function(name) {
   unname(av_codes$av_1st[match(name, av_codes$name)])
 }
 
-names_codes <- antivirals %>% 
+names_codes <- antivirals %>%
   separate(name,
-           into = paste0("name", c(1:7)),
+    into = paste0("name", c(1:7)),
-           sep = "(, | and )",
+    sep = "(, | and )",
-           remove = FALSE,
+    remove = FALSE,
-           fill = "right") %>%
+    fill = "right"
+  ) %>%
   # remove empty columns
-  select(!where(function(x) all(is.na(x)))) %>% 
+  select(!where(function(x) all(is.na(x)))) %>%
-  mutate_at(vars(matches("name[1-9]")), replace_with_av_code) %>% 
+  mutate_at(vars(matches("name[1-9]")), replace_with_av_code) %>%
-  unite(av, matches("name[1-9]"), sep = "+", na.rm = TRUE) %>% 
+  unite(av, matches("name[1-9]"), sep = "+", na.rm = TRUE) %>%
   mutate(name = gsub("(, | and )", "/", name))
 substr(names_codes$name, 1, 1) <- toupper(substr(names_codes$name, 1, 1))
 
@@ -143,8 +144,9 @@ antivirals <- antivirals %>% AMR:::dataset_UTF8_to_ASCII()
 
 # add loinc, see 'data-raw/loinc.R'
 loinc_df <- read.csv("data-raw/Loinc.csv",
-                     row.names = NULL,
+  row.names = NULL,
-                     stringsAsFactors = FALSE)
+  stringsAsFactors = FALSE
+)
 
 loinc_df <- loinc_df %>% filter(CLASS == "DRUG/TOX")
 av_names <- antivirals %>%

data-raw/reproduction_of_dosage.R

@@ -173,7 +173,7 @@ dosage_new <- bind_rows(
   as.data.frame(stringsAsFactors = FALSE)
 rownames(dosage_new) <- NULL
 
-dosage <- bind_rows(dosage_new, AMR::dosage) %>% 
+dosage <- bind_rows(dosage_new, AMR::dosage) %>%
   dataset_UTF8_to_ASCII()
 
 usethis::use_data(dosage, internal = FALSE, overwrite = TRUE, version = 2)

data-raw/reproduction_of_microorganisms.R

@@ -37,10 +37,10 @@
 #    CSV file (~12,5 MB) as "taxonomy.csv". Their API unfortunately does
 #    not include the full taxonomy and is currently (2022) pretty worthless.
 # 3. For data about human pathogens, we use Bartlett et al. (2022),
-#    https://doi.org/10.1099/mic.0.001269. Their latest supplementary material 
+#    https://doi.org/10.1099/mic.0.001269. Their latest supplementary material
 #    can be found here: https://github.com/padpadpadpad/bartlett_et_al_2022_human_pathogens.
-#.   Download their latest xlsx file in the `data` folder and save it to our
+# .   Download their latest xlsx file in the `data` folder and save it to our
-#.   `data-raw` folder.
+# .   `data-raw` folder.
 # 4. Set this folder_location to the path where these two files are:
 folder_location <- "~/Downloads/backbone/"
 file_gbif <- paste0(folder_location, "Taxon.tsv")
@@ -65,7 +65,7 @@ devtools::load_all(".") # load AMR package
 
 get_author_year <- function(ref) {
   # Only keep first author, e.g. transform 'Smith, Jones, 2011' to 'Smith et al., 2011'
-  
+
   authors2 <- iconv(ref, from = "UTF-8", to = "ASCII//TRANSLIT")
   authors2 <- gsub(" ?\\(Approved Lists [0-9]+\\) ?", " () ", authors2)
   authors2 <- gsub(" [)(]+ $", "", authors2)
@@ -73,21 +73,21 @@ get_author_year <- function(ref) {
   authors2 <- trimws(gsub("^[(](.*)[)]$", "\\1", authors2))
   # only take part after brackets if there's a name
   authors2 <- ifelse(grepl(".*[)] [a-zA-Z]+.*", authors2),
-                     gsub(".*[)] (.*)", "\\1", authors2),
+    gsub(".*[)] (.*)", "\\1", authors2),
-                     authors2
+    authors2
   )
   # replace parentheses with emend. to get the latest authors
   authors2 <- gsub("(", " emend. ", authors2, fixed = TRUE)
   authors2 <- gsub(")", "", authors2, fixed = TRUE)
   authors2 <- gsub(" +", " ", authors2)
   authors2 <- trimws(authors2)
-  
+
   # get year from last 4 digits
   lastyear <- as.integer(gsub(".*([0-9]{4})$", "\\1", authors2))
   # can never be later than now
   lastyear <- ifelse(lastyear > as.integer(format(Sys.Date(), "%Y")),
-                     NA,
+    NA,
-                     lastyear
+    lastyear
   )
   # get authors without last year
   authors <- gsub("(.*)[0-9]{4}$", "\\1", authors2)
@@ -119,8 +119,8 @@ get_author_year <- function(ref) {
   authors[nchar(authors) <= 3] <- ""
   # combine author and year if year is available
   ref <- ifelse(!is.na(lastyear),
-                paste0(authors, ", ", lastyear),
+    paste0(authors, ", ", lastyear),
-                authors
+    authors
   )
   # fix beginning and ending
   ref <- gsub(", $", "", ref)
@@ -128,7 +128,7 @@ get_author_year <- function(ref) {
   ref <- gsub("^(emend|et al.,?)", "", ref)
   ref <- trimws(ref)
   ref <- gsub("'", "", ref)
-  
+
   # a lot start with a lowercase character - fix that
   ref[!grepl("^d[A-Z]", ref)] <- gsub("^([a-z])", "\\U\\1", ref[!grepl("^d[A-Z]", ref)], perl = TRUE)
   # specific one for the French that are named dOrbigny
@@ -222,9 +222,9 @@ include_fungal_orders <- c(
 # get latest taxonomic names of these fungal orders
 include_fungal_orders_ids <- taxonomy_gbif.bak %>%
   filter(order %in% include_fungal_orders)
-include_fungal_orders <- taxonomy_gbif.bak %>% 
+include_fungal_orders <- taxonomy_gbif.bak %>%
-  filter(taxonID %in% c(include_fungal_orders_ids$taxonID, include_fungal_orders_ids$acceptedNameUsageID)) %>% 
+  filter(taxonID %in% c(include_fungal_orders_ids$taxonID, include_fungal_orders_ids$acceptedNameUsageID)) %>%
-  distinct(order) %>% 
+  distinct(order) %>%
   pull(order)
 
 # check some columns to validate below filters
@@ -361,7 +361,7 @@ for (page in LETTERS) {
     names <- names[ranks != "species"]
     ranks <- ranks[ranks != "species"]
     ranks[ranks == "domain"] <- "kingdom"
-    
+
     df <- names %>%
       tibble() %>%
       t() %>%
@@ -369,7 +369,7 @@ for (page in LETTERS) {
       setNames(ranks) %>%
       # no candidates please
       filter(genus %unlike% "^(Candidatus|\\[)")
-    
+
     taxonomy_lpsn_missing <- taxonomy_lpsn_missing %>%
       bind_rows(df)
   }
@@ -491,14 +491,14 @@ saveRDS(taxonomy_lpsn, "data-raw/taxonomy_lpsn.rds", version = 2)
 taxonomy_gbif <- taxonomy_gbif %>%
   # clean NAs and add fullname
   mutate(across(kingdom:subspecies, function(x) ifelse(is.na(x), "", x)),
-         fullname = trimws(case_when(
+    fullname = trimws(case_when(
-           rank == "family" ~ family,
+      rank == "family" ~ family,
-           rank == "order" ~ order,
+      rank == "order" ~ order,
-           rank == "class" ~ class,
+      rank == "class" ~ class,
-           rank == "phylum" ~ phylum,
+      rank == "phylum" ~ phylum,
-           rank == "kingdom" ~ kingdom,
+      rank == "kingdom" ~ kingdom,
-           TRUE ~ paste(genus, species, subspecies)
+      TRUE ~ paste(genus, species, subspecies)
-         )), .before = 1
+    )), .before = 1
   ) %>%
   # keep only one GBIF taxon ID per full name
   arrange(fullname, gbif) %>%
@@ -507,14 +507,14 @@ taxonomy_gbif <- taxonomy_gbif %>%
 taxonomy_lpsn <- taxonomy_lpsn %>%
   # clean NAs and add fullname
   mutate(across(kingdom:subspecies, function(x) ifelse(is.na(x), "", x)),
-         fullname = trimws(case_when(
+    fullname = trimws(case_when(
-           rank == "family" ~ family,
+      rank == "family" ~ family,
-           rank == "order" ~ order,
+      rank == "order" ~ order,
-           rank == "class" ~ class,
+      rank == "class" ~ class,
-           rank == "phylum" ~ phylum,
+      rank == "phylum" ~ phylum,
-           rank == "kingdom" ~ kingdom,
+      rank == "kingdom" ~ kingdom,
-           TRUE ~ paste(genus, species, subspecies)
+      TRUE ~ paste(genus, species, subspecies)
-         )), .before = 1
+    )), .before = 1
   ) %>%
   # keep only one LPSN record ID per full name
   arrange(fullname, lpsn) %>%
@@ -536,23 +536,25 @@ taxonomy_lpsn$lpsn_parent[taxonomy_lpsn$rank == "subspecies"] <- taxonomy_lpsn$l
 taxonomy <- taxonomy_lpsn %>%
   # join GBIF identifiers to them
   left_join(taxonomy_gbif %>% select(kingdom, fullname, starts_with("gbif")),
-            by = c("kingdom", "fullname")
+    by = c("kingdom", "fullname")
   )
 
 # for everything else, add the GBIF data
 taxonomy <- taxonomy %>%
   bind_rows(taxonomy_gbif %>%
-              filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname))) %>%
+    filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname))) %>%
   arrange(fullname) %>%
   filter(fullname != "")
 
 # get missing entries from existing microorganisms data set
 taxonomy <- taxonomy %>%
   bind_rows(AMR::microorganisms %>%
-              select(all_of(colnames(taxonomy))) %>% 
+    select(all_of(colnames(taxonomy))) %>%
-              filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname),
+    filter(
-                     # these will be added later:
+      !paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname),
-                     source != "manually added")) %>%
+      # these will be added later:
+      source != "manually added"
+    )) %>%
   arrange(fullname) %>%
   filter(fullname != "")
 
@@ -602,9 +604,10 @@ taxonomy <- taxonomy %>%
         source = "manually added"
       ) %>%
       filter(!paste(kingdom, rank) %in% paste(taxonomy$kingdom, taxonomy$rank)) %>%
-      left_join(current_gbif %>%
+      left_join(
-                  select(kingdom, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
+        current_gbif %>%
-                by = c("kingdom", "rank")
+          select(kingdom, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
+        by = c("kingdom", "rank")
       ) %>%
       mutate(source = ifelse(!is.na(gbif), "GBIF", source))
   )
@@ -625,17 +628,18 @@ for (i in 2:6) {
       source = "manually added"
     ) %>%
     filter(!paste(kingdom, .[[ncol(.) - 4]], rank) %in% paste(taxonomy$kingdom, taxonomy[[i + 1]], taxonomy$rank)) %>%
-  # get GBIF identifier where available
+    # get GBIF identifier where available
-  left_join(current_gbif %>%
+    left_join(
-    select(kingdom, all_of(i_name), rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
+      current_gbif %>%
-  by = c("kingdom", "rank", i_name)
+        select(kingdom, all_of(i_name), rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
-  ) %>%
+      by = c("kingdom", "rank", i_name)
-  mutate(source = ifelse(!is.na(gbif), "GBIF", source))
+    ) %>%
+    mutate(source = ifelse(!is.na(gbif), "GBIF", source))
   message("n = ", nrow(to_add))
   if (is.null(taxonomy_all_missing)) {
     taxonomy_all_missing <- to_add
   } else {
-    taxonomy_all_missing <- taxonomy_all_missing %>% 
+    taxonomy_all_missing <- taxonomy_all_missing %>%
       bind_rows(to_add)
   }
 }
@@ -645,20 +649,24 @@ taxonomy <- taxonomy %>%
   bind_rows(taxonomy_all_missing)
 
 # fix for duplicate fullnames within a kingdom (such as Nitrospira which is the name of the genus AND its class)
-taxonomy <- taxonomy %>% 
+taxonomy <- taxonomy %>%
-  mutate(rank_index = case_when(rank == "subspecies" ~ 1,
+  mutate(
-                                rank == "species" ~ 2,
+    rank_index = case_when(
-                                rank == "genus" ~ 3,
+      rank == "subspecies" ~ 1,
-                                rank == "family" ~ 4,
+      rank == "species" ~ 2,
-                                rank == "order" ~ 5,
+      rank == "genus" ~ 3,
-                                rank == "class" ~ 6,
+      rank == "family" ~ 4,
-                                TRUE ~ 7),
+      rank == "order" ~ 5,
-         fullname_rank = paste0(fullname, " {", rank, "}")) %>% 
+      rank == "class" ~ 6,
-  arrange(kingdom, fullname, rank_index) %>% 
+      TRUE ~ 7
-  group_by(kingdom, fullname) %>% 
+    ),
-  mutate(fullname = if_else(row_number() > 1, fullname_rank, fullname)) %>% 
+    fullname_rank = paste0(fullname, " {", rank, "}")
-  ungroup() %>% 
+  ) %>%
-  select(-fullname_rank, -rank_index) %>% 
+  arrange(kingdom, fullname, rank_index) %>%
+  group_by(kingdom, fullname) %>%
+  mutate(fullname = if_else(row_number() > 1, fullname_rank, fullname)) %>%
+  ungroup() %>%
+  select(-fullname_rank, -rank_index) %>%
   arrange(fullname)
 
 # now also add missing species (requires combination with genus)
@@ -676,12 +684,13 @@ taxonomy <- taxonomy %>%
       ) %>%
       filter(!paste(kingdom, genus, species, rank) %in% paste(taxonomy$kingdom, taxonomy$genus, taxonomy$species, taxonomy$rank)) %>%
       # get GBIF identifier where available
-      left_join(current_gbif %>%
+      left_join(
-                  select(kingdom, genus, species = specificEpithet, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
+        current_gbif %>%
-                by = c("kingdom", "rank", "genus", "species")
+          select(kingdom, genus, species = specificEpithet, rank = taxonRank, ref = scientificNameAuthorship, gbif = taxonID, gbif_parent = parentNameUsageID),
+        by = c("kingdom", "rank", "genus", "species")
       ) %>%
       mutate(source = ifelse(!is.na(gbif), "GBIF", source))
-    )
+  )
 
 
 # remove NAs from taxonomy again, and keep unique full names
@@ -702,7 +711,7 @@ manually_added <- AMR::microorganisms %>%
   filter(source == "manually added", !paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname)) %>%
   select(fullname:subspecies, ref, source, rank)
 
-manually_added <- manually_added %>% 
+manually_added <- manually_added %>%
   bind_rows(salmonellae)
 
 # get latest taxonomy for those entries
@@ -805,76 +814,83 @@ taxonomy <- taxonomy %>%
 pathogens <- read_excel(file_bartlett, sheet = "Tab 6 Full List")
 
 # get all established, both old and current taxonomic names
-established <- pathogens %>% 
+established <- pathogens %>%
-  filter(status == "established") %>% 
+  filter(status == "established") %>%
   mutate(fullname = paste(genus, species)) %>%
-  pull(fullname) %>% 
+  pull(fullname) %>%
-  c(unlist(mo_current(.)),
+  c(
-    unlist(mo_synonyms(., keep_synonyms = FALSE))) %>% 
+    unlist(mo_current(.)),
-  strsplit(" ", fixed = TRUE) %>% 
+    unlist(mo_synonyms(., keep_synonyms = FALSE))
-  sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>% 
+  ) %>%
-  sort() %>% 
+  strsplit(" ", fixed = TRUE) %>%
+  sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
+  sort() %>%
   unique()
 
 # get all putative, both old and current taxonomic names
-putative <- pathogens %>% 
+putative <- pathogens %>%
-  filter(status == "putative") %>% 
+  filter(status == "putative") %>%
   mutate(fullname = paste(genus, species)) %>%
-  pull(fullname) %>% 
+  pull(fullname) %>%
-  c(unlist(mo_current(.)),
+  c(
-    unlist(mo_synonyms(., keep_synonyms = FALSE))) %>% 
+    unlist(mo_current(.)),
-  strsplit(" ", fixed = TRUE) %>% 
+    unlist(mo_synonyms(., keep_synonyms = FALSE))
-  sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>% 
+  ) %>%
-  sort() %>% 
+  strsplit(" ", fixed = TRUE) %>%
+  sapply(function(x) ifelse(length(x) == 1, x, paste(x[1], x[2]))) %>%
+  sort() %>%
   unique()
 
 established <- established[established %unlike% "unknown"]
 putative <- putative[putative %unlike% "unknown"]
 
-established_genera <- established %>% 
+established_genera <- established %>%
-  strsplit(" ", fixed = TRUE) %>% 
+  strsplit(" ", fixed = TRUE) %>%
-  sapply(function(x) x[1]) %>% 
+  sapply(function(x) x[1]) %>%
-  sort() %>% 
+  sort() %>%
   unique()
 
-putative_genera <- putative %>% 
+putative_genera <- putative %>%
-  strsplit(" ", fixed = TRUE) %>% 
+  strsplit(" ", fixed = TRUE) %>%
-  sapply(function(x) x[1]) %>% 
+  sapply(function(x) x[1]) %>%
-  sort() %>% 
+  sort() %>%
   unique()
 
-nonbacterial_genera <- AMR:::MO_PREVALENT_GENERA %>% 
+nonbacterial_genera <- AMR:::MO_PREVALENT_GENERA %>%
-  c(unlist(mo_current(.)),
+  c(
-    unlist(mo_synonyms(., keep_synonyms = FALSE))) %>% 
+    unlist(mo_current(.)),
-  strsplit(" ", fixed = TRUE) %>% 
+    unlist(mo_synonyms(., keep_synonyms = FALSE))
-  sapply(function(x) x[1]) %>% 
+  ) %>%
-  sort() %>% 
+  strsplit(" ", fixed = TRUE) %>%
+  sapply(function(x) x[1]) %>%
+  sort() %>%
   unique()
 nonbacterial_genera <- nonbacterial_genera[nonbacterial_genera %unlike% "unknown"]
 
 # update prevalence based on taxonomy (following the recent and thorough work of Bartlett et al., 2022)
 # see https://doi.org/10.1099/mic.0.001269
-taxonomy <- taxonomy %>% 
+taxonomy <- taxonomy %>%
   mutate(prevalence = case_when(
     # 'established' means 'have infected at least three persons in three or more references'
     paste(genus, species) %in% established & rank %in% c("species", "subspecies") ~ 1.0,
     # other genera in the 'established' group
     genus %in% established_genera & rank == "genus" ~ 1.0,
-    
+
     # 'putative' means 'fewer than three known cases'
     paste(genus, species) %in% putative & rank %in% c("species", "subspecies") ~ 1.25,
     # other genera in the 'putative' group
     genus %in% putative_genera & rank == "genus" ~ 1.25,
-    
+
     # species and subspecies in 'established' and 'putative' groups
     genus %in% c(established_genera, putative_genera) & rank %in% c("species", "subspecies") ~ 1.5,
     # other species from a genus in either group
     genus %in% nonbacterial_genera & rank %in% c("genus", "species", "subspecies") ~ 1.5,
     # we keep track of prevalent genera too of non-bacterial species
     genus %in% AMR:::MO_PREVALENT_GENERA & kingdom != "Bacteria" & rank %in% c("genus", "species", "subspecies") ~ 1.5,
-    
+
     # all others
-    TRUE ~ 2.0))
+    TRUE ~ 2.0
+  ))
 
 table(taxonomy$prevalence, useNA = "always")
 # (a lot will be removed further below)
@@ -909,13 +925,14 @@ mo_kingdom <- taxonomy %>%
 mo_phylum <- taxonomy %>%
   filter(rank == "phylum") %>%
   distinct(kingdom, phylum) %>%
-  left_join(AMR::microorganisms %>%
+  left_join(
-              filter(rank == "phylum") %>%
+    AMR::microorganisms %>%
-              transmute(kingdom,
+      filter(rank == "phylum") %>%
-                        phylum = fullname,
+      transmute(kingdom,
-                        mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
+        phylum = fullname,
-              ),
+        mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
-            by = c("kingdom", "phylum")
+      ),
+    by = c("kingdom", "phylum")
   ) %>%
   group_by(kingdom) %>%
   mutate(
@@ -935,13 +952,14 @@ mo_phylum <- mo_phylum %>%
 mo_class <- taxonomy %>%
   filter(rank == "class") %>%
   distinct(kingdom, class) %>%
-  left_join(AMR::microorganisms %>%
+  left_join(
-              filter(rank == "class") %>%
+    AMR::microorganisms %>%
-              transmute(kingdom,
+      filter(rank == "class") %>%
-                        class = fullname,
+      transmute(kingdom,
-                        mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
+        class = fullname,
-              ),
+        mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
-            by = c("kingdom", "class")
+      ),
+    by = c("kingdom", "class")
   ) %>%
   group_by(kingdom) %>%
   mutate(
@@ -961,13 +979,14 @@ mo_class <- mo_class %>%
 mo_order <- taxonomy %>%
   filter(rank == "order") %>%
   distinct(kingdom, order) %>%
-  left_join(AMR::microorganisms %>%
+  left_join(
-              filter(rank == "order") %>%
+    AMR::microorganisms %>%
-              transmute(kingdom,
+      filter(rank == "order") %>%
-                        order = fullname,
+      transmute(kingdom,
-                        mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
+        order = fullname,
-              ),
+        mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
-            by = c("kingdom", "order")
+      ),
+    by = c("kingdom", "order")
   ) %>%
   group_by(kingdom) %>%
   mutate(
@@ -987,13 +1006,14 @@ mo_order <- mo_order %>%
 mo_family <- taxonomy %>%
   filter(rank == "family") %>%
   distinct(kingdom, family) %>%
-  left_join(AMR::microorganisms %>%
+  left_join(
-              filter(rank == "family") %>%
+    AMR::microorganisms %>%
-              transmute(kingdom,
+      filter(rank == "family") %>%
-                        family = fullname,
+      transmute(kingdom,
-                        mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
+        family = fullname,
-              ),
+        mo_old = gsub("[A-Z]{1,2}_", "", as.character(mo))
-            by = c("kingdom", "family")
+      ),
+    by = c("kingdom", "family")
   ) %>%
   group_by(kingdom) %>%
   mutate(
@@ -1014,11 +1034,12 @@ mo_genus <- taxonomy %>%
   filter(rank == "genus") %>%
   distinct(kingdom, genus) %>%
   # get available old MO codes
-  left_join(AMR::microorganisms %>%
+  left_join(
-              filter(rank == "genus") %>%
+    AMR::microorganisms %>%
-              transmute(mo_genus_old = gsub("^[A-Z]+_", "", as.character(mo)), kingdom, genus) %>%
+      filter(rank == "genus") %>%
-              distinct(kingdom, genus, .keep_all = TRUE),
+      transmute(mo_genus_old = gsub("^[A-Z]+_", "", as.character(mo)), kingdom, genus) %>%
-            by = c("kingdom", "genus")
+      distinct(kingdom, genus, .keep_all = TRUE),
+    by = c("kingdom", "genus")
   ) %>%
   distinct(kingdom, genus, .keep_all = TRUE) %>%
   # since kingdom is part of the code, genus abbreviations may be duplicated between kingdoms
@@ -1060,12 +1081,13 @@ mo_genus <- mo_genus %>%
 mo_species <- taxonomy %>%
   filter(rank == "species") %>%
   distinct(kingdom, genus, species) %>%
-  left_join(AMR::microorganisms %>%
+  left_join(
-              filter(rank == "species") %>%
+    AMR::microorganisms %>%
-              transmute(mo_species_old = gsub("^[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species) %>%
+      filter(rank == "species") %>%
-              filter(mo_species_old %unlike% "-") %>%
+      transmute(mo_species_old = gsub("^[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species) %>%
-              distinct(kingdom, genus, species, .keep_all = TRUE),
+      filter(mo_species_old %unlike% "-") %>%
-            by = c("kingdom", "genus", "species")
+      distinct(kingdom, genus, species, .keep_all = TRUE),
+    by = c("kingdom", "genus", "species")
   ) %>%
   distinct(kingdom, genus, species, .keep_all = TRUE) %>%
   group_by(kingdom, genus) %>%
@@ -1108,12 +1130,13 @@ mo_species <- mo_species %>%
 mo_subspecies <- taxonomy %>%
   filter(rank == "subspecies") %>%
   distinct(kingdom, genus, species, subspecies) %>%
-  left_join(AMR::microorganisms %>%
+  left_join(
-              filter(rank %in% c("subspecies", "subsp.", "infraspecies")) %>%
+    AMR::microorganisms %>%
-              transmute(mo_subspecies_old = gsub("^[A-Z]+_[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species, subspecies) %>%
+      filter(rank %in% c("subspecies", "subsp.", "infraspecies")) %>%
-              filter(mo_subspecies_old %unlike% "-") %>%
+      transmute(mo_subspecies_old = gsub("^[A-Z]+_[A-Z]+_[A-Z]+_", "", as.character(mo)), kingdom, genus, species, subspecies) %>%
-              distinct(kingdom, genus, species, subspecies, .keep_all = TRUE),
+      filter(mo_subspecies_old %unlike% "-") %>%
-            by = c("kingdom", "genus", "species", "subspecies")
+      distinct(kingdom, genus, species, subspecies, .keep_all = TRUE),
+    by = c("kingdom", "genus", "species", "subspecies")
   ) %>%
   distinct(kingdom, genus, species, subspecies, .keep_all = TRUE) %>%
   group_by(kingdom, genus, species) %>%
@@ -1187,20 +1210,26 @@ taxonomy <- taxonomy %>%
   arrange(fullname)
 
 # now check these - e.g. Nitrospira is the name of a genus AND its class
-taxonomy %>% filter(fullname %in% .[duplicated(fullname), "fullname", drop = TRUE]) %>% View()
+taxonomy %>%
+  filter(fullname %in% .[duplicated(fullname), "fullname", drop = TRUE]) %>%
+  View()
 taxonomy <- taxonomy %>%
-  mutate(rank_index = case_when(kingdom == "Bacteria" ~ 1,
+  mutate(rank_index = case_when(
-                                kingdom == "Fungi" ~ 2,
+    kingdom == "Bacteria" ~ 1,
-                                kingdom == "Protozoa" ~ 3,
+    kingdom == "Fungi" ~ 2,
-                                kingdom == "Archaea" ~ 4,
+    kingdom == "Protozoa" ~ 3,
-                                TRUE ~ 5)) %>% 
+    kingdom == "Archaea" ~ 4,
-  arrange(fullname, rank_index) %>% 
+    TRUE ~ 5
-  distinct(fullname, .keep_all = TRUE) %>% 
+  )) %>%
-  select(-rank_index) %>% 
+  arrange(fullname, rank_index) %>%
+  distinct(fullname, .keep_all = TRUE) %>%
+  select(-rank_index) %>%
   filter(mo != "")
 
 # this must not exist:
-taxonomy %>% filter(mo %like% "__") %>% View()
+taxonomy %>%
+  filter(mo %like% "__") %>%
+  View()
 taxonomy <- taxonomy %>% filter(mo %unlike% "__")
 
 
@@ -1214,14 +1243,20 @@ taxonomy <- taxonomy %>% distinct(mo, .keep_all = TRUE)
 taxonomy %>% filter(fullname %in% .[duplicated(fullname), "fullname", drop = TRUE])
 
 # are all GBIFs available?
-taxonomy %>% filter(!gbif_parent %in% gbif) %>% count(rank)
+taxonomy %>%
+  filter(!gbif_parent %in% gbif) %>%
+  count(rank)
 # try to find the right gbif IDs
 taxonomy$gbif_parent[which(!taxonomy$gbif_parent %in% taxonomy$gbif & taxonomy$rank == "species")] <- taxonomy$gbif[match(taxonomy$genus[which(!taxonomy$gbif_parent %in% taxonomy$gbif & taxonomy$rank == "species")], taxonomy$genus)]
 taxonomy$gbif_parent[which(!taxonomy$gbif_parent %in% taxonomy$gbif & taxonomy$rank == "class")] <- taxonomy$gbif[match(taxonomy$phylum[which(!taxonomy$gbif_parent %in% taxonomy$gbif & taxonomy$rank == "class")], taxonomy$phylum)]
-taxonomy %>% filter(!gbif_parent %in% gbif) %>% count(rank)
+taxonomy %>%
+  filter(!gbif_parent %in% gbif) %>%
+  count(rank)
 
 # are all LPSNs available?
-taxonomy %>% filter(!lpsn_parent %in% lpsn) %>% count(rank)
+taxonomy %>%
+  filter(!lpsn_parent %in% lpsn) %>%
+  count(rank)
 # make GBIF refer to newest renaming according to LPSN
 taxonomy$gbif_renamed_to[which(!is.na(taxonomy$gbif_renamed_to) & !is.na(taxonomy$lpsn_renamed_to))] <- taxonomy$gbif[match(taxonomy$lpsn_renamed_to[which(!is.na(taxonomy$gbif_renamed_to) & !is.na(taxonomy$lpsn_renamed_to))], taxonomy$lpsn)]
 
@@ -1251,21 +1286,33 @@ taxonomy <- taxonomy %>%
 
 # no ghost families, orders classes, phyla
 taxonomy <- taxonomy %>%
-  group_by(kingdom, family) %>% filter(n() > 1 |  fullname %like% "unknown" | rank == "kingdom") %>%
+  group_by(kingdom, family) %>%
-  group_by(kingdom, order) %>% filter(n() > 1 |  fullname %like% "unknown" | rank == "kingdom") %>%
+  filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>%
-  group_by(kingdom, class) %>% filter(n() > 1 |  fullname %like% "unknown" | rank == "kingdom") %>%
+  group_by(kingdom, order) %>%
-  group_by(kingdom, phylum) %>% filter(n() > 1 |  fullname %like% "unknown" | rank == "kingdom") %>% 
+  filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>%
+  group_by(kingdom, class) %>%
+  filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>%
+  group_by(kingdom, phylum) %>%
+  filter(n() > 1 | fullname %like% "unknown" | rank == "kingdom") %>%
   ungroup()
 
 
-message("\nCongratulations! The new taxonomic table will contain ", format(nrow(taxonomy), big.mark = ","), " rows.\n",
+message(
-        "This was ", format(nrow(AMR::microorganisms), big.mark = ","), " rows.\n")
+  "\nCongratulations! The new taxonomic table will contain ", format(nrow(taxonomy), big.mark = ","), " rows.\n",
+  "This was ", format(nrow(AMR::microorganisms), big.mark = ","), " rows.\n"
+)
 
 # these are the new ones:
-taxonomy %>% filter(!paste(kingdom, fullname) %in% paste(AMR::microorganisms$kingdom, AMR::microorganisms$fullname)) %>% View()
+taxonomy %>%
+  filter(!paste(kingdom, fullname) %in% paste(AMR::microorganisms$kingdom, AMR::microorganisms$fullname)) %>%
+  View()
 # these were removed:
-AMR::microorganisms %>% filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname)) %>% View()
+AMR::microorganisms %>%
-AMR::microorganisms %>% filter(!fullname %in% taxonomy$fullname) %>% View()
+  filter(!paste(kingdom, fullname) %in% paste(taxonomy$kingdom, taxonomy$fullname)) %>%
+  View()
+AMR::microorganisms %>%
+  filter(!fullname %in% taxonomy$fullname) %>%
+  View()
 
 
 # Add SNOMED CT -----------------------------------------------------------

man/add_custom_microorganisms.Rd

@@ -58,8 +58,9 @@ mo_name("Enterobacter asburiae/cloacae")
 # now add a custom entry - it will be considered by as.mo() and
 # all mo_*() functions
 add_custom_microorganisms(
-  data.frame(genus = "Enterobacter",
+  data.frame(
-             species = "asburiae/cloacae"
+    genus = "Enterobacter",
+    species = "asburiae/cloacae"
   )
 )
 
@@ -81,8 +82,10 @@ mo_info("Enterobacter asburiae/cloacae")
 
 # the function tries to be forgiving:
 add_custom_microorganisms(
-  data.frame(GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE",
+  data.frame(
-             SPECIES = "SPECIES")
+    GENUS = "BACTEROIDES / PARABACTEROIDES SLASHLINE",
+    SPECIES = "SPECIES"
+  )
 )
 mo_name("BACTEROIDES / PARABACTEROIDES")
 mo_rank("BACTEROIDES / PARABACTEROIDES")
@@ -93,9 +96,11 @@ mo_family("Bacteroides/Parabacteroides")
 
 # for groups and complexes, set them as species or subspecies:
 add_custom_microorganisms(
-  data.frame(genus = "Citrobacter", 
+  data.frame(
-             species = c("freundii", "braakii complex"),
+    genus = "Citrobacter",
-             subspecies = c("complex", ""))
+    species = c("freundii", "braakii complex"),
+    subspecies = c("complex", "")
+  )
 )
 mo_name(c("C. freundii complex", "C. braakii complex"))
 mo_species(c("C. freundii complex", "C. braakii complex"))

man/antibiotic_class_selectors.Rd

@@ -214,20 +214,17 @@ example_isolates[, ab_selector(oral_ddd > 1 & oral_units == "g")]
 # dplyr -------------------------------------------------------------------
 \donttest{
 if (require("dplyr")) {
-
   # get AMR for all aminoglycosides e.g., per ward:
   example_isolates \%>\%
     group_by(ward) \%>\%
     summarise(across(aminoglycosides(), resistance))
 }
 if (require("dplyr")) {
-
   # You can combine selectors with '&' to be more specific:
   example_isolates \%>\%
     select(penicillins() & administrable_per_os())
 }
 if (require("dplyr")) {
-
   # get AMR for only drugs that matter - no intrinsic resistance:
   example_isolates \%>\%
     filter(mo_genus() \%in\% c("Escherichia", "Klebsiella")) \%>\%
@@ -235,7 +232,6 @@ if (require("dplyr")) {
     summarise(across(not_intrinsic_resistant(), resistance))
 }
 if (require("dplyr")) {
-
   # get susceptibility for antibiotics whose name contains "trim":
   example_isolates \%>\%
     filter(first_isolate()) \%>\%
@@ -243,19 +239,16 @@ if (require("dplyr")) {
     summarise(across(ab_selector(name \%like\% "trim"), susceptibility))
 }
 if (require("dplyr")) {
-
   # this will select columns 'IPM' (imipenem) and 'MEM' (meropenem):
   example_isolates \%>\%
     select(carbapenems())
 }
 if (require("dplyr")) {
-
   # this will select columns 'mo', 'AMK', 'GEN', 'KAN' and 'TOB':
   example_isolates \%>\%
     select(mo, aminoglycosides())
 }
 if (require("dplyr")) {
-
   # any() and all() work in dplyr's filter() too:
   example_isolates \%>\%
     filter(
@@ -264,25 +257,21 @@ if (require("dplyr")) {
     )
 }
 if (require("dplyr")) {
-
   # also works with c():
   example_isolates \%>\%
     filter(any(c(carbapenems(), aminoglycosides()) == "R"))
 }
 if (require("dplyr")) {
-
   # not setting any/all will automatically apply all():
   example_isolates \%>\%
     filter(aminoglycosides() == "R")
 }
 if (require("dplyr")) {
-
   # this will select columns 'mo' and all antimycobacterial drugs ('RIF'):
   example_isolates \%>\%
     select(mo, ab_class("mycobact"))
 }
 if (require("dplyr")) {
-
   # get bug/drug combinations for only glycopeptides in Gram-positives:
   example_isolates \%>\%
     filter(mo_is_gram_positive()) \%>\%
@@ -298,7 +287,6 @@ if (require("dplyr")) {
     select(penicillins()) # only the 'J01CA01' column will be selected
 }
 if (require("dplyr")) {
-
   # with recent versions of dplyr this is all equal:
   x <- example_isolates[carbapenems() == "R", ]
   y <- example_isolates \%>\% filter(carbapenems() == "R")

man/as.ab.Rd

@@ -91,7 +91,6 @@ ab_name("eryt")
 
 \donttest{
 if (require("dplyr")) {
-
   # you can quickly rename 'sir' columns using set_ab_names() with dplyr:
   example_isolates \%>\%
     set_ab_names(where(is.sir), property = "atc")

man/as.sir.Rd

@@ -125,7 +125,7 @@ your_data \%>\% mutate(across(where(is.disk), as.sir))
 \item For \strong{interpreting a complete data set}, with automatic determination of MIC values, disk diffusion diameters, microorganism names or codes, and antimicrobial test results. This is done very simply by running \code{as.sir(your_data)}.
 }
 
-For points 2, 3 and 4: Use \code{\link[=sir_interpretation_history]{sir_interpretation_history()}} to retrieve a \link{data.frame} (or \link[tibble:tibble]{tibble} if the \code{tibble} package is installed) with all results of the last \code{\link[=as.sir]{as.sir()}} call.
+\strong{For points 2, 3 and 4: Use \code{\link[=sir_interpretation_history]{sir_interpretation_history()}}} to retrieve a \link{data.frame} (or \link[tibble:tibble]{tibble} if the \code{tibble} package is installed) with all results of the last \code{\link[=as.sir]{as.sir()}} call.
 }
 
 \subsection{Supported Guidelines}{

man/first_isolate.Rd

@@ -179,13 +179,11 @@ if (require("dplyr")) {
     filter(first_isolate())
 }
 if (require("dplyr")) {
-
   # short-hand version:
   example_isolates \%>\%
     filter_first_isolate(info = FALSE)
 }
 if (require("dplyr")) {
-
   # flag the first isolates per group:
   example_isolates \%>\%
     group_by(ward) \%>\%

man/get_episode.Rd

@@ -44,11 +44,12 @@ is_new_episode(df$date, episode_days = 60) # TRUE/FALSE
 df[which(get_episode(df$date, 60) == 3), ]
 
 # the functions also work for less than a day, e.g. to include one per hour:
-get_episode(c(
+get_episode(
-  Sys.time(),
+  c(
-  Sys.time() + 60 * 60
+    Sys.time(),
-),
+    Sys.time() + 60 * 60
-episode_days = 1 / 24
+  ),
+  episode_days = 1 / 24
 )
 
 \donttest{
@@ -85,7 +86,6 @@ if (require("dplyr")) {
     )
 }
 if (require("dplyr")) {
-
   # grouping on patients and microorganisms leads to the same
   # results as first_isolate() when using 'episode-based':
   x <- df \%>\%
@@ -102,7 +102,6 @@ if (require("dplyr")) {
   identical(x, y)
 }
 if (require("dplyr")) {
-
   # but is_new_episode() has a lot more flexibility than first_isolate(),
   # since you can now group on anything that seems relevant:
   df \%>\%

man/ggplot_sir.Rd

@@ -138,13 +138,11 @@ At default, the names of antibiotics will be shown on the plots using \code{\lin
 \examples{
 \donttest{
 if (require("ggplot2") && require("dplyr")) {
-
   # get antimicrobial results for drugs against a UTI:
   ggplot(example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP)) +
     geom_sir()
 }
 if (require("ggplot2") && require("dplyr")) {
-
   # prettify the plot using some additional functions:
   df <- example_isolates \%>\% select(AMX, NIT, FOS, TMP, CIP)
   ggplot(df) +
@@ -155,21 +153,18 @@ if (require("ggplot2") && require("dplyr")) {
     theme_sir()
 }
 if (require("ggplot2") && require("dplyr")) {
-
   # or better yet, simplify this using the wrapper function - a single command:
   example_isolates \%>\%
     select(AMX, NIT, FOS, TMP, CIP) \%>\%
     ggplot_sir()
 }
 if (require("ggplot2") && require("dplyr")) {
-
   # get only proportions and no counts:
   example_isolates \%>\%
     select(AMX, NIT, FOS, TMP, CIP) \%>\%
     ggplot_sir(datalabels = FALSE)
 }
 if (require("ggplot2") && require("dplyr")) {
-
   # add other ggplot2 arguments as you like:
   example_isolates \%>\%
     select(AMX, NIT, FOS, TMP, CIP) \%>\%
@@ -182,14 +177,12 @@ if (require("ggplot2") && require("dplyr")) {
     )
 }
 if (require("ggplot2") && require("dplyr")) {
-
   # you can alter the colours with colour names:
   example_isolates \%>\%
     select(AMX) \%>\%
     ggplot_sir(colours = c(SI = "yellow"))
 }
 if (require("ggplot2") && require("dplyr")) {
-
   # but you can also use the built-in colour-blind friendly colours for
   # your plots, where "S" is green, "I" is yellow and "R" is red:
   data.frame(
@@ -202,7 +195,6 @@ if (require("ggplot2") && require("dplyr")) {
     scale_sir_colours(Value4 = "S", Value5 = "I", Value6 = "R")
 }
 if (require("ggplot2") && require("dplyr")) {
-
   # resistance of ciprofloxacine per age group
   example_isolates \%>\%
     mutate(first_isolate = first_isolate()) \%>\%
@@ -216,14 +208,12 @@ if (require("ggplot2") && require("dplyr")) {
     ggplot_sir(x = "age_group")
 }
 if (require("ggplot2") && require("dplyr")) {
-
   # a shorter version which also adjusts data label colours:
   example_isolates \%>\%
     select(AMX, NIT, FOS, TMP, CIP) \%>\%
     ggplot_sir(colours = FALSE)
 }
 if (require("ggplot2") && require("dplyr")) {
-
   # it also supports groups (don't forget to use the group var on `x` or `facet`):
   example_isolates \%>\%
     filter(mo_is_gram_negative(), ward != "Outpatient") \%>\%

man/mo_property.Rd

@@ -405,7 +405,6 @@ mo_species("EHEC")
 mo_fullname("K. pneu rh")
 mo_shortname("K. pneu rh")
 
-
 \donttest{
 # Becker classification, see ?as.mo ----------------------------------------
 

man/proportion.Rd

@@ -204,7 +204,6 @@ if (require("dplyr")) {
     )
 }
 if (require("dplyr")) {
-
   # scoped dplyr verbs with antibiotic selectors
   # (you could also use across() of course)
   example_isolates \%>\%

tests/tinytest.R

@@ -34,7 +34,7 @@
 
 # test only on GitHub Actions and at using RStudio jobs - not on CRAN as tests are lengthy
 if (tryCatch(isTRUE(AMR:::import_fn("isJob", "rstudioapi")()), error = function(e) FALSE) ||
-    identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
+  identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
   # env var 'R_LIBS_USER' got overwritten during 'R CMD check' in GitHub Actions, so:
   .libPaths(c(Sys.getenv("R_LIBS_USER_GH_ACTIONS"), .libPaths()))
   if (AMR:::pkg_is_available("tinytest", also_load = TRUE)) {

vignettes/AMR.Rmd

@@ -48,15 +48,16 @@ For this tutorial, we will create fake demonstration data to work with.
 You can skip to [Cleaning the data](#cleaning-the-data) if you already have your own data ready. If you start your analysis, try to make the structure of your data generally look like this:
 
 ```{r example table, echo = FALSE, results = 'asis'}
-knitr::kable(data.frame(
+knitr::kable(
-  date = Sys.Date(),
+  data.frame(
-  patient_id = c("abcd", "abcd", "efgh"),
+    date = Sys.Date(),
-  mo = "Escherichia coli",
+    patient_id = c("abcd", "abcd", "efgh"),
-  AMX = c("S", "S", "R"),
+    mo = "Escherichia coli",
-  CIP = c("S", "R", "S"),
+    AMX = c("S", "S", "R"),
-  stringsAsFactors = FALSE
+    CIP = c("S", "R", "S"),
-),
+    stringsAsFactors = FALSE
-align = "c"
+  ),
+  align = "c"
 )
 ``` 
 
@@ -129,14 +130,15 @@ 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 = sample(
-    "Hospital A",
+    c(
-    "Hospital B",
+      "Hospital A",
-    "Hospital C",
+      "Hospital B",
-    "Hospital D"
+      "Hospital C",
-  ),
+      "Hospital D"
-  size = sample_size, replace = TRUE,
+    ),
-  prob = c(0.30, 0.35, 0.15, 0.20)
+    size = sample_size, replace = TRUE,
+    prob = c(0.30, 0.35, 0.15, 0.20)
   ),
   bacteria = sample(bacteria,
     size = sample_size, replace = TRUE,
@@ -293,10 +295,11 @@ data_1st %>%
 ```
 
 ```{r bug_drg 2b, echo = FALSE, results = 'asis'}
-knitr::kable(data_1st %>%
+knitr::kable(
-  filter(any(aminoglycosides() == "R")) %>%
+  data_1st %>%
-  head(),
+    filter(any(aminoglycosides() == "R")) %>%
-align = "c"
+    head(),
+  align = "c"
 )
 ```
 
@@ -309,10 +312,11 @@ data_1st %>%
 ```
 
 ```{r bug_drg 1b, echo = FALSE, results = 'asis'}
-knitr::kable(data_1st %>%
+knitr::kable(
-  bug_drug_combinations() %>%
+  data_1st %>%
-  head(),
+    bug_drug_combinations() %>%
-align = "c"
+    head(),
+  align = "c"
 )
 ```
 
@@ -325,10 +329,11 @@ data_1st %>%
 
 
 ```{r bug_drg 3b, echo = FALSE, results = 'asis'}
-knitr::kable(data_1st %>%
+knitr::kable(
-  select(bacteria, aminoglycosides()) %>%
+  data_1st %>%
-  bug_drug_combinations(),
+    select(bacteria, aminoglycosides()) %>%
-align = "c"
+    bug_drug_combinations(),
+  align = "c"
 )
 ```
 

vignettes/WHONET.Rmd

@@ -88,11 +88,12 @@ data %>%
 
 ```{r, echo = FALSE}
 # on very old and some new releases of R, this may lead to an error
-tryCatch(data %>%
+tryCatch(
-  group_by(Country) %>%
+  data %>%
-  select(Country, AMP_ND2, AMC_ED20, CAZ_ED10, CIP_ED5) %>%
+    group_by(Country) %>%
-  ggplot_sir(translate_ab = "ab", facet = "Country", datalabels = FALSE) %>%
+    select(Country, AMP_ND2, AMC_ED20, CAZ_ED10, CIP_ED5) %>%
-  print(),
+    ggplot_sir(translate_ab = "ab", facet = "Country", datalabels = FALSE) %>%
-error = function(e) base::invisible()
+    print(),
+  error = function(e) base::invisible()
 )
 ```