From 891d248fab48b221f3fffa59327e37ca844b84cd Mon Sep 17 00:00:00 2001 From: Matthijs Berends <31037261+msberends@users.noreply.github.com> Date: Wed, 7 Oct 2026 14:29:48 +0200 Subject: [PATCH] Improve the session caches of as.ab(), as.mo() and all mo_*() functions (#313) (#314) - One cache design for as.ab() and as.mo() in R/aa_session_cache.R: lazily built lookup indices (ATC codes, drug synonyms, SNOMED codes) and coercion caches with the same structure (key, input, value), keyed on input plus outcome-relevant settings - Caches are invalidated whenever the lookup tables change (custom antimicrobials or microorganisms, set_mo_source()) - mo_*() functions use a fast path for valid input and work on unique values only - synonym_mo_to_accepted_mo() is memoised per code - Fix as.mo() cache keys that never matched again, fast_mode results of as.ab() being reused by regular calls, and ab_reset_session() clearing as.mo() uncertainties Co-authored-by: Claude Opus 5.5 --- DESCRIPTION | 4 +- NEWS.md | 9 +- R/aa_helper_functions.R | 2 + R/aa_session_cache.R | 133 ++++++++++++++++++++++++++++ R/ab.R | 77 +++++++--------- R/custom_antimicrobials.R | 5 +- R/custom_microorganisms.R | 12 +-- R/mo.R | 123 ++++++++++++++++++------- R/mo_property.R | 67 +++++++++----- R/mo_source.R | 3 + R/zzz.R | 14 +-- man/as.ab.Rd | 2 + man/as.mo.Rd | 2 + tests/testthat/test-session_cache.R | 133 ++++++++++++++++++++++++++++ 14 files changed, 462 insertions(+), 124 deletions(-) create mode 100644 R/aa_session_cache.R create mode 100644 tests/testthat/test-session_cache.R diff --git a/DESCRIPTION b/DESCRIPTION index 353dca2e2..8aca3aa39 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 3.0.1.9103 -Date: 2026-10-04 +Version: 3.0.1.9106 +Date: 2026-10-07 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 diff --git a/NEWS.md b/NEWS.md index 4d7bf1ef2..cb7ec1586 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 3.0.1.9103 +# AMR 3.0.1.9106 Planned as v3.1.0, mid October 2026. @@ -56,6 +56,9 @@ Planned as v3.1.0, mid October 2026. * Assumption of disk zones are now preferred over MIC values when input is only whole numbers (#291) * `as.mic()`: values in scientific notation (e.g. `1e-3`) now handled correctly * `as.ab()`: codes containing "PH" or "TH" (e.g. `ETH`, `PHE`) no longer return `NA` when mixed with unrecognised input (#245) +* `as.ab()`: results of `fast_mode` (used internally) were remembered and reused by later regular calls, which could return `NA` for valid input (#313) +* `as.mo()`: previously coerced input was often not recognised again, e.g. for an unknown species of a known genus, so it was matched again on every call (#313) +* `ab_reset_session()` no longer clears the uncertainties of `as.mo()` (#313) * Combined MIC/SIR input values (e.g. `"<= 0.002; S"` or `"S; 0.002"`) now parsed correctly (#252) * `as.mo()`: * Input of the form `"X complex"` now falls back to `"X"` when the complex is not a distinct taxon in the database, preventing `NA` results for valid clinical descriptions such as `"Proteus vulgaris complex"` (#287) @@ -74,6 +77,10 @@ Planned as v3.1.0, mid October 2026. * Taxonomy: consistent higher taxonomy and parent records, and data sets refer only to current names (except `intrinsic_resistant`) ### Updated +* Faster `as.ab()`, `as.mo()` and all `mo_*()` functions through one consistent session cache design, which is cleared when lookup tables change, e.g. after `add_custom_microorganisms()` (#313) + * `mo_*()` functions retrieve properties of valid `` input directly, and only for unique values + * The mapping of outdated taxonomic names to their current names is remembered per code + * `mo_uncertainties()` now also lists uncertainties of previously coerced input * `top_n_microorganisms()`: new `property_for_each` argument for sub-grouping within top *n* groups; rank ordering enforced (only lower taxonomic ranks allowed); fixed `property = NULL` not being accepted; inner filter now tracks original row indices to prevent cross-group contamination * Taxonomic update for all microorganisms, now updated to COL 2026-04-18 XR, LPSN and BacDive of October 2026, and MycoBank of January 2026 * `mo_kingdom()` now returns the formal taxonomic kingdom; a one-time note per session explains the change when querying bacterial or archaeal records. diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 8b55644a6..6fc1b4a96 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -1697,6 +1697,8 @@ add_MO_lookup_to_AMR_env <- function() { 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 AMR_env$MO_lookup <- MO_lookup + # a new lookup table, so derived caches must be rebuilt + reset_mo_cache() } } diff --git a/R/aa_session_cache.R b/R/aa_session_cache.R new file mode 100644 index 000000000..99e48ea98 --- /dev/null +++ b/R/aa_session_cache.R @@ -0,0 +1,133 @@ +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://amr-for-r.org # +# ==================================================================== # + + +# SESSION CACHES ------------------------------------------------------ +# +# as.ab() and as.mo() share one cache design, kept in the package environment `AMR_env`: +# +# 1. Lookup indices, derived from `AMR_env$AB_lookup` and `AMR_env$MO_lookup` (e.g. all ATC codes or SNOMED +# codes as one flat vector). These are built lazily on first use, see get_ab_index() and get_mo_index(). +# 2. Coercion caches, `AMR_env$ab_previously_coerced` and `AMR_env$mo_previously_coerced`, that remember the +# outcome of earlier coercions. Both have the same structure: a `key` (the cleaned input together with the +# settings that affect the outcome), the original `input`, and the resulting code as `value`. +# 3. For microorganisms, the mapping from (outdated) codes to codes of currently accepted names, which is +# memoised per unique code, see synonym_mo_to_accepted_mo(). +# +# All of these are invalidated with reset_ab_cache() or reset_mo_cache(), which must be called whenever the +# lookup tables change, e.g. in add_custom_antimicrobials() and add_custom_microorganisms(). + +new_coercion_cache <- function() { + data.frame( + key = character(0), + input = character(0), + value = character(0), + stringsAsFactors = FALSE + ) +} + +coercion_cache_key <- function(x, ...) { + # all arguments in `...` are settings that can change the outcome of a coercion, they become part of the key + if (length(x) == 0) { + return(character(0)) + } + settings <- vapply(FUN.VALUE = character(1), list(...), function(s) paste0(s, collapse = "")) + paste(x, paste(settings, collapse = "|"), sep = "|") +} + +coercion_cache_has <- function(type, keys) { + keys %in% AMR_env[[paste0(type, "_previously_coerced")]]$key +} + +coercion_cache_get <- function(type, keys) { + cache <- AMR_env[[paste0(type, "_previously_coerced")]] + cache$value[match(keys, cache$key)] +} + +coercion_cache_add <- function(type, keys, inputs, values) { + cache_name <- paste0(type, "_previously_coerced") + keep <- !is.na(keys) & !duplicated(keys) + if (!any(keep)) { + return(invisible(NULL)) + } + keys <- keys[keep] + cache <- AMR_env[[cache_name]] + AMR_env[[cache_name]] <- rbind_AMR( + cache[which(!cache$key %in% keys), , drop = FALSE], + data.frame( + key = keys, + input = as.character(inputs[keep]), + value = as.character(values[keep]), + stringsAsFactors = FALSE + ) + ) + invisible(NULL) +} + +reset_ab_cache <- function() { + AMR_env$AB_index <- NULL + AMR_env$ab_previously_coerced <- new_coercion_cache() +} + +reset_mo_cache <- function() { + AMR_env$MO_index <- NULL + AMR_env$mo_accepted <- NULL + AMR_env$mo_previously_coerced <- new_coercion_cache() + AMR_env$mo_previously_uncertain <- NULL +} + +get_ab_index <- function() { + if (is.null(AMR_env$AB_index)) { + ab <- as.character(AMR_env$AB_lookup$ab) + atc <- unlist(AMR_env$AB_lookup$atc, use.names = FALSE) + atc_ab <- rep(ab, lengths(AMR_env$AB_lookup$atc)) + synonyms <- tolower(unlist(AMR_env$AB_lookup$synonyms, use.names = FALSE)) + synonyms_ab <- rep(ab, lengths(AMR_env$AB_lookup$synonyms)) + AMR_env$AB_index <- list( + atc = atc[!is.na(atc)], + atc_ab = atc_ab[!is.na(atc)], + synonyms = synonyms[!is.na(synonyms)], + synonyms_ab = synonyms_ab[!is.na(synonyms)] + ) + } + AMR_env$AB_index +} + +get_mo_index <- function() { + add_MO_lookup_to_AMR_env() + if (is.null(AMR_env$MO_index)) { + snomed <- unlist(AMR_env$MO_lookup$snomed, use.names = FALSE) + snomed_mo <- rep(as.character(AMR_env$MO_lookup$mo), lengths(AMR_env$MO_lookup$snomed)) + AMR_env$MO_index <- list( + snomed = snomed[!is.na(snomed)], + snomed_mo = snomed_mo[!is.na(snomed)] + ) + } + AMR_env$MO_index +} diff --git a/R/ab.R b/R/ab.R index d4f9e7241..623c9b2d1 100755 --- a/R/ab.R +++ b/R/ab.R @@ -48,6 +48,8 @@ #' #' Use the [`ab_*`][ab_property()] functions to get properties based on the returned antibiotic ID, see *Examples*. #' +#' Results of non-exact input are remembered during the session, so that the same input is not matched again. Use [ab_reset_session()] to forget these results. They are also forgotten after [add_custom_antimicrobials()] or [clear_custom_antimicrobials()]. +#' #' Note: the [as.ab()] and [`ab_*`][ab_property()] functions may use very long regular expression to match brand names of antimicrobial drugs. This may fail on some systems. #' #' You can add your own manual codes to be considered by [as.ab()] and all [`ab_*`][ab_property()] functions, see [add_custom_antimicrobials()]. @@ -160,40 +162,25 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(), known_names <- x %in% AMR_env$AB_lookup$generalised_name x_new[known_names] <- AMR_env$AB_lookup$ab[match(x[known_names], AMR_env$AB_lookup$generalised_name)] known_codes_ab <- x %in% AMR_env$AB_lookup$ab - known_codes_atc <- vapply(FUN.VALUE = logical(1), gsub(" ", "", x), function(x_) x_ %in% unlist(AMR_env$AB_lookup$atc), USE.NAMES = FALSE) - known_codes_synonyms <- vapply(FUN.VALUE = logical(1), gsub(" ", "", tolower(x)), function(x_) x_ %in% tolower(unlist(AMR_env$AB_lookup$synonyms)), USE.NAMES = FALSE) + # ATC codes and synonyms are looked up in flat vectors that are built once per session + ab_index <- get_ab_index() + x_atc <- gsub(" ", "", x, fixed = TRUE) + x_synonym <- gsub(" ", "", tolower(x), fixed = TRUE) + known_codes_atc <- x_atc %in% ab_index$atc + known_codes_synonyms <- x_synonym %in% ab_index$synonyms known_codes_cid <- x %in% AMR_env$AB_lookup$cid x_new[known_codes_ab] <- AMR_env$AB_lookup$ab[match(x[known_codes_ab], AMR_env$AB_lookup$ab)] - x_new[known_codes_atc] <- AMR_env$AB_lookup$ab[vapply( - FUN.VALUE = integer(1), - gsub(" ", "", x[known_codes_atc]), - function(x_) { - which(vapply( - FUN.VALUE = logical(1), - AMR_env$AB_lookup$atc, - function(atc) x_ %in% atc - ))[1L] - }, - USE.NAMES = FALSE - )] - x_new[known_codes_synonyms] <- AMR_env$AB_lookup$ab[vapply( - FUN.VALUE = integer(1), - gsub(" ", "", tolower(x[known_codes_synonyms])), - function(x_) { - which(vapply( - FUN.VALUE = logical(1), - AMR_env$AB_lookup$synonyms, - function(syns) x_ %in% tolower(syns) - ))[1L] - }, - USE.NAMES = FALSE - )] + x_new[known_codes_atc] <- ab_index$atc_ab[match(x_atc[known_codes_atc], ab_index$atc)] + x_new[known_codes_synonyms] <- ab_index$synonyms_ab[match(x_synonym[known_codes_synonyms], ab_index$synonyms)] x_new[known_codes_cid] <- AMR_env$AB_lookup$ab[match(x[known_codes_cid], AMR_env$AB_lookup$cid)] - previously_coerced <- x %in% AMR_env$ab_previously_coerced$x - x_new[previously_coerced & is.na(x_new)] <- AMR_env$ab_previously_coerced$ab[match(x[is.na(x_new) & x %in% AMR_env$ab_previously_coerced$x], AMR_env$ab_previously_coerced$x)] - previously_coerced_mention <- !is.na(x) & x %in% AMR_env$ab_previously_coerced$x & !x %in% AMR_env$AB_lookup$ab & !x %in% AMR_env$AB_lookup$generalised_name + # From previous hits in this session ---- + # the key contains all settings that can change the outcome, so that e.g. a `fast_mode` result is never reused otherwise + cache_keys <- coercion_cache_key(x, fast_mode, flag_multiple_results, language) + previously_coerced <- !is.na(x) & is.na(x_new) & coercion_cache_has("ab", cache_keys) + x_new[previously_coerced] <- coercion_cache_get("ab", cache_keys[previously_coerced]) + previously_coerced_mention <- previously_coerced & !is.na(x_new) if (any(previously_coerced_mention) && isTRUE(info) && message_not_thrown_before("as.ab", entire_session = TRUE)) { - only_one <- length(unique(which(x[which(previously_coerced)] %in% x_bak_clean))) == 1 + only_one <- sum(previously_coerced_mention) == 1 message_( "Returning ", ifelse(only_one, "a ", ""), "previously coerced ", ifelse(only_one, "value for an antimicrobial", "values for various antimicrobials"), @@ -431,16 +418,13 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(), } # save to package env to save time for next time - 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( - AMR_env$ab_previously_coerced, - data.frame( - x = x, - ab = x_new, - x_bak = x_bak[match(x, x_bak_clean)], - stringsAsFactors = FALSE - ) - )) + coerced_now <- which(!already_known & !is.na(x)) + coercion_cache_add( + "ab", + keys = cache_keys[coerced_now], + inputs = x_bak[match(x[coerced_now], x_bak_clean)], + values = x_new[coerced_now] + ) # take failed ATC codes apart from rest if (length(x_unknown_ATCs) > 0 && fast_mode == FALSE) { @@ -454,9 +438,9 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(), x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs] x_unknown <- c( 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))] + x_bak[match(x[previously_coerced & is.na(x_new)], x_bak_clean)] ) - x_unknown <- x_unknown[!x_unknown %in% c("", NA)] + x_unknown <- unique(x_unknown[!x_unknown %in% c("", NA)]) if (length(x_unknown) > 0 && fast_mode == FALSE) { warning_( "in {.help [{.fun as.ab}](AMR::as.ab)}: ", ifelse(length(unique(x_unknown)) == 1, "this value", "these values"), " could not be coerced to a valid antimicrobial ID: ", @@ -466,16 +450,16 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(), # Throw note about uncertainties x_uncertain <- x_uncertain[!is.na(x_uncertain)] - AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[!is.na(AMR_env$ab_previously_coerced$x), ] if (isTRUE(info) && length(x_uncertain) > 0 && fast_mode == FALSE) { x_uncertain <- unique(x_uncertain) if (message_not_thrown_before("as.ab", "uncertainties", x_bak)) { if (length(x_uncertain) <= 3) { + ab_uncertain <- x_new[match(x_bak_clean[match(x_uncertain, x_bak)], x)] examples <- vector_and( paste0( '"', x_uncertain, '" (assumed ', - ab_name(AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], language = NULL, tolower = TRUE), - ", ", AMR_env$ab_previously_coerced$ab[which(AMR_env$ab_previously_coerced$x_bak %in% x_uncertain)], ")" + ab_name(ab_uncertain, language = NULL, tolower = TRUE), + ", ", ab_uncertain, ")" ), quotes = FALSE ) @@ -510,8 +494,7 @@ is.ab <- function(x) { ab_reset_session <- function() { if (NROW(AMR_env$ab_previously_coerced) > 0) { message_("Reset ", nr2char(NROW(AMR_env$ab_previously_coerced)), " previously matched input value", ifelse(NROW(AMR_env$ab_previously_coerced) > 1, "s", ""), ".") - AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[0, , drop = FALSE] - AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE] + AMR_env$ab_previously_coerced <- new_coercion_cache() } else { message_("No previously matched input values to reset.") } diff --git a/R/custom_antimicrobials.R b/R/custom_antimicrobials.R index 068ccdb11..658c87f9c 100755 --- a/R/custom_antimicrobials.R +++ b/R/custom_antimicrobials.R @@ -153,8 +153,9 @@ add_custom_antimicrobials <- function(x) { } AMR_env$AB_lookup <- unique(rbind_AMR(AMR_env$AB_lookup, new_df)) - AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(!AMR_env$ab_previously_coerced$ab %in% c(x$ab, x$generalised_name) & !AMR_env$ab_previously_coerced$x %in% c(x$ab, x$generalised_name)), , drop = FALSE] class(AMR_env$AB_lookup$ab) <- c("ab", "character") + # the lookup table changed, so earlier coercions and lookup indices are no longer valid + reset_ab_cache() message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal {.code antimicrobials} data set.") } @@ -165,6 +166,6 @@ clear_custom_antimicrobials <- function() { AMR_env$AB_lookup <- cbind(AMR::antimicrobials, AB_LOOKUP) n2 <- nrow(AMR_env$AB_lookup) AMR_env$custom_ab_codes <- character(0) - AMR_env$ab_previously_coerced <- AMR_env$ab_previously_coerced[which(AMR_env$ab_previously_coerced$ab %in% AMR_env$AB_lookup$ab), , drop = FALSE] + reset_ab_cache() message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal {.help [antimicrobials](AMR::antimicrobials)} data set.") } diff --git a/R/custom_microorganisms.R b/R/custom_microorganisms.R index 799fd9ff7..c9ce6ad39 100755 --- a/R/custom_microorganisms.R +++ b/R/custom_microorganisms.R @@ -278,11 +278,11 @@ add_custom_microorganisms <- function(x) { new_df[, col] <- x[, col, drop = TRUE] } - # clear previous coercions - suppressMessages(mo_reset_session()) - AMR_env$MO_lookup <- unique(rbind_AMR(AMR_env$MO_lookup, new_df)) class(AMR_env$MO_lookup$mo) <- c("mo", "character") + # the lookup table changed, so earlier coercions and lookup indices are no longer valid + reset_mo_cache() + AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE] if (nrow(x) <= 3) { message_("Added ", vector_and(italicise(x$fullname), quotes = FALSE), " to the internal {.code microorganisms} data set.") } else { @@ -295,16 +295,12 @@ add_custom_microorganisms <- function(x) { clear_custom_microorganisms <- function() { n <- nrow(AMR_env$MO_lookup) - # reset + # reset, which also invalidates earlier coercions and lookup indices AMR_env$MO_lookup <- NULL add_MO_lookup_to_AMR_env() - # clear previous coercions - suppressMessages(mo_reset_session()) - n2 <- nrow(AMR_env$MO_lookup) AMR_env$custom_mo_codes <- character(0) - AMR_env$mo_previously_coerced <- AMR_env$mo_previously_coerced[which(AMR_env$mo_previously_coerced$mo %in% AMR_env$MO_lookup$mo), , drop = FALSE] AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE] message_("Cleared ", nr2char(n - n2), " custom record", ifelse(n - n2 > 1, "s", ""), " from the internal {.code microorganisms} data set.") } diff --git a/R/mo.R b/R/mo.R index deb138dc8..df255f191 100755 --- a/R/mo.R +++ b/R/mo.R @@ -86,6 +86,8 @@ #' - Use [mo_failures()] to get a [character] [vector] with all values that could not be coerced to a valid value. #' - Use [mo_renamed()] to get a [data.frame] with all values that could be coerced based on outdated, previously accepted taxonomic names. #' +#' Results of non-exact input are remembered during the session, so that the same input is not matched again. This only applies to the same settings of `minimum_matching_score`, `only_fungi` and `cleaning_regex`. Use [mo_reset_session()] to forget these results. They are also forgotten when the taxonomy changes, e.g. after [add_custom_microorganisms()]. +#' #' ### For Mycologists #' #' The [matching score algorithm][mo_matching_score()] gives precedence to bacteria over fungi. If you are only analysing fungi, be sure to use `only_fungi = TRUE`, or better yet, add this to your code and run it once every session: @@ -207,13 +209,15 @@ as.mo <- function(x, add_MO_lookup_to_AMR_env() - if (tryCatch(all(x %in% c(AMR_env$MO_lookup$mo, NA)), error = function(e) FALSE) && - isFALSE(Becker) && - isFALSE(Lancefield) && - isTRUE(keep_synonyms)) { - # don't look into valid MO codes, just return them + if (isFALSE(Becker) && isFALSE(Lancefield) && is.atomic(x) && is.null(dim(x))) { + # don't look into valid MO codes, just return them, unless synonyms must be replaced # is.mo() won't work - MO codes might change between package versions - return(set_clean_class(x, new_class = c("mo", "character"))) + x_unique <- unique(as.character(x)) + x_index <- match(x_unique, AMR_env$MO_lookup$mo) + if (all(!is.na(x_index) | is.na(x_unique)) && + (isTRUE(keep_synonyms) || !any(AMR_env$MO_lookup$status[x_index] == "synonym", na.rm = TRUE))) { + return(set_clean_class(x, new_class = c("mo", "character"))) + } } # start off with replaced language-specific non-ASCII characters with ASCII characters @@ -253,26 +257,31 @@ as.mo <- function(x, ) } # From SNOMED ---- - # based on this extremely fast gem: https://stackoverflow.com/a/11002456/4575331 - snomeds <- unlist(AMR_env$MO_lookup$snomed) - snomeds <- snomeds[!is.na(snomeds)] - out[is.na(out) & x %in% snomeds] <- AMR_env$MO_lookup$mo[rep(seq_along(AMR_env$MO_lookup$snomed), vapply(FUN.VALUE = double(1), AMR_env$MO_lookup$snomed, length))[match(x[is.na(out) & x %in% snomeds], snomeds)]] + # SNOMED codes are looked up in a flat vector that is built once per session + mo_index <- get_mo_index() + ind <- is.na(out) & x %in% mo_index$snomed + out[ind] <- mo_index$snomed_mo[match(x[ind], mo_index$snomed)] # From other familiar output ---- # such as Salmonella groups, colloquial names, etc. out[is.na(out)] <- convert_colloquial_input(x[is.na(out)]) # From previous hits in this session ---- - old <- out - out[is.na(out) & paste(x, minimum_matching_score, only_fungi) %in% AMR_env$mo_previously_coerced$x] <- AMR_env$mo_previously_coerced$mo[match(paste(x, minimum_matching_score, only_fungi)[is.na(out) & paste(x, minimum_matching_score, only_fungi) %in% AMR_env$mo_previously_coerced$x], AMR_env$mo_previously_coerced$x)] - new <- out - if (isTRUE(info) && message_not_thrown_before("as.mo", old, new, entire_session = TRUE) && any(is.na(old) & !is.na(new), na.rm = TRUE)) { + x_left <- unique(x[is.na(out) & !is.na(x)]) + cache_keys_left <- coercion_cache_key(x_left, minimum_matching_score, only_fungi, cleaning_regex) + cache_hit <- coercion_cache_has("mo", cache_keys_left) + previously_coerced <- is.na(out) & x %in% x_left[cache_hit] + out[previously_coerced] <- coercion_cache_get("mo", cache_keys_left[cache_hit])[match(x[previously_coerced], x_left[cache_hit])] + previously_coerced_mention <- previously_coerced & out != "UNKNOWN" + if (isTRUE(info) && any(previously_coerced_mention) && message_not_thrown_before("as.mo", x[previously_coerced_mention], entire_session = TRUE)) { message_( - "Returning previously coerced value", ifelse(sum(is.na(old) & !is.na(new)) > 1, "s", ""), - " for ", vector_and(x[is.na(old) & !is.na(new)]), ". Run {.help [{.fun mo_reset_session}](AMR::mo_reset_session)} to reset this. This note will be shown once per session for this input." + "Returning previously coerced value", ifelse(length(unique(x[previously_coerced_mention])) > 1, "s", ""), + " for ", vector_and(x[previously_coerced_mention]), ". Run {.help [{.fun mo_reset_session}](AMR::mo_reset_session)} to reset this. This note will be shown once per session for this input." ) } # For all other input ---- - if (any(is.na(out) & !is.na(x))) { + to_coerce <- is.na(out) & !is.na(x) + if (any(to_coerce)) { + x_before_cleaning <- x # reset uncertainties AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, ] AMR_env$mo_failures <- NULL @@ -474,15 +483,6 @@ as.mo <- function(x, stringsAsFactors = FALSE ) ) - # save to package env to save time for next time - AMR_env$mo_previously_coerced <- unique(rbind_AMR( - AMR_env$mo_previously_coerced, - data.frame( - x = paste(x_search, minimum_matching_score, only_fungi), - mo = result_mo, - stringsAsFactors = FALSE - ) - )) } # the actual result: as.character(result_mo) @@ -493,6 +493,27 @@ as.mo <- function(x, # expand from unique again out[is.na(out)] <- x_coerced[match(x[is.na(out)], x_unique)] + # save to package env to save time for next time, using the input from before the cleaning steps above + coerced_now <- which(to_coerce & !is.na(x)) + coerced_now <- coerced_now[!duplicated(x_before_cleaning[coerced_now])] + cache_keys_now <- coercion_cache_key(x_before_cleaning[coerced_now], minimum_matching_score, only_fungi, cleaning_regex) + value_now <- out[coerced_now] + value_now[is.na(value_now)] <- "UNKNOWN" + coercion_cache_add("mo", keys = cache_keys_now, inputs = x_before_cleaning[coerced_now], values = value_now) + # also save the uncertainties, so that mo_uncertainties() remains complete for previously coerced input + uncertainty_row <- match(x[coerced_now], AMR_env$mo_uncertainties$original_input) + if (any(!is.na(uncertainty_row))) { + previously_uncertain <- AMR_env$mo_previously_uncertain + AMR_env$mo_previously_uncertain <- rbind_AMR( + previously_uncertain[which(!previously_uncertain$key %in% cache_keys_now), , drop = FALSE], + cbind( + key = cache_keys_now[!is.na(uncertainty_row)], + AMR_env$mo_uncertainties[uncertainty_row[!is.na(uncertainty_row)], , drop = FALSE], + stringsAsFactors = FALSE + ) + ) + } + # Throw note about uncertainties ---- if (isTRUE(info) && NROW(AMR_env$mo_uncertainties) > 0) { if (message_not_thrown_before("as.mo", "uncertainties", AMR_env$mo_uncertainties$original_input)) { @@ -523,6 +544,19 @@ as.mo <- function(x, } } # end of loop over all yet unknowns + # Add uncertainties of previously coerced input ---- + previously_uncertain <- AMR_env$mo_previously_uncertain + previously_uncertain <- previously_uncertain[which(previously_uncertain$key %in% cache_keys_left[cache_hit]), , drop = FALSE] + if (NROW(previously_uncertain) > 0) { + if (!any(to_coerce)) { + # uncertainties were not reset for new input, so do it here + AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE] + } + previously_uncertain$key <- NULL + previously_uncertain$keep_synonyms <- keep_synonyms + AMR_env$mo_uncertainties <- rbind_AMR(AMR_env$mo_uncertainties, previously_uncertain) + } + # Keep or replace synonyms ---- out_current <- synonym_mo_to_accepted_mo(out, fill_in_accepted = FALSE) AMR_env$mo_renamed <- list(old = out[!is.na(out_current)]) @@ -653,7 +687,8 @@ mo_failures <- function() { mo_reset_session <- function() { if (NROW(AMR_env$mo_previously_coerced) > 0) { message_("Reset ", nr2char(NROW(AMR_env$mo_previously_coerced)), " previously matched input value", ifelse(NROW(AMR_env$mo_previously_coerced) > 1, "s", ""), ".") - AMR_env$mo_previously_coerced <- AMR_env$mo_previously_coerced[0, , drop = FALSE] + AMR_env$mo_previously_coerced <- new_coercion_cache() + AMR_env$mo_previously_uncertain <- NULL AMR_env$mo_uncertainties <- AMR_env$mo_uncertainties[0, , drop = FALSE] } else { message_("No previously matched input values to reset.") @@ -1387,11 +1422,39 @@ load_mo_uncertainties <- function(metadata) { synonym_mo_to_accepted_mo <- function(x, fill_in_accepted = FALSE, dataset = AMR_env$MO_lookup) { # `dataset` is an argument so that it can be used in the regeneration of the microorganisms data set - if (identical(dataset, AMR_env$MO_lookup)) { - add_MO_lookup_to_AMR_env() - dataset <- AMR_env$MO_lookup + if (!identical(dataset, AMR_env$MO_lookup)) { + return(synonym_mo_to_accepted_mo_uncached(x, fill_in_accepted = fill_in_accepted, dataset = dataset)) } + # for the internal lookup table, the outcome is memoised per unique code for the whole session + add_MO_lookup_to_AMR_env() + x <- as.character(x) + accepted <- AMR_env$mo_accepted + if (is.null(accepted)) { + accepted <- data.frame(mo = character(0), accepted = character(0), stringsAsFactors = FALSE) + } + x_new <- unique(x[!is.na(x) & !x %in% accepted$mo]) + if (length(x_new) > 0) { + accepted <- rbind_AMR( + accepted, + data.frame( + mo = x_new, + accepted = synonym_mo_to_accepted_mo_uncached(x_new, fill_in_accepted = TRUE, dataset = AMR_env$MO_lookup), + stringsAsFactors = FALSE + ) + ) + AMR_env$mo_accepted <- accepted + } + + out <- accepted$accepted[match(x, accepted$mo)] + if (isFALSE(fill_in_accepted)) { + # only return codes that were actually renamed, i.e., of synonyms with a known current name + out[!is.na(out) & out == x] <- NA_character_ + } + out +} + +synonym_mo_to_accepted_mo_uncached <- function(x, fill_in_accepted = FALSE, dataset) { out <- x is_still_synonym <- dataset$status[match(out, dataset$mo)] == "synonym" limit <- 0 diff --git a/R/mo_property.R b/R/mo_property.R index 7fc44f906..c5cfd7ed8 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -1038,34 +1038,53 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, .. } has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all") - if (isFALSE(has_Becker_or_Lancefield) && isTRUE(keep_synonyms) && all(x %in% c(AMR_env$MO_lookup$mo, NA))) { - # fastest way to get properties - if (property == "snomed") { - x <- lapply(x, function(y) unlist(AMR_env$MO_lookup$snomed[match(y, AMR_env$MO_lookup$mo)])) - } else { - x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)] - } + # properties are retrieved for unique values only, and expanded again at the end + x_full <- NULL + if (is.atomic(x) && is.null(dim(x)) && anyDuplicated(x) > 0) { + x_full <- x + x <- unique(x) + } + if (is.atomic(x) && is.null(dim(x))) { + x_index <- match(x, AMR_env$MO_lookup$mo) + is_valid_mo <- !is.na(x_index) | is.na(x) } else { - # get microorganisms data set, but remove synonyms if keep_synonyms is FALSE - mo_data_check <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$status %in% if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"), , drop = FALSE] + is_valid_mo <- FALSE + } - if (all(x %in% c(mo_data_check$mo, NA)) && !has_Becker_or_Lancefield) { - # do nothing, just don't run the other if-else's - } else if (all(x %in% c(unlist(mo_data_check[[property]]), NA)) && !has_Becker_or_Lancefield) { - # no need to do anything, just return it - return(x) - } else { - # we need to get MO codes now - x <- replace_old_mo_codes(x, property = property) - x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...) + if (isFALSE(has_Becker_or_Lancefield) && all(is_valid_mo) && + (isTRUE(keep_synonyms) || !any(AMR_env$MO_lookup$status[x_index] == "synonym", na.rm = TRUE))) { + # fastest way to get properties: valid MO codes that need no further coercion + } else { + if (isFALSE(has_Becker_or_Lancefield) && !all(is_valid_mo)) { + # input might already contain the property, such as a genus for mo_genus(), in which case just return it + # (synonyms only count if keep_synonyms is TRUE) + allowed_status <- if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted" + property_values <- AMR_env$MO_lookup[[property]][which(AMR_env$MO_lookup$status %in% allowed_status)] + if (is.list(property_values)) { + property_values <- unlist(property_values) + } + if (all(x %in% c(property_values, NA))) { + if (is.null(x_full)) { + return(x) + } else { + return(x_full) + } + } } + # we need to get MO codes now + x <- replace_old_mo_codes(x, property = property) + x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...) + x_index <- match(x, AMR_env$MO_lookup$mo) + } - # get property reeaaally fast using match() - if (property == "snomed") { - x <- lapply(x, function(y) unlist(AMR_env$MO_lookup$snomed[match(y, AMR_env$MO_lookup$mo)])) - } else { - x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)] - } + # get property reeaaally fast using match() + if (property == "snomed") { + x <- lapply(x_index, function(i) unlist(AMR_env$MO_lookup$snomed[i])) + } else { + x <- AMR_env$MO_lookup[[property]][x_index] + } + if (!is.null(x_full)) { + x <- x[match(x_full, unique(x_full))] } if (property == "mo") { diff --git a/R/mo_source.R b/R/mo_source.R index cf678670a..72260db96 100755 --- a/R/mo_source.R +++ b/R/mo_source.R @@ -132,6 +132,9 @@ set_mo_source <- function(path, destination = getOption("AMR_mo_source", "~/mo_s stop_ifnot(destination %like% "[.]rds$", "the {.arg destination} must be a file location with file extension .rds.") mo_source_destination <- path.expand(destination) + # earlier coercions might have been based on another mo_source + AMR_env$mo_previously_coerced <- new_coercion_cache() + if (is.null(path) || path %in% c(FALSE, "")) { AMR_env$mo_source <- NULL if (file.exists(mo_source_destination)) { diff --git a/R/zzz.R b/R/zzz.R index 1e81a70e3..67fa716a1 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -40,16 +40,9 @@ AMR_env$mo_uncertainties <- data.frame( stringsAsFactors = FALSE ) AMR_env$mo_renamed <- list() -AMR_env$mo_previously_coerced <- data.frame( - x = character(0), - mo = character(0), - stringsAsFactors = FALSE -) -AMR_env$ab_previously_coerced <- data.frame( - x = character(0), - ab = character(0), - stringsAsFactors = FALSE -) +# session caches of as.ab() and as.mo(), see R/aa_session_cache.R +AMR_env$mo_previously_coerced <- new_coercion_cache() +AMR_env$ab_previously_coerced <- new_coercion_cache() AMR_env$av_previously_coerced <- data.frame( x = character(0), av = character(0), @@ -111,6 +104,7 @@ AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x" } AMR_env$AB_lookup <- cbind(AMR::antimicrobials, AB_LOOKUP) + reset_ab_cache() AMR_env$AV_lookup <- cbind(AMR::antivirals, AV_LOOKUP) } diff --git a/man/as.ab.Rd b/man/as.ab.Rd index 61afa9977..217ba0715 100644 --- a/man/as.ab.Rd +++ b/man/as.ab.Rd @@ -52,6 +52,8 @@ All these properties will be searched for the user input. The \code{\link[=as.ab Use the \code{\link[=ab_property]{ab_*}} functions to get properties based on the returned antibiotic ID, see \emph{Examples}. +Results of non-exact input are remembered during the session, so that the same input is not matched again. Use \code{\link[=ab_reset_session]{ab_reset_session()}} to forget these results. They are also forgotten after \code{\link[=add_custom_antimicrobials]{add_custom_antimicrobials()}} or \code{\link[=clear_custom_antimicrobials]{clear_custom_antimicrobials()}}. + Note: the \code{\link[=as.ab]{as.ab()}} and \code{\link[=ab_property]{ab_*}} functions may use very long regular expression to match brand names of antimicrobial drugs. This may fail on some systems. You can add your own manual codes to be considered by \code{\link[=as.ab]{as.ab()}} and all \code{\link[=ab_property]{ab_*}} functions, see \code{\link[=add_custom_antimicrobials]{add_custom_antimicrobials()}}. diff --git a/man/as.mo.Rd b/man/as.mo.Rd index aade87288..aedf8a335 100644 --- a/man/as.mo.Rd +++ b/man/as.mo.Rd @@ -113,6 +113,8 @@ There are three helper functions that can be run after using the \code{\link[=as \item Use \code{\link[=mo_failures]{mo_failures()}} to get a \link{character} \link{vector} with all values that could not be coerced to a valid value. \item Use \code{\link[=mo_renamed]{mo_renamed()}} to get a \link{data.frame} with all values that could be coerced based on outdated, previously accepted taxonomic names. } + +Results of non-exact input are remembered during the session, so that the same input is not matched again. This only applies to the same settings of \code{minimum_matching_score}, \code{only_fungi} and \code{cleaning_regex}. Use \code{\link[=mo_reset_session]{mo_reset_session()}} to forget these results. They are also forgotten when the taxonomy changes, e.g. after \code{\link[=add_custom_microorganisms]{add_custom_microorganisms()}}. } \subsection{For Mycologists}{ diff --git a/tests/testthat/test-session_cache.R b/tests/testthat/test-session_cache.R new file mode 100644 index 000000000..2fcdad018 --- /dev/null +++ b/tests/testthat/test-session_cache.R @@ -0,0 +1,133 @@ +# ==================================================================== # +# TITLE: # +# AMR: An R Package for Working with Antimicrobial Resistance Data # +# # +# SOURCE CODE: # +# https://github.com/msberends/AMR # +# # +# PLEASE CITE THIS SOFTWARE AS: # +# Berends MS, Luz CF, Friedrich AW, et al. (2022). # +# AMR: An R Package for Working with Antimicrobial Resistance Data. # +# Journal of Statistical Software, 104(3), 1-31. # +# https://doi.org/10.18637/jss.v104.i03 # +# # +# Developed at the University of Groningen and the University Medical # +# Center Groningen in the Netherlands, in collaboration with many # +# colleagues from around the world, see our website. # +# # +# This R package is free software; you can freely use and distribute # +# it for both personal and commercial purposes under the terms of the # +# GNU General Public License version 2.0 (GNU GPL-2), as published by # +# the Free Software Foundation. # +# We created this package for both routine data analysis and academic # +# research and it was publicly released in the hope that it will be # +# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. # +# # +# Visit our website for the full manual and a complete tutorial about # +# how to conduct AMR data analysis: https://amr-for-r.org # +# ==================================================================== # + +test_that("test-session_cache.R", { + skip_on_cran() + + # as.ab() ---- + ab_reset_session() + # a `fast_mode` result must never be reused by a regular coercion + expect_true(is.na(suppressWarnings(as.ab("amxcilin", fast_mode = TRUE, info = FALSE)))) + expect_identical(as.character(suppressWarnings(as.ab("amxcilin", info = FALSE))), "AMX") + expect_true(all(c("amxcilin") %in% AMR:::AMR_env$ab_previously_coerced$input)) + expect_identical(colnames(AMR:::AMR_env$ab_previously_coerced), c("key", "input", "value")) + # second run comes from the cache and gives the same result + expect_identical(as.character(as.ab("amxcilin", info = FALSE)), "AMX") + # ATC codes and synonyms are looked up in the session index + expect_identical(as.character(as.ab(c("J01CA04", "J01MA02", "amoxil", "cipro"), info = FALSE)), c("AMX", "CIP", "AMX", "CIP")) + # resetting does not touch microorganism uncertainties + suppressWarnings(as.mo("Klebsiela pneumonia", info = FALSE)) + n_uncertain <- NROW(mo_uncertainties()) + expect_message(ab_reset_session()) + expect_identical(NROW(mo_uncertainties()), n_uncertain) + expect_identical(NROW(AMR:::AMR_env$ab_previously_coerced), 0L) + + # as.mo() ---- + mo_reset_session() + x <- c("Klebsiela pneumonia", "Stafylococcus aureus") + expect_identical(as.character(suppressWarnings(as.mo(x, info = FALSE))), c("B_KLBSL_PNMN", "B_STPHY_AURS")) + expect_true(all(x %in% AMR:::AMR_env$mo_previously_coerced$input)) + expect_identical(NROW(mo_uncertainties()), 2L) + # second run comes from the cache, and the uncertainties are still complete + expect_identical(as.character(suppressWarnings(as.mo(rev(x), info = FALSE))), c("B_STPHY_AURS", "B_KLBSL_PNMN")) + expect_identical(sort(mo_uncertainties()$original_input), sort(x)) + # another minimum_matching_score is another cache key + n_cached <- NROW(AMR:::AMR_env$mo_previously_coerced) + suppressWarnings(as.mo(x, minimum_matching_score = 0.1, info = FALSE)) + expect_identical(NROW(AMR:::AMR_env$mo_previously_coerced), n_cached + 2L) + # cached results are keyed on the original input, also when it is cleaned before fuzzy matching + mo_reset_session() + suppressWarnings(as.mo("Klebsiela pneumonia group", info = FALSE)) + expect_true("Klebsiela pneumonia group" %in% AMR:::AMR_env$mo_previously_coerced$input) + # input that could not be coerced is also remembered + expect_identical(as.character(suppressWarnings(as.mo("xq", info = FALSE))), "UNKNOWN") + expect_warning(as.mo("xq", info = FALSE)) + expect_identical(mo_failures(), "xq") + + # valid codes of outdated names are replaced, also on the fast path + syn <- AMR:::AMR_env$MO_lookup$mo[AMR:::AMR_env$MO_lookup$status == "synonym"][1:5] + expect_false(any(as.mo(syn, keep_synonyms = FALSE, info = FALSE) %in% syn, na.rm = TRUE)) + expect_identical(as.character(as.mo(syn, keep_synonyms = TRUE, info = FALSE)), as.character(syn)) + + # SNOMED codes + expect_identical(as.character(as.mo(c(112283007, 3092008), info = FALSE)), c("B_ESCHR_COLI", "B_STPHY_AURS")) + + # synonym_mo_to_accepted_mo() ---- + all_mo <- as.character(AMR:::AMR_env$MO_lookup$mo) + for (fill in c(TRUE, FALSE)) { + AMR:::reset_mo_cache() + expect_identical( + AMR:::synonym_mo_to_accepted_mo(c(all_mo, NA, "invalid"), fill_in_accepted = fill), + AMR:::synonym_mo_to_accepted_mo_uncached(c(all_mo, NA, "invalid"), fill_in_accepted = fill, dataset = AMR:::AMR_env$MO_lookup) + ) + # now from the memoised mapping + expect_identical( + AMR:::synonym_mo_to_accepted_mo(rev(all_mo), fill_in_accepted = fill), + AMR:::synonym_mo_to_accepted_mo_uncached(rev(all_mo), fill_in_accepted = fill, dataset = AMR:::AMR_env$MO_lookup) + ) + } + + # mo_*() functions ---- + x <- as.mo(c("B_ESCHR_COLI", "B_STPHY_AURS", NA, "B_ESCHR_COLI", "UNKNOWN")) + expect_identical(mo_name(x, language = NULL), c("Escherichia coli", "Staphylococcus aureus", NA, "Escherichia coli", "(unknown name)")) + expect_identical(mo_genus(rep(x, 3), language = NULL), rep(mo_genus(x, language = NULL), 3)) + expect_identical(mo_snomed(x[c(1, 1, 3)]), list(mo_snomed(x[1])[[1]], mo_snomed(x[1])[[1]], NULL)) + expect_identical(mo_property(x, "prevalence"), as.double(AMR:::AMR_env$MO_lookup$prevalence[match(x, AMR:::AMR_env$MO_lookup$mo)])) + # input that already contains the property is returned as is + expect_identical(mo_genus(c("Escherichia", "Escherichia", NA)), c("Escherichia", "Escherichia", NA)) + # character input with duplicates + expect_identical(mo_name(c("E. coli", "S. aureus", "E. coli"), language = NULL), c("Escherichia coli", "Staphylococcus aureus", "Escherichia coli")) + # factors + expect_identical(mo_gramstain(factor(c("E. coli", "S. aureus", "E. coli")), language = NULL), c("Gram-negative", "Gram-positive", "Gram-negative")) + # synonyms are replaced unless keep_synonyms = TRUE + expect_false(any(mo_name(syn, keep_synonyms = FALSE, language = NULL) == mo_name(syn, keep_synonyms = TRUE, language = NULL))) + + # invalidation ---- + mo_reset_session() + suppressWarnings(as.mo("Klebsiela pneumonia", info = FALSE)) + invisible(AMR:::get_mo_index()) + invisible(AMR:::synonym_mo_to_accepted_mo("B_ESCHR_COLI")) + suppressMessages(add_custom_microorganisms(data.frame(genus = "Testbacterium", species = "cachei"))) + expect_identical(NROW(AMR:::AMR_env$mo_previously_coerced), 0L) + expect_null(AMR:::AMR_env$MO_index) + expect_null(AMR:::AMR_env$mo_accepted) + expect_identical(mo_name("Testbacterium cachei", language = NULL), "Testbacterium cachei") + suppressMessages(clear_custom_microorganisms()) + expect_identical(NROW(AMR:::AMR_env$mo_previously_coerced), 0L) + + ab_reset_session() + expect_true(is.na(suppressWarnings(as.ab("Qwxzqwxz", info = FALSE)))) + invisible(AMR:::get_ab_index()) + suppressMessages(add_custom_antimicrobials(data.frame(ab = "TESTCD", name = "Qwxzqwxz", group = "Test group"))) + expect_identical(NROW(AMR:::AMR_env$ab_previously_coerced), 0L) + expect_null(AMR:::AMR_env$AB_index) + expect_identical(as.character(as.ab("Qwxzqwxz", info = FALSE)), "TESTCD") + suppressMessages(clear_custom_antimicrobials()) + expect_true(is.na(suppressWarnings(as.ab("Qwxzqwxz", info = FALSE)))) +})