diff --git a/DESCRIPTION b/DESCRIPTION index 87e5c4785..301a76f72 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 3.0.1.9106 -Date: 2026-10-09 +Version: 3.0.1.9107 +Date: 2026-10-10 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/NAMESPACE b/NAMESPACE index aced79f1d..c8c3cea72 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -160,6 +160,7 @@ export(ab_selector) export(ab_synonyms) export(ab_tradenames) export(ab_url) +export(add_custom_antimicrobial_synonyms) export(add_custom_antimicrobials) export(add_custom_microorganisms) export(administrable_iv) diff --git a/NEWS.md b/NEWS.md index cbb0906c4..76da189b1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 3.0.1.9106 +# AMR 3.0.1.9107 Planned as v3.1.0, mid October 2026. @@ -43,6 +43,7 @@ Planned as v3.1.0, mid October 2026. * Typed missing value constants `NA_ab_` and `NA_mo_`, for use in pipelines that need missing values of a specific class * New `wisca_plot()` to assess the susceptibility and incidence distributions from the Monte Carlo simulations * A registry of all microbial IDs (MO codes) since v2.0.0 now prevents existing IDs from being reused or mixed up; IDs of earlier releases are translated to the current ID of the same taxon +* `add_custom_antimicrobial_synonyms()` to add local names, such as trade names, to existing antimicrobials (#307) ### Fixed * `as.mo()` returned *Salmonella bongori* or another subspecies for *Salmonella* serovars written with the species, such as "Salmonella enterica serovar Typhi" @@ -57,6 +58,7 @@ Planned as v3.1.0, mid October 2026. * `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.ab()`: input that is not valid UTF-8 (e.g. text exported in a local encoding such as CP949) now returns `NA` with a warning instead of an error * `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) diff --git a/R/aa_session_cache.R b/R/aa_session_cache.R index 99e48ea98..78f40df35 100644 --- a/R/aa_session_cache.R +++ b/R/aa_session_cache.R @@ -92,6 +92,7 @@ coercion_cache_add <- function(type, keys, inputs, values) { reset_ab_cache <- function() { AMR_env$AB_index <- NULL + AMR_env$custom_ab_id_keys <- NULL AMR_env$ab_previously_coerced <- new_coercion_cache() } diff --git a/R/ab.R b/R/ab.R index 623c9b2d1..482fbee93 100755 --- a/R/ab.R +++ b/R/ab.R @@ -110,6 +110,62 @@ as.ab <- function(x, flag_multiple_results = TRUE, language = get_AMR_locale(), already_regex <- isTRUE(list(...)$already_regex) fast_mode <- isTRUE(list(...)$fast_mode) + # text that is not valid UTF-8 (e.g. exported in a local encoding such as CP949) makes the string + # functions below fail in a UTF-8 locale, so such values are returned as NA with a warning + # (checked on unique values only, as this runs on every call) + if (is.factor(x)) { + x <- as.character(x) + } + if (is.character(x)) { + x_unique <- unique(x[!is.na(x)]) + invalid <- x %in% x_unique[!custom_ab_valid_utf8(enc2utf8(x_unique))] + if (any(invalid)) { + warning_("in `as.ab()`: ", nr2char(sum(invalid)), " value", ifelse(sum(invalid) > 1, "s were", " was"), " not valid UTF-8 text and returned as `NA`. Convert such input first, e.g. with `iconv(x, from = \"CP949\", to = \"UTF-8\")`.") + x[invalid] <- NA_character_ + if (all(is.na(x))) { + return(set_clean_class(rep(NA_character_, length(x)), new_class = c("ab", "character"))) + } + } + } + + # user-added synonyms (add_custom_antimicrobial_synonyms()) are matched on the input as given, + # before the input is transliterated to ASCII below, so that names in non-Latin scripts can be used + if (NROW(AMR_env$custom_ab_synonyms) > 0 && already_regex == FALSE && !isTRUE(list(...)$skip_custom_synonyms)) { + x_unique <- unique(x) + keys_unique <- custom_ab_synonym_key(x_unique) + hit_unique <- match(keys_unique, AMR_env$custom_ab_synonyms$key) + # no exact match: remove one trailing part at a time (part in parentheses or a strength such as "4.5g") + # and look the rest up after each removal, so that e.g. "Brand (comment) 4.5g" matches "Brand (comment)" + # before "Brand"; no words are removed, in any language; not for input that already identifies an antimicrobial as given + retry <- is.na(hit_unique) & !is.na(keys_unique) & !keys_unique %in% custom_ab_identifier_keys_cached()$key + if (any(retry)) { + idx <- which(retry) + cand <- custom_ab_strip_normalise(x_unique[idx]) + repeat { + h <- match(custom_ab_synonym_key(cand), AMR_env$custom_ab_synonyms$key, incomparables = NA) + hit_unique[idx] <- h + left <- is.na(h) + if (!any(left)) break + idx <- idx[left] + stripped <- custom_ab_strip_step(cand[left]) + moved <- stripped != cand[left] + if (!any(moved)) break + idx <- idx[moved] + cand <- stripped[moved] + } + } + hit <- hit_unique[match(x, x_unique)] + if (any(!is.na(hit))) { + out <- rep(NA_character_, length(x)) + out[!is.na(hit)] <- AMR_env$custom_ab_synonyms$ab[hit[!is.na(hit)]] + rest <- is.na(hit) & !is.na(x) + if (any(rest)) { + out[rest] <- as.character(as.ab(x[rest], flag_multiple_results = flag_multiple_results, language = language, info = info, skip_custom_synonyms = TRUE, ...)) + } + return(set_clean_class(out, new_class = c("ab", "character"))) + } + } + x_bak <- x x <- toupper(x) diff --git a/R/custom_antimicrobials.R b/R/custom_antimicrobials.R index 658c87f9c..664422956 100755 --- a/R/custom_antimicrobials.R +++ b/R/custom_antimicrobials.R @@ -30,14 +30,16 @@ #' Add Custom Antimicrobials #' #' With [add_custom_antimicrobials()] you can add your own custom antimicrobial drug names and codes. -#' @param x A [data.frame] resembling the [antimicrobials] data set, at least containing columns "ab" and "name". +#' @param x A [data.frame] resembling the [antimicrobials] data set, at least containing columns "ab" and "name". To add synonyms to existing antimicrobials, columns "ab" and "synonyms" suffice (see *Details*). +#' @param ab For [add_custom_antimicrobial_synonyms()]: a [character] vector of existing antimicrobial codes (see [as.ab()]), or a [data.frame] with columns "ab" and "synonyms" (one synonym per row). +#' @param synonyms A [character] vector of synonyms. If `ab` has length 1, all `synonyms` are added to that antimicrobial; otherwise `ab` and `synonyms` must have the same length. #' @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 circumvent this and automate the process of adding antimicrobials: #' #' **Method 1:** Using the package option [`AMR_custom_ab`][AMR-options], which is the preferred method. To use this method: #' -#' 1. Create a data set in the structure of the [antimicrobials] 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. +#' 1. Create a data set in the structure of the [antimicrobials] data set (containing at the very least columns "ab" and "name", or only columns "ab" and "synonyms" for synonyms of existing antimicrobials) 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 package option [`AMR_custom_ab`][AMR-options]: `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 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: #' @@ -48,6 +50,8 @@ #' #' Upon package load, this file will be loaded and run through the [add_custom_antimicrobials()] function. #' +#' This file can also hold synonyms for antimicrobials that already exist, such as local trade names: rows with an existing code in column "ab" and only column "synonyms" filled (one synonym per row, codes may repeat) are passed on to [add_custom_antimicrobial_synonyms()]. Rows with an existing code that have any other column filled still give an error. Synonyms must be valid UTF-8 text; convert other encodings first, e.g. with `iconv(x, from = "CP949", to = "UTF-8")`. +#' #' **Method 2:** Loading the antimicrobial additions directly from your `.Rprofile` file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method: #' #' 1. Edit the `.Rprofile` file using e.g. `utils::file.edit("~/.Rprofile")`. @@ -63,7 +67,9 @@ #' ) #' ``` #' -#' Use [clear_custom_antimicrobials()] to clear the previously added antimicrobials. +#' Use [add_custom_antimicrobial_synonyms()] to add extra names, such as local trade names, to antimicrobials that already exist (including antimicrobials added with [add_custom_antimicrobials()]). These synonyms are recognised by [as.ab()] and all `ab_*()` functions. Synonyms may contain non-ASCII characters (e.g. trade names in other scripts): they are matched against the input as given, before [as.ab()] transliterates the input to ASCII. Matching ignores case, all white space (including no-break and ideographic spaces) and zero-width characters. If the input does not match as given, a trailing part in parentheses or brackets (such as `(piperacillin, tazobactam)`) and a trailing strength written as a number with a unit symbol (such as `4.5g`, `4/0.5 g` or `500 mg/mL`) are removed one at a time, and matching is tried again after each removal, so that the longest registered synonym wins. Full-width characters are read as their ASCII equivalents. No words are removed, in any language: to recognise a name with a dosage form (such as `Inj`), add that variant as a synonym as well. Only user-added synonyms are matched this way, there is no other fuzzy matching for them, and a strength on its own is never matched to a user-added synonym. A synonym cannot be added if it already identifies another antimicrobial as its code, name, synonym, abbreviation, ATC code, CID or LOINC code, also when written with other punctuation (such as `J01-CR05`). +#' +#' Use [clear_custom_antimicrobials()] to clear the previously added antimicrobials and synonyms. #' @seealso [add_custom_microorganisms()] to add custom microorganisms. #' @rdname add_custom_antimicrobials #' @export @@ -114,19 +120,96 @@ #' ) #' x #' x[, betalactams()] +#' +#' # add local trade names as synonyms to existing antimicrobials, +#' # here a Korean trade name of piperacillin/tazobactam +#' add_custom_antimicrobial_synonyms("TZP", "\uD0C0\uC870\uC2E0\uC8FC") +#' ab_name("\uD0C0\uC870\uC2E0\uC8FC") +#' # a trailing strength, as in many hospital exports, is ignored +#' as.ab("\uD0C0\uC870\uC2E0\uC8FC 4.5g") #' } add_custom_antimicrobials <- function(x) { meet_criteria(x, allow_class = "data.frame") - stop_ifnot( - all(c("ab", "name") %in% colnames(x)), - "`x` must contain columns \"ab\" and \"name\"." - ) - stop_if( - any(x$ab %in% AMR_env$AB_lookup$ab), - "Antimicrobial drug code(s) ", vector_and(x$ab[x$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antimicrobials` data set." - ) # remove any extra class/type, such as grouped tbl, or data.table: x <- as.data.frame(x, stringsAsFactors = FALSE) + stop_ifnot( + "ab" %in% colnames(x), + "`x` must contain columns \"ab\" and \"name\", or columns \"ab\" and \"synonyms\" to add synonyms to existing antimicrobials." + ) + # rows that only fill in "ab" and "synonyms" add synonyms to existing antimicrobials, see add_custom_antimicrobial_synonyms() + synonym_rows <- custom_ab_synonym_rows(x) + records <- x[!synonym_rows, , drop = FALSE] + stop_if( + NROW(records) > 0 && !"name" %in% colnames(records), + "`x` must contain columns \"ab\" and \"name\", or columns \"ab\" and \"synonyms\" to add synonyms to existing antimicrobials." + ) + stop_if( + any(records$ab %in% AMR_env$AB_lookup$ab), + "Antimicrobial drug code(s) ", vector_and(records$ab[records$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antimicrobials` data set." + ) + # names of new antimicrobials must not already be in use as user-added synonyms of other antimicrobials, + # compared in the same ways as custom_ab_synonyms_prepare() does, so that the order of adding does not matter + if (NROW(records) > 0 && NROW(AMR_env$custom_ab_synonyms) > 0) { + syn_tab <- AMR_env$custom_ab_synonyms + rec_ids <- custom_ab_identifier_keys(records) + rec_gen <- custom_ab_generalised_punct(generalise_antibiotic_name(as.character(records$name))) + hits <- data.frame( + rec = c(rec_ids$ab, rec_ids$ab, as.character(records$ab)), + s = c( + match(rec_ids$key, syn_tab$key, incomparables = NA), + match(rec_ids$pkey, custom_ab_punct_key(syn_tab$key), incomparables = NA), + match(rec_gen, custom_ab_generalised_punct(custom_ab_generalised(syn_tab$synonym)), incomparables = NA) + ), + stringsAsFactors = FALSE + ) + hits <- hits[!is.na(hits$s), , drop = FALSE] + clash <- syn_tab$ab[hits$s] != hits$rec + stop_if( + any(clash), + "The name or synonym(s) ", vector_and(unique(syn_tab$synonym[hits$s[clash]])), " of the new antimicrobial(s) are already in use as user-added synonyms of ", vector_and(unique(syn_tab$ab[hits$s[clash]])), "." + ) + } + # validate the synonyms before anything is added, so that an error leaves the session unchanged + syn <- NULL + if (any(synonym_rows)) { + syn_col <- x$synonyms[synonym_rows] + syn_ab <- as.character(x$ab[synonym_rows]) + if (is.list(syn_col)) { + syn_ab <- rep(syn_ab, vapply(FUN.VALUE = integer(1), syn_col, length)) + syn_col <- unlist(syn_col, use.names = FALSE) + } + syn <- custom_ab_synonyms_prepare(ab = syn_ab, synonyms = syn_col, new_records = records) + } + if (NROW(records) > 0) { + add_custom_antimicrobials_records(records) + } + if (!is.null(syn)) { + custom_ab_synonyms_commit(syn) + } + invisible(NULL) +} + +# rows of `x` that have a "synonyms" column and no other column filled besides "ab" +custom_ab_synonym_rows <- function(x) { + if (!"synonyms" %in% colnames(x)) { + return(rep(FALSE, NROW(x))) + } + other_filled <- rep(FALSE, NROW(x)) + for (col in setdiff(colnames(x), c("ab", "synonyms"))) { + other_filled <- other_filled | custom_ab_is_filled(x[, col, drop = TRUE]) + } + !other_filled +} + +custom_ab_is_filled <- function(col) { + if (is.list(col)) { + vapply(FUN.VALUE = logical(1), col, function(v) any(!is.na(v) & as.character(v) != "")) + } else { + !is.na(col) & as.character(col) != "" + } +} + +add_custom_antimicrobials_records <- function(x) { # keep only columns available in the antimicrobials data set x <- x[, colnames(AMR_env$AB_lookup)[colnames(AMR_env$AB_lookup) %in% colnames(x)], drop = FALSE] x$generalised_name <- generalise_antibiotic_name(x$name) @@ -159,6 +242,269 @@ add_custom_antimicrobials <- function(x) { message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal {.code antimicrobials} data set.") } +#' @rdname add_custom_antimicrobials +#' @export +add_custom_antimicrobial_synonyms <- function(ab, synonyms = NULL) { + if (is.data.frame(ab)) { + stop_ifnot( + all(c("ab", "synonyms") %in% colnames(ab)), + "`ab` must contain columns \"ab\" and \"synonyms\" when it is a data.frame." + ) + synonyms <- ab$synonyms + ab <- as.character(ab$ab) + if (is.list(synonyms)) { + ab <- rep(ab, vapply(FUN.VALUE = integer(1), synonyms, length)) + synonyms <- unlist(synonyms, use.names = FALSE) + } + } else { + meet_criteria(ab, allow_class = c("character", "ab")) + meet_criteria(synonyms, allow_class = "character") + ab <- as.character(ab) + if (length(ab) == 1) { + ab <- rep(ab, length(synonyms)) + } + stop_ifnot( + length(ab) == length(synonyms), + "`ab` must be of length 1 or of the same length as `synonyms`." + ) + } + syn <- custom_ab_synonyms_prepare(ab = ab, synonyms = synonyms) + if (is.null(syn)) { + message_("No synonyms to add.") + return(invisible(NULL)) + } + custom_ab_synonyms_commit(syn) + invisible(NULL) +} + +# checks synonyms and returns a data.frame(ab, synonym, key), or NULL if there is nothing to add; +# `new_records` are antimicrobials that are about to be added in the same call of add_custom_antimicrobials() +custom_ab_synonyms_prepare <- function(ab, synonyms, new_records = NULL) { + ab <- as.character(ab) + synonyms <- enc2utf8(as.character(synonyms)) + invalid <- !is.na(synonyms) & !custom_ab_valid_utf8(synonyms) + stop_if( + any(invalid), + "Synonym(s) must be valid UTF-8 text, which does not apply to the synonym(s) at position ", vector_and(which(invalid), quotes = FALSE), ". Convert them first, e.g. with `iconv(x, from = \"CP949\", to = \"UTF-8\")`." + ) + synonyms <- trimws2(synonyms) + keep <- !is.na(ab) & !is.na(synonyms) & !is.na(custom_ab_synonym_key(synonyms)) + ab <- ab[keep] + synonyms <- synonyms[keep] + if (length(ab) == 0) { + return(NULL) + } + new_codes <- if (is.null(new_records)) character(0) else as.character(new_records$ab) + known <- c(as.character(AMR_env$AB_lookup$ab), new_codes) + unknown <- unique(ab[!ab %in% known]) + stop_if( + length(unknown) > 0, + "Antimicrobial drug code(s) ", vector_and(unknown), " do not exist. Use add_custom_antimicrobials() to add new antimicrobials first." + ) + keys <- custom_ab_synonym_key(synonyms) + # a synonym must not already identify another antimicrobial - its code, name, synonyms, abbreviations, + # ATC codes, CID or LOINC codes - not with other punctuation (e.g. "J01-CR05") and not in the + # generalised form that as.ab() uses for its exact matches either + ids <- custom_ab_identifier_keys_cached() + gen_ids <- custom_ab_generalised_ids() + if (!is.null(new_records) && NROW(new_records) > 0) { + ids <- rbind(ids, custom_ab_identifier_keys(new_records)) + new_gen <- data.frame(ab = as.character(new_records$ab), gen = generalise_antibiotic_name(as.character(new_records$name)), stringsAsFactors = FALSE) + new_gen$genp <- custom_ab_generalised_punct(new_gen$gen) + gen_ids <- rbind(gen_ids, new_gen[!is.na(new_gen$genp), , drop = FALSE]) + } + owners_of <- function(table_keys, table_ab, k) { + groups <- split(table_ab, table_keys) + lapply(match(k, names(groups), incomparables = NA), function(j) if (is.na(j)) character(0) else groups[[j]]) + } + by_key <- owners_of(ids$key, ids$ab, keys) + by_pkey <- owners_of(ids$pkey, ids$ab, custom_ab_punct_key(keys)) + by_gen <- owners_of(gen_ids$genp, gen_ids$ab, custom_ab_generalised_punct(custom_ab_generalised(synonyms))) + owners <- lapply(seq_along(keys), function(i) setdiff(unique(c(by_key[[i]], by_pkey[[i]], by_gen[[i]])), ab[i])) + taken <- lengths(owners) > 0 + stop_if( + any(taken), + "Synonym(s) already identify another antimicrobial (as its code, name, synonym, abbreviation, ATC code, CID or LOINC code): ", + vector_and(unique(paste0(synonyms[taken], " (", vapply(FUN.VALUE = character(1), owners[taken], paste, collapse = ", "), ")")), quotes = FALSE), "." + ) + existing <- AMR_env$custom_ab_synonyms + clash <- keys %in% existing$key & ab != existing$ab[match(keys, existing$key)] + clash <- clash | (duplicated(keys) & !duplicated(paste(keys, ab))) + stop_if( + any(clash), + "Synonym(s) ", vector_and(unique(synonyms[clash])), " would refer to more than one antimicrobial." + ) + data.frame(ab = ab, synonym = synonyms, key = keys, stringsAsFactors = FALSE) +} + +custom_ab_synonyms_commit <- function(syn) { + class(AMR_env$AB_lookup$ab) <- "character" + for (code in unique(syn$ab)) { + i <- which(AMR_env$AB_lookup$ab == code)[1L] + new_syn <- syn$synonym[syn$ab == code] + old_syn <- AMR_env$AB_lookup$synonyms[[i]] + old_syn <- old_syn[!is.na(old_syn) & old_syn != ""] + # only added to `synonyms` (for ab_synonyms()); matching is done by the exact match at the start of as.ab(), + # so these synonyms are deliberately kept out of the fuzzy matching on `generalised_*` + AMR_env$AB_lookup$synonyms[[i]] <- unique(c(old_syn, new_syn)) + } + class(AMR_env$AB_lookup$ab) <- c("ab", "character") + AMR_env$custom_ab_synonyms <- unique(rbind(AMR_env$custom_ab_synonyms, syn)) + # the lookup table changed, so earlier coercions and lookup indices are no longer valid + reset_ab_cache() + n_syn <- length(unique(syn$synonym)) + n_ab <- length(unique(syn$ab)) + message_( + "Added ", nr2char(n_syn), " synonym", ifelse(n_syn > 1, "s", ""), + " to ", nr2char(n_ab), " antimicrobial", ifelse(n_ab > 1, "s", ""), "." + ) +} + +# validUTF8() requires R >= 3.3.0, so use iconv(), which returns NA for invalid input +custom_ab_valid_utf8 <- function(x) { + !is.na(iconv(x, from = "UTF-8", to = "UTF-8")) +} + +# white space for the user-added synonym functions: all Unicode white space, like trimws2() +custom_ab_ws <- "[\\h\\v\\p{Z}\u200B\u200C\u200D\u2060\uFEFF]" + +# key for user-added synonyms: case and all white space are ignored, full-width characters are read as ASCII, +# other characters are kept as given; +# input that is not valid UTF-8 or that consists of white space only gets an NA key and thus never matches +custom_ab_synonym_key <- function(x) { + x <- enc2utf8(as.character(x)) + out <- rep(NA_character_, length(x)) + valid <- !is.na(x) & custom_ab_valid_utf8(x) + out[valid] <- toupper(gsub(paste0(custom_ab_ws, "+"), "", custom_ab_fullwidth_to_ascii(x[valid]), perl = TRUE)) + out[!is.na(out) & out == ""] <- NA_character_ + out +} + +# generalised form as used by the exact stage of as.ab(), or NA when the text cannot be transliterated to ASCII +custom_ab_generalised <- function(x) { + out <- rep(NA_character_, length(x)) + ascii <- suppressWarnings(iconv(toupper(enc2utf8(as.character(x))), from = "UTF-8", to = "ASCII//TRANSLIT")) + ok <- !is.na(ascii) & !grepl("?", ascii, fixed = TRUE) + if (any(ok)) { + # some iconv implementations transliterate diacritics to separate marks (e.g. "O" with acute to "'O") + gen <- generalise_antibiotic_name(gsub("['`^~\"]", "", ascii[ok])) + gen[!grepl("[A-Z0-9]", gen)] <- NA_character_ + out[ok] <- gen + } + out +} + +# key without punctuation (letters and digits only), so that a synonym cannot take over another +# antimicrobial's identifier by adding punctuation, e.g. "J01-CR05" or "Zo-syn" +custom_ab_punct_key <- function(key) { + out <- gsub("[^\\p{L}\\p{N}]+", "", key, perl = TRUE) + out[!is.na(out) & out == ""] <- NA_character_ + out +} + +# the same for generalised forms, which consist of A-Z, 0-9 and punctuation only +custom_ab_generalised_punct <- function(gen) { + out <- gsub("[^A-Z0-9]+", "", gen) + out[!is.na(out) & out == ""] <- NA_character_ + out +} + +# parts after a product name that are removed one at a time by custom_ab_strip_step(): trailing punctuation, +# a part in parentheses or brackets (also nested) and a strength written as a number with a unit symbol; +# this is deliberately language-independent, so no words (such as dosage forms) are removed +custom_ab_strip_patterns <- local({ + num <- "[0-9]+([.,][0-9]+)*" + unit <- "(mg|g|mcg|ug|\u00B5g|\u03BCg|ng|kg|iu|miu|u|ml|l|meq|mmol|%|\u338E|\u338D|\u338F|\u3396|\u2113)" + sep <- "[ ,_*-]*" + per <- paste0("( ?/ ?(", num, ")? ?", unit, ")?") + combination <- paste0("(", num, " ?", unit, "? ?[/:] ?)?") + c( + punctuation = "[.,;:]+$", + parenthesised = " ?(\\((?:[^()]++|(?1))*\\))$", + bracketed = " ?(\\[(?:[^][]++|(?1))*\\])$", + strength = paste0("(?= 65281L & cp <= 65374L + cp[w] <- cp[w] - 65248L + intToUtf8(cp) + }, USE.NAMES = FALSE) + } + x +} + +# white space to single spaces and full-width ASCII characters to ASCII +custom_ab_strip_normalise <- function(x) { + x <- custom_ab_fullwidth_to_ascii(enc2utf8(as.character(x))) + trimws2(gsub(paste0(custom_ab_ws, "+"), " ", x, perl = TRUE)) +} + +# removes one trailing part (see custom_ab_strip_patterns) from each value, e.g. "Brand (comment) 4.5g" -> +# "Brand (comment)" -> "Brand"; values that cannot be shortened (or would become empty) are returned as is; +# only used by as.ab() to look up user-added synonyms when the input as given does not match one +custom_ab_strip_step <- function(x) { + out <- x + todo <- !is.na(x) + for (p in custom_ab_strip_patterns) { + if (!any(todo)) break + y <- trimws2(gsub(p, "", out[todo], perl = TRUE, ignore.case = TRUE)) + changed <- y != out[todo] & y != "" + if (any(changed)) { + i <- which(todo)[changed] + out[i] <- y[changed] + todo[i] <- FALSE + } + } + out +} + +# keys of everything that identifies an antimicrobial in `lkp` (by default the internal lookup table): +# code, name, synonyms, abbreviations, ATC codes, CID and LOINC codes +custom_ab_identifier_keys <- function(lkp = AMR_env$AB_lookup) { + ab <- as.character(lkp$ab) + as_list <- function(col) { + if (!col %in% colnames(lkp)) { + return(vector("list", length(ab))) + } + v <- lkp[[col]] + if (is.list(v)) v else as.list(v) + } + parts <- list(as.list(ab), as_list("name"), as_list("synonyms"), as_list("abbreviations"), as_list("atc"), as_list("cid"), as_list("loinc")) + ids <- lapply(seq_along(ab), function(i) { + vals <- as.character(unlist(lapply(parts, function(p) p[[i]]), use.names = FALSE)) + vals[!is.na(vals) & vals != ""] + }) + out <- data.frame(ab = rep(ab, lengths(ids)), key = custom_ab_synonym_key(unlist(ids, use.names = FALSE)), stringsAsFactors = FALSE) + out <- out[!is.na(out$key), , drop = FALSE] + out$pkey <- custom_ab_punct_key(out$key) + out +} + +# the same for the internal lookup table, kept until the lookup table changes (see reset_ab_cache()) +custom_ab_identifier_keys_cached <- function() { + if (is.null(AMR_env$custom_ab_id_keys)) { + AMR_env$custom_ab_id_keys <- custom_ab_identifier_keys() + } + AMR_env$custom_ab_id_keys +} + +# generalised names and synonyms of the internal lookup table, as used by the exact stage of as.ab() +custom_ab_generalised_ids <- function() { + ab <- as.character(AMR_env$AB_lookup$ab) + g <- AMR_env$AB_lookup$generalised_all + if (!is.list(g)) g <- as.list(g) + out <- data.frame(ab = rep(ab, lengths(g)), gen = as.character(unlist(g, use.names = FALSE)), stringsAsFactors = FALSE) + out$genp <- custom_ab_generalised_punct(out$gen) + out[!is.na(out$genp), , drop = FALSE] +} + #' @rdname add_custom_antimicrobials #' @export clear_custom_antimicrobials <- function() { @@ -166,6 +512,7 @@ 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$custom_ab_synonyms <- AMR_env$custom_ab_synonyms[0, , 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/zzz.R b/R/zzz.R index 67fa716a1..ba0108c31 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -72,6 +72,7 @@ AMR_env$sir_interpretation_history <- data.frame( AMR_env$custom_ab_codes <- character(0) +AMR_env$custom_ab_synonyms <- data.frame(ab = character(0), synonym = character(0), key = character(0), stringsAsFactors = FALSE) AMR_env$custom_mo_codes <- character(0) AMR_env$is_dark_theme <- NULL AMR_env$supports_colour <- NULL diff --git a/man/add_custom_antimicrobials.Rd b/man/add_custom_antimicrobials.Rd index 19d708db0..f45444653 100644 --- a/man/add_custom_antimicrobials.Rd +++ b/man/add_custom_antimicrobials.Rd @@ -2,15 +2,22 @@ % Please edit documentation in R/custom_antimicrobials.R \name{add_custom_antimicrobials} \alias{add_custom_antimicrobials} +\alias{add_custom_antimicrobial_synonyms} \alias{clear_custom_antimicrobials} \title{Add Custom Antimicrobials} \usage{ add_custom_antimicrobials(x) +add_custom_antimicrobial_synonyms(ab, synonyms = NULL) + clear_custom_antimicrobials() } \arguments{ -\item{x}{A \link{data.frame} resembling the \link{antimicrobials} data set, at least containing columns "ab" and "name".} +\item{x}{A \link{data.frame} resembling the \link{antimicrobials} data set, at least containing columns "ab" and "name". To add synonyms to existing antimicrobials, columns "ab" and "synonyms" suffice (see \emph{Details}).} + +\item{ab}{For \code{\link[=add_custom_antimicrobial_synonyms]{add_custom_antimicrobial_synonyms()}}: a \link{character} vector of existing antimicrobial codes (see \code{\link[=as.ab]{as.ab()}}), or a \link{data.frame} with columns "ab" and "synonyms" (one synonym per row).} + +\item{synonyms}{A \link{character} vector of synonyms. If \code{ab} has length 1, all \code{synonyms} are added to that antimicrobial; otherwise \code{ab} and \code{synonyms} must have the same length.} } \description{ With \code{\link[=add_custom_antimicrobials]{add_custom_antimicrobials()}} you can add your own custom antimicrobial drug names and codes. @@ -22,7 +29,7 @@ There are two ways to circumvent this and automate the process of adding antimic \strong{Method 1:} Using the package option \code{\link[=AMR-options]{AMR_custom_ab}}, which is the preferred method. To use this method: \enumerate{ -\item Create a data set in the structure of the \link{antimicrobials} data set (containing at the very least columns "ab" and "name") and save it with \code{\link[=saveRDS]{saveRDS()}} to a location of choice, e.g. \code{"~/my_custom_ab.rds"}, or any remote location. +\item Create a data set in the structure of the \link{antimicrobials} data set (containing at the very least columns "ab" and "name", or only columns "ab" and "synonyms" for synonyms of existing antimicrobials) and save it with \code{\link[=saveRDS]{saveRDS()}} to a location of choice, e.g. \code{"~/my_custom_ab.rds"}, or any remote location. \item Set the file location to the package option \code{\link[=AMR-options]{AMR_custom_ab}}: \code{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 \code{.Rprofile} file so that it will be loaded on start-up of \R. To do this, open the \code{.Rprofile} file using e.g. \code{utils::file.edit("~/.Rprofile")}, add this text and save the file: \if{html}{\out{
}}\preformatted{# Add custom antimicrobial codes: @@ -30,6 +37,8 @@ options(AMR_custom_ab = "~/my_custom_ab.rds") }\if{html}{\out{
}} Upon package load, this file will be loaded and run through the \code{\link[=add_custom_antimicrobials]{add_custom_antimicrobials()}} function. + +This file can also hold synonyms for antimicrobials that already exist, such as local trade names: rows with an existing code in column "ab" and only column "synonyms" filled (one synonym per row, codes may repeat) are passed on to \code{\link[=add_custom_antimicrobial_synonyms]{add_custom_antimicrobial_synonyms()}}. Rows with an existing code that have any other column filled still give an error. Synonyms must be valid UTF-8 text; convert other encodings first, e.g. with \code{iconv(x, from = "CP949", to = "UTF-8")}. } \strong{Method 2:} Loading the antimicrobial additions directly from your \code{.Rprofile} file. Note that the definitions will be stored in a user-specific \R file, which is a suboptimal workflow. To use this method: @@ -46,7 +55,9 @@ Upon package load, this file will be loaded and run through the \code{\link[=add }\if{html}{\out{}} } -Use \code{\link[=clear_custom_antimicrobials]{clear_custom_antimicrobials()}} to clear the previously added antimicrobials. +Use \code{\link[=add_custom_antimicrobial_synonyms]{add_custom_antimicrobial_synonyms()}} to add extra names, such as local trade names, to antimicrobials that already exist (including antimicrobials added with \code{\link[=add_custom_antimicrobials]{add_custom_antimicrobials()}}). These synonyms are recognised by \code{\link[=as.ab]{as.ab()}} and all \verb{ab_*()} functions. Synonyms may contain non-ASCII characters (e.g. trade names in other scripts): they are matched against the input as given, before \code{\link[=as.ab]{as.ab()}} transliterates the input to ASCII. Matching ignores case, all white space (including no-break and ideographic spaces) and zero-width characters. If the input does not match as given, a trailing part in parentheses or brackets (such as \verb{(piperacillin, tazobactam)}) and a trailing strength written as a number with a unit symbol (such as \verb{4.5g}, \verb{4/0.5 g} or \verb{500 mg/mL}) are removed one at a time, and matching is tried again after each removal, so that the longest registered synonym wins. Full-width characters are read as their ASCII equivalents. No words are removed, in any language: to recognise a name with a dosage form (such as \code{Inj}), add that variant as a synonym as well. Only user-added synonyms are matched this way, there is no other fuzzy matching for them, and a strength on its own is never matched to a user-added synonym. A synonym cannot be added if it already identifies another antimicrobial as its code, name, synonym, abbreviation, ATC code, CID or LOINC code, also when written with other punctuation (such as \code{J01-CR05}). + +Use \code{\link[=clear_custom_antimicrobials]{clear_custom_antimicrobials()}} to clear the previously added antimicrobials and synonyms. } \examples{ \donttest{ @@ -95,6 +106,13 @@ x <- data.frame( ) x x[, betalactams()] + +# add local trade names as synonyms to existing antimicrobials, +# here a Korean trade name of piperacillin/tazobactam +add_custom_antimicrobial_synonyms("TZP", "\uD0C0\uC870\uC2E0\uC8FC") +ab_name("\uD0C0\uC870\uC2E0\uC8FC") +# a trailing strength, as in many hospital exports, is ignored +as.ab("\uD0C0\uC870\uC2E0\uC8FC 4.5g") } } \seealso{ diff --git a/tests/testthat/test-custom_antimicrobials.R b/tests/testthat/test-custom_antimicrobials.R index 618e9a1ad..4f3773ec5 100644 --- a/tests/testthat/test-custom_antimicrobials.R +++ b/tests/testthat/test-custom_antimicrobials.R @@ -48,3 +48,183 @@ test_that("test-custom ab.R", { expect_identical(ab_name("testab"), "Test Antibiotic") expect_identical(ab_group("testab"), "Test Group") }) + +test_that("test-custom ab synonyms", { + skip_on_cran() + + suppressMessages(clear_custom_antimicrobials()) + suppressMessages(ab_reset_session()) + on.exit(suppressMessages(clear_custom_antimicrobials()), add = TRUE) + + # codes must exist + expect_error(add_custom_antimicrobial_synonyms("NOTANAB", "something")) + + # ASCII and non-ASCII synonyms (a Korean trade name of piperacillin/tazobactam) + tazocin_ko <- "\uD0C0\uC870\uC2E0\uC8FC" + suppressMessages(add_custom_antimicrobial_synonyms("TZP", c("Tazocinum Testname", tazocin_ko))) + expect_identical(as.character(as.ab("Tazocinum Testname")), "TZP") + expect_identical(as.character(as.ab(tazocin_ko)), "TZP") + expect_identical(as.character(as.ab("\uD0C0\uC870 \uC2E0\uC8FC")), "TZP") # white space is ignored + expect_identical(as.character(as.ab(c(tazocin_ko, "amoxicillin", NA))), c("TZP", "AMX", NA)) + expect_identical(ab_name(tazocin_ko), ab_name("TZP")) + + # another non-ASCII name that was not added must not be matched to TZP + expect_false(identical(as.character(suppressWarnings(suppressMessages(as.ab("\uBA54\uB85C\uD39C")))), "TZP")) + + # data.frame input with column "synonyms", also for custom antimicrobials, and also as a list column + suppressMessages(add_custom_antimicrobials(data.frame(ab = "TESTSYN", name = "Test Synonym Antibiotic"))) + suppressMessages(add_custom_antimicrobial_synonyms(data.frame(ab = "TESTSYN", synonyms = "Testosyn"))) + expect_identical(as.character(as.ab("testosyn")), "TESTSYN") + syn_list <- data.frame(ab = "TESTSYN", stringsAsFactors = FALSE) + syn_list$synonyms <- list(c("Testosyn Two", "Testosyn Three")) + suppressMessages(add_custom_antimicrobial_synonyms(syn_list)) + expect_identical(as.character(as.ab(c("Testosyn Two", "Testosyn Three"))), c("TESTSYN", "TESTSYN")) + + # one synonym cannot refer to two antimicrobials, nor be the code or name of another antimicrobial + expect_error(add_custom_antimicrobial_synonyms("MEM", tazocin_ko)) + expect_error(add_custom_antimicrobial_synonyms("TZP", "MEM")) + expect_error(add_custom_antimicrobial_synonyms("TZP", "Meropenem")) + # nor take over another antimicrobial's synonym, abbreviation, ATC code, CID or LOINC code + taken <- "already\\s+identify\\s+another\\s+antimicrobial" + expect_error(add_custom_antimicrobial_synonyms("MEM", "Zosyn"), taken) + expect_error(add_custom_antimicrobial_synonyms("MEM", "J01CR05"), taken) + expect_identical(as.character(as.ab(c("Zosyn", "J01CR05"))), c("TZP", "TZP")) + tzp_row <- AMR::antimicrobials[AMR::antimicrobials$ab == "TZP", , drop = FALSE] + tzp_ids <- c( + unlist(tzp_row$synonyms)[1], unlist(tzp_row$abbreviations)[1], unlist(tzp_row$atc)[1], + as.character(tzp_row$cid[1]), unlist(tzp_row$loinc)[1] + ) + for (id in tzp_ids[!is.na(tzp_ids) & tzp_ids != ""]) { + expect_error(add_custom_antimicrobial_synonyms("MEM", id), taken, info = id) + } + # also not in the spelling variants that as.ab() already resolves to another antimicrobial + expect_error(add_custom_antimicrobial_synonyms("MEM", "Piperacillin-tazobactam"), taken) + expect_error(add_custom_antimicrobial_synonyms("MEM", "Z\u00F3syn"), taken) + # nor with other punctuation (including an invisible soft hyphen) + for (id in c("J01-CR05", "J01.CR05", "Zo-syn", "Zo\u00ADsyn")) { + expect_error(add_custom_antimicrobial_synonyms("MEM", id), taken, info = id) + } + # but an antimicrobial may get its own identifiers again + expect_message(add_custom_antimicrobial_synonyms("TZP", c("Zosyn", "J01CR05"))) + # synonyms consisting of white space only are skipped + expect_message(add_custom_antimicrobial_synonyms("TZP", c("\u00A0", "\u3000")), "No synonyms") + + # all Unicode white space is ignored (no-break space, ideographic space) + expect_identical(as.character(as.ab("\uD0C0\uC870\u3000\uC2E0\uC8FC")), "TZP") + expect_identical(as.character(as.ab("\uD0C0\uC870\u00A0\uC2E0\uC8FC")), "TZP") + expect_identical(as.character(as.ab("Tazocinum\u00A0Testname")), "TZP") + + # a trailing part in parentheses or a strength is removed when there is no exact match + expect_identical(as.character(as.ab(paste0(tazocin_ko, " 4.5g"))), "TZP") + expect_identical(as.character(as.ab(paste0(tazocin_ko, "4.5g"))), "TZP") + expect_identical(as.character(as.ab(paste0(tazocin_ko, " 4.5g "))), "TZP") + expect_identical(as.character(as.ab(paste0(tazocin_ko, " 4.5\u00A0g"))), "TZP") + expect_identical(as.character(as.ab(paste0(tazocin_ko, " 4/0.5 g"))), "TZP") + expect_identical(as.character(as.ab(paste0(tazocin_ko, " 500 mg/mL"))), "TZP") + expect_identical(as.character(as.ab(paste0(tazocin_ko, " (piperacillin, tazobactam) 4.5g"))), "TZP") + expect_identical(as.character(as.ab("Tazocinum Testname 2.25 g")), "TZP") + # also nested parentheses, brackets, trailing punctuation, unit symbols and full-width characters + tazocin_variants <- paste0(tazocin_ko, c( + "4.5g(pip(4:1))", " [4.5g]", "-4.5g", " 4.5g.", " 4.5\u338E", " \uFF14\uFF0E\uFF15\uFF47" + )) + expect_identical(as.character(as.ab(tazocin_variants)), rep("TZP", length(tazocin_variants))) + # but nothing is matched on a strength alone + expect_false(identical(as.character(suppressWarnings(suppressMessages(as.ab("4.5g")))), "TZP")) + # and no words are removed, in any language, such as dosage forms or pack quantities + for (word in c(" Inj", " IV", " 1 vial", "\uC8FC\uC0AC", " 1\uBCD1")) { + expect_false(identical(as.character(suppressWarnings(suppressMessages(as.ab(paste0("Tazocinum Testname", word))))), "TZP"), info = word) + } + + # one trailing part is removed at a time, so the longest registered synonym wins + suppressMessages(add_custom_antimicrobial_synonyms("CXA", "Cefubrand Testname")) + suppressMessages(add_custom_antimicrobial_synonyms("CXM", "Cefubrand Testname (IV)")) + expect_identical( + as.character(as.ab(c("Cefubrand Testname (IV) 750mg", "Cefubrand Testname (IV) 750 mg.", "Cefubrand Testname 250mg"))), + c("CXM", "CXM", "CXA") + ) + + # synonyms are listed by ab_synonyms(), but take no part in fuzzy matching + expect_true("Tazocinum Testname" %in% ab_synonyms("TZP")) + tzp <- which(AMR:::AMR_env$AB_lookup$ab == "TZP") + expect_false(AMR:::generalise_antibiotic_name("Tazocinum Testname") %in% AMR:::AMR_env$AB_lookup$generalised_all[[tzp]]) + expect_false(AMR:::generalise_antibiotic_name("Tazocinum Testname") %in% AMR:::AMR_env$AB_lookup$generalised_synonyms[[tzp]]) + + # input that is not valid UTF-8, such as a CP949 export in a UTF-8 locale, must not give an error + tazocin_cp949 <- tryCatch(iconv(tazocin_ko, from = "UTF-8", to = "CP949"), error = function(e) NA_character_) + if (!is.na(tazocin_cp949) && isTRUE(l10n_info()[["UTF-8"]])) { + Encoding(tazocin_cp949) <- "unknown" + expect_true(is.na(AMR:::custom_ab_synonym_key(tazocin_cp949))) + expect_identical(as.character(suppressWarnings(as.ab(c(tazocin_cp949, tazocin_ko)))), c(NA, "TZP")) + expect_warning(as.ab(tazocin_cp949)) + expect_error(suppressMessages(add_custom_antimicrobial_synonyms("TZP", tazocin_cp949)), "UTF-8") + } + + # clearing removes the synonyms as well + suppressMessages(clear_custom_antimicrobials()) + expect_false(identical(as.character(suppressWarnings(suppressMessages(as.ab(tazocin_ko)))), "TZP")) +}) + +test_that("test-custom ab synonyms via add_custom_antimicrobials()", { + skip_on_cran() + + suppressMessages(clear_custom_antimicrobials()) + suppressMessages(ab_reset_session()) + on.exit(suppressMessages(clear_custom_antimicrobials()), add = TRUE) + tazocin_ko <- "\uD0C0\uC870\uC2E0\uC8FC" + + # rows for existing codes with only "ab" and "synonyms" filled are passed on as synonyms; + # one synonym per row, codes may repeat, empty cells are skipped (this is what the AMR_custom_ab option loads at start-up) + syn <- data.frame( + ab = c("TZP", "TZP", "MEM", "MEM", NA), + synonyms = c("Tazocinum Testname", tazocin_ko, "Meropenemum Testname", NA, NA), + stringsAsFactors = FALSE + ) + tmp <- tempfile(fileext = ".rds") + saveRDS(syn, tmp) + suppressMessages(add_custom_antimicrobials(readRDS(tmp))) + unlink(tmp) + expect_identical(as.character(as.ab(c("Tazocinum Testname", tazocin_ko, "Meropenemum Testname"))), c("TZP", "TZP", "MEM")) + + # existing codes with any other column filled still give the current error + expect_error(add_custom_antimicrobials(data.frame(ab = "TZP", name = "Something", synonyms = "Something"))) + expect_error(add_custom_antimicrobials(data.frame(ab = "TZP", name = "Something"))) + + # plain records still work as before, also without a "synonyms" column + suppressMessages(add_custom_antimicrobials(data.frame(ab = "TESTREC", name = "Test Record Antibiotic"))) + expect_identical(ab_name("TESTREC"), "Test Record Antibiotic") + + # new antimicrobials and synonyms for them can be added in one go + suppressMessages(add_custom_antimicrobials(data.frame( + ab = c("TESTMIX", "TESTMIX"), + name = c("Test Mix Antibiotic", NA), + synonyms = c(NA, "Testomix"), + stringsAsFactors = FALSE + ))) + expect_identical(as.character(as.ab("Testomix")), "TESTMIX") + expect_identical(ab_name("Testomix"), "Test Mix Antibiotic") + + # an error in the synonyms leaves the session unchanged, also for new antimicrobials in the same call + n_before <- NROW(AMR:::AMR_env$AB_lookup) + expect_error(add_custom_antimicrobials(data.frame(ab = c("NOTANAB2", "TESTNEW"), name = c(NA, "Test New"), synonyms = c("Notanab", NA), stringsAsFactors = FALSE))) + expect_error(add_custom_antimicrobials(data.frame(ab = c("TESTNEW", "MEM"), name = c("Test New", NA), synonyms = c(NA, "Tazocinum Testname"), stringsAsFactors = FALSE))) + expect_identical(NROW(AMR:::AMR_env$AB_lookup), n_before) + expect_false("TESTNEW" %in% AMR:::AMR_env$AB_lookup$ab) + + # a new antimicrobial and a synonym of another one in the same call must not share a name + expect_error(add_custom_antimicrobials(data.frame(ab = c("TESTSAME", "TZP"), name = c("Foobarcillin", NA), synonyms = c(NA, "Foobarcillin"), stringsAsFactors = FALSE)), "already\\s+identify\\s+another\\s+antimicrobial") + expect_false("TESTSAME" %in% AMR:::AMR_env$AB_lookup$ab) + # and a new antimicrobial cannot take a name that is already a user-added synonym + suppressMessages(add_custom_antimicrobial_synonyms("TZP", "Foobarcillin")) + expect_error(add_custom_antimicrobials(data.frame(ab = "TESTLATER", name = "Foobarcillin")), "already\\s+in\\s+use\\s+as\\s+user-added\\s+synonyms") + expect_identical(as.character(as.ab("Foobarcillin")), "TZP") + # not with other punctuation either, so that the order of adding does not matter + suppressMessages(add_custom_antimicrobial_synonyms("TZP", "Foo-quxcillin")) + expect_error(add_custom_antimicrobials(data.frame(ab = "TESTORDER", name = "Foo quxcillin")), "already\\s+in\\s+use\\s+as\\s+user-added\\s+synonyms") + + # a new record without a name does not block the synonyms in the same call + suppressMessages(add_custom_antimicrobials(data.frame( + ab = c("TESTNONAME", "MEM"), name = c(NA, NA), group = c("Test", NA), synonyms = c(NA, "Meropenemum Somebrand"), + stringsAsFactors = FALSE + ))) + expect_identical(as.character(as.ab("Meropenemum Somebrand")), "MEM") +})