fix antibiotics error

R/aa_helper_functions.R

@@ -1079,10 +1079,16 @@ try_colour <- function(..., before, after, collapse = " ") {
     txt
   }
 }
+is_dark <- function() {
+  if (is.null(AMR_env$is_dark_theme)) {
+    AMR_env$is_dark_theme <- tryCatch(isTRUE(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$dark), error = function(e) FALSE)
+  }
+  isTRUE(AMR_env$is_dark_theme)
+}
 font_black <- function(..., collapse = " ") {
   before <- "\033[38;5;232m"
   after <- "\033[39m"
-  if (isTRUE(AMR_env$is_dark_theme)) {
+  if (is_dark()) {
     # white
     before <- "\033[37m"
     after <- "\033[39m"
@@ -1092,7 +1098,7 @@ font_black <- function(..., collapse = " ") {
 font_white <- function(..., collapse = " ") {
   before <- "\033[37m"
   after <- "\033[39m"
-  if (isTRUE(AMR_env$is_dark_theme)) {
+  if (is_dark()) {
     # black
     before <- "\033[38;5;232m"
     after <- "\033[39m"
@@ -1371,17 +1377,19 @@ trimws2 <- function(..., whitespace = "[\u0009\u000A\u000B\u000C\u000D\u0020\u00
 # Faster data.table implementations ----
 
 match <- function(x, table, ...) {
-  if (isTRUE(AMR_env$has_data.table) && is.character(x) && is.character(table)) {
+  chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE)
+  if (!is.null(chmatch) && is.character(x) && is.character(table)) {
     # data.table::chmatch() is 35% faster than base::match() for character
-    getExportedValue(name = "chmatch", ns = asNamespace("data.table"))(x, table, ...)
+    chmatch(x, table, ...)
   } else {
     base::match(x, table, ...)
   }
 }
 `%in%` <- function(x, table) {
-  if (isTRUE(AMR_env$has_data.table) && is.character(x) && is.character(table)) {
+  chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
+  if (!is.null(chin) && is.character(x) && is.character(table)) {
     # data.table::`%chin%`() is 20-50% faster than base::`%in%`() for character
-    getExportedValue(name = "%chin%", ns = asNamespace("data.table"))(x, table)
+    chin(x, table)
   } else {
     base::`%in%`(x, table)
   }

R/ab.R

@@ -492,14 +492,17 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
   }
 
   # save to package env to save time for next time
-  AMR_env$ab_previously_coerced <- unique(rbind(AMR_env$ab_previously_coerced,
-    data.frame(
-      x = x,
-      ab = x_new,
+  if (initial_search == TRUE) {
+    AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$x %in% x), , drop = FALSE]
+    AMR_env$ab_previously_coerced <- unique(rbind(AMR_env$ab_previously_coerced,
+      data.frame(
+        x = x,
+        ab = x_new,
+        stringsAsFactors = FALSE
+      ),
       stringsAsFactors = FALSE
-    ),
-    stringsAsFactors = FALSE
-  ))
+    ))
+  }
 
   # take failed ATC codes apart from rest
   if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) {
@@ -509,7 +512,8 @@ 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,
+                 AMR_env$ab_previously_coerced$x[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: ",

R/add_custom_antimicrobials.R

@@ -40,7 +40,7 @@
 #' # Add custom antibiotic codes:
 #' library(AMR)
 #' add_custom_antimicrobials(
-#'   data.frame(ab = "TEST",
+#'   data.frame(ab = "TESTAB",
 #'              name = "Test Antibiotic",
 #'              group = "Test Group")
 #' )
@@ -54,14 +54,14 @@
 #'
 #' # returns NA and throws a warning (which is now suppressed):
 #' suppressWarnings(
-#'   as.ab("test")
+#'   as.ab("testab")
 #' )
 #'
 #' # now add a custom entry - it will be considered by as.ab() and
 #' # all ab_*() functions
 #' add_custom_antimicrobials(
 #'   data.frame(
-#'     ab = "TEST",
+#'     ab = "TESTAB",
 #'     name = "Test Antibiotic",
 #'     # you can add any property present in the
 #'     # 'antibiotics' data set, such as 'group':
@@ -69,12 +69,12 @@
 #'   )
 #' )
 #'
-#' # "test" is now a new antibiotic:
-#' as.ab("test")
-#' ab_name("test")
-#' ab_group("test")
+#' # "testab" is now a new antibiotic:
+#' as.ab("testab")
+#' ab_name("testab")
+#' ab_group("testab")
 #'
-#' ab_info("test")
+#' ab_info("testab")
 #'
 #'
 #' # Add Co-fluampicil, which is one of the many J01CR50 codes, see
@@ -92,7 +92,7 @@
 #'
 #' # even antibiotic selectors work
 #' x <- data.frame(
-#'   random_column = "test",
+#'   random_column = "some value",
 #'   coflu = as.rsi("S"),
 #'   ampicillin = as.rsi("R")
 #' )

R/mo_property.R

@@ -513,8 +513,9 @@ mo_is_intrinsic_resistant <- function(x, ab, language = get_AMR_locale(), keep_s
     )
   }
 
-  # runs against internal vector: INTRINSIC_R (see zzz.R)
-  paste(x, ab) %in% INTRINSIC_R
+  # runs against internal vector: intrinsic_resistant (see zzz.R)
+  add_intrinsic_resistance_to_AMR_env()
+  paste(x, ab) %in% AMR_env$intrinsic_resistant
 }
 
 #' @rdname mo_property

R/rsi.R

@@ -848,7 +848,8 @@ as_rsi_method <- function(method_short,
   any_is_intrinsic_resistant <- FALSE
 
   for (i in seq_len(length(x))) {
-    is_intrinsic_r <- paste(mo[i], ab_param) %in% INTRINSIC_R
+    add_intrinsic_resistance_to_AMR_env()
+    is_intrinsic_r <- paste(mo[i], ab_param) %in% AMR_env$intrinsic_resistant
     any_is_intrinsic_resistant <- any_is_intrinsic_resistant | is_intrinsic_r
 
     if (isTRUE(add_intrinsic_resistance) & is_intrinsic_r) {

R/zzz.R

@@ -66,9 +66,8 @@ AMR_env$rsi_interpretation_history <- data.frame(
   interpretation = character(0),
   stringsAsFactors = FALSE
 )
-AMR_env$has_data.table <- pkg_is_available("data.table", also_load = FALSE)
 AMR_env$custom_ab_codes <- character(0)
-AMR_env$is_dark_theme <- tryCatch(isTRUE(getExportedValue("getThemeInfo", ns = asNamespace("rstudioapi"))()$dark), error = function(e) FALSE)
+AMR_env$is_dark_theme <- NULL
 
 # determine info icon for messages
 utf8_supported <- isTRUE(base::l10n_info()$`UTF-8`)
@@ -150,8 +149,6 @@ if (utf8_supported && !is_latex) {
   # they cannot be part of R/sysdata.rda since CRAN thinks it would make the package too large (+3 MB)
   AMR_env$AB_lookup <- create_AB_lookup()
   AMR_env$MO_lookup <- create_MO_lookup()
-  # for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector
-  assign(x = "INTRINSIC_R", value = create_intr_resistance(), envir = asNamespace("AMR"))
 }
 
 .onAttach <- function(lib, pkg) {
@@ -184,37 +181,16 @@ create_MO_lookup <- function() {
   # all the rest
   MO_lookup[which(is.na(MO_lookup$kingdom_index)), "kingdom_index"] <- 5
 
-  # # use this paste instead of `fullname` to work with Viridans Group Streptococci, etc.
-  # if (length(MO_FULLNAME_LOWER) == nrow(MO_lookup)) {
-  #   MO_lookup$fullname_lower <- MO_FULLNAME_LOWER
-  # } else {
-  #   MO_lookup$fullname_lower <- ""
-  #   warning("MO table updated - Run: source(\"data-raw/_pre_commit_hook.R\")", call. = FALSE)
-  # }
-
-  MO_lookup$fullname_lower <- create_MO_fullname_lower()
+  MO_lookup$fullname_lower <- MO_FULLNAME_LOWER
   MO_lookup$full_first <- substr(MO_lookup$fullname_lower, 1, 1)
   MO_lookup$species_first <- substr(MO_lookup$species, 1, 1)
 
-  # so arrange data on prevalence first, then kingdom, then full name
-  MO_lookup[order(MO_lookup$prevalence, MO_lookup$kingdom_index, MO_lookup$fullname_lower), , drop = FALSE]
+  MO_lookup
 }
 
-create_MO_fullname_lower <- function() {
-  MO_lookup <- AMR::microorganisms
-  # use this paste instead of `fullname` to work with Viridans Group Streptococci, etc.
-  MO_lookup$fullname_lower <- tolower(trimws(paste(
-    MO_lookup$genus,
-    MO_lookup$species,
-    MO_lookup$subspecies
-  )))
-  ind <- MO_lookup$genus == "" | grepl("^[(]unknown ", MO_lookup$fullname, perl = TRUE)
-  MO_lookup[ind, "fullname_lower"] <- tolower(MO_lookup[ind, "fullname", drop = TRUE])
-  MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", MO_lookup$fullname_lower, perl = TRUE))
-  MO_lookup$fullname_lower
-}
-
-create_intr_resistance <- function() {
+add_intrinsic_resistance_to_AMR_env <- function() {
   # for mo_is_intrinsic_resistant() - saves a lot of time when executed on this vector
-  paste(AMR::intrinsic_resistant$mo, AMR::intrinsic_resistant$ab)
+  if (is.null(AMR_env$intrinsic_resistant)) {
+    AMR_env$intrinsic_resistant <- paste(AMR::intrinsic_resistant$mo, AMR::intrinsic_resistant$ab)
+  }
 }