From 76bcd3528c1ff30590fd9a25bb40f864e1ed5691 Mon Sep 17 00:00:00 2001 From: "Matthijs S. Berends" Date: Fri, 14 Oct 2022 13:02:50 +0200 Subject: [PATCH] move object assignment to AMR_env --- DESCRIPTION | 4 +-- NEWS.md | 2 +- R/aa_helper_functions.R | 2 +- R/ab.R | 50 ++++++++++++++++---------------- R/ab_property.R | 12 ++++---- R/ab_selectors.R | 38 ++++++++++++------------ R/add_custom_antimicrobials.R | 27 +++++------------ R/eucast_rules.R | 4 +-- R/guess_ab_col.R | 4 +-- R/italicise_taxonomy.R | 6 ++-- R/join_microorganisms.R | 2 +- R/mdro.R | 2 +- R/mo.R | 32 ++++++++++---------- R/mo_matching_score.R | 4 +-- R/zzz.R | 4 +-- data-raw/_pre_commit_hook.R | 44 ++++++++++++++-------------- inst/tinytest/test-data.R | 2 +- man/add_custom_antimicrobials.Rd | 4 +-- 18 files changed, 116 insertions(+), 127 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 17f5a3e9..1431ae79 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.8.2.9014 -Date: 2022-10-11 +Version: 1.8.2.9016 +Date: 2022-10-14 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 0c9769b4..6c454a6a 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 1.8.2.9014 +# AMR 1.8.2.9016 This version will eventually become v2.0! We're happy to reach a new major milestone soon! diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index 5113ede2..4f32a6c5 100755 --- a/R/aa_helper_functions.R +++ b/R/aa_helper_functions.R @@ -626,7 +626,7 @@ create_eucast_ab_documentation <- function() { if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) { # antibiotic group names, as defined in data-raw/_pre_commit_hook.R, such as `CARBAPENEMS` val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR")) - } else if (val %in% AB_lookup$ab) { + } else if (val %in% AMR_env$AB_lookup$ab) { # separate drugs, such as `AMX` val <- as.ab(val) } else { diff --git a/R/ab.R b/R/ab.R index e719789c..b6bfda04 100755 --- a/R/ab.R +++ b/R/ab.R @@ -100,7 +100,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { if (is.ab(x)) { return(x) } - if (all(x %in% c(AB_lookup$ab, NA))) { + if (all(x %in% c(AMR_env$AB_lookup$ab, NA))) { # all valid AB codes, but not yet right class return(set_clean_class(x, new_class = c("ab", "character") @@ -147,25 +147,25 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { } # Fill in names, AB codes, CID codes and ATC codes directly (`x` is already clean and uppercase) - known_names <- x %in% AB_lookup$generalised_name - x_new[known_names] <- AB_lookup$ab[match(x[known_names], AB_lookup$generalised_name)] - known_codes_ab <- x %in% AB_lookup$ab - known_codes_atc <- vapply(FUN.VALUE = logical(1), x, function(x_) x_ %in% unlist(AB_lookup$atc), USE.NAMES = FALSE) - known_codes_cid <- x %in% AB_lookup$cid - x_new[known_codes_ab] <- AB_lookup$ab[match(x[known_codes_ab], AB_lookup$ab)] - x_new[known_codes_atc] <- AB_lookup$ab[vapply( + 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), x, function(x_) x_ %in% unlist(AMR_env$AB_lookup$atc), USE.NAMES = FALSE) + 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), x[known_codes_atc], function(x_) { which(vapply( FUN.VALUE = logical(1), - AB_lookup$atc, + AMR_env$AB_lookup$atc, function(atc) x_ %in% atc ))[1L] }, USE.NAMES = FALSE )] - x_new[known_codes_cid] <- AB_lookup$ab[match(x[known_codes_cid], AB_lookup$cid)] + 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)] already_known <- known_names | known_codes_ab | known_codes_atc | known_codes_cid | previously_coerced @@ -217,10 +217,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { # exact LOINC code loinc_found <- unlist(lapply( - AB_lookup$generalised_loinc, + AMR_env$AB_lookup$generalised_loinc, function(s) x[i] %in% s )) - found <- AB_lookup$ab[loinc_found == TRUE] + found <- AMR_env$AB_lookup$ab[loinc_found == TRUE] if (length(found) > 0) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next @@ -228,10 +228,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { # exact synonym synonym_found <- unlist(lapply( - AB_lookup$generalised_synonyms, + AMR_env$AB_lookup$generalised_synonyms, function(s) x[i] %in% s )) - found <- AB_lookup$ab[synonym_found == TRUE] + found <- AMR_env$AB_lookup$ab[synonym_found == TRUE] if (length(found) > 0) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next @@ -239,11 +239,11 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { # exact abbreviation abbr_found <- unlist(lapply( - AB_lookup$generalised_abbreviations, + AMR_env$AB_lookup$generalised_abbreviations, # require at least 2 characters for abbreviations function(s) x[i] %in% s && nchar(x[i]) >= 2 )) - found <- AB_lookup$ab[abbr_found == TRUE] + found <- AMR_env$AB_lookup$ab[abbr_found == TRUE] if (length(found) > 0) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next @@ -251,9 +251,9 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { # length of input is quite long, and Levenshtein distance is only max 2 if (nchar(x[i]) >= 10) { - levenshtein <- as.double(utils::adist(x[i], AB_lookup$generalised_name)) + levenshtein <- as.double(utils::adist(x[i], AMR_env$AB_lookup$generalised_name)) if (any(levenshtein <= 2)) { - found <- AB_lookup$ab[which(levenshtein <= 2)] + found <- AMR_env$AB_lookup$ab[which(levenshtein <= 2)] x_new[i] <- note_if_more_than_one_found(found, i, from_text) next } @@ -290,13 +290,13 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { } # try if name starts with it - found <- AB_lookup[which(AB_lookup$generalised_name %like% paste0("^", x_spelling)), "ab", drop = TRUE] + found <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$generalised_name %like% paste0("^", x_spelling)), "ab", drop = TRUE] if (length(found) > 0) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next } # try if name ends with it - found <- AB_lookup[which(AB_lookup$generalised_name %like% paste0(x_spelling, "$")), "ab", drop = TRUE] + found <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$generalised_name %like% paste0(x_spelling, "$")), "ab", drop = TRUE] if (nchar(x[i]) >= 4 && length(found) > 0) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next @@ -304,10 +304,10 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) { # and try if any synonym starts with it synonym_found <- unlist(lapply( - AB_lookup$generalised_synonyms, + AMR_env$AB_lookup$generalised_synonyms, function(s) any(s %like% paste0("^", x_spelling)) )) - found <- AB_lookup$ab[synonym_found == TRUE] + found <- AMR_env$AB_lookup$ab[synonym_found == TRUE] if (length(found) > 0) { x_new[i] <- note_if_more_than_one_found(found, i, from_text) next @@ -585,7 +585,7 @@ as.data.frame.ab <- function(x, ...) { "[<-.ab" <- function(i, j, ..., value) { y <- NextMethod() attributes(y) <- attributes(i) - return_after_integrity_check(y, "antimicrobial code", AB_lookup$ab) + return_after_integrity_check(y, "antimicrobial code", AMR_env$AB_lookup$ab) } #' @method [[<- ab #' @export @@ -593,7 +593,7 @@ as.data.frame.ab <- function(x, ...) { "[[<-.ab" <- function(i, j, ..., value) { y <- NextMethod() attributes(y) <- attributes(i) - return_after_integrity_check(y, "antimicrobial code", AB_lookup$ab) + return_after_integrity_check(y, "antimicrobial code", AMR_env$AB_lookup$ab) } #' @method c ab #' @export @@ -602,7 +602,7 @@ c.ab <- function(...) { x <- list(...)[[1L]] y <- NextMethod() attributes(y) <- attributes(x) - return_after_integrity_check(y, "antimicrobial code", AB_lookup$ab) + return_after_integrity_check(y, "antimicrobial code", AMR_env$AB_lookup$ab) } #' @method unique ab diff --git a/R/ab_property.R b/R/ab_property.R index 983ee35f..b0ae2882 100644 --- a/R/ab_property.R +++ b/R/ab_property.R @@ -452,22 +452,22 @@ set_ab_names <- function(data, ..., property = "name", language = get_AMR_locale } ab_validate <- function(x, property, ...) { - if (tryCatch(all(x[!is.na(x)] %in% AB_lookup$ab), error = function(e) FALSE)) { + if (tryCatch(all(x[!is.na(x)] %in% AMR_env$AB_lookup$ab), error = function(e) FALSE)) { # special case for ab_* functions where class is already - x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE] + x <- AMR_env$AB_lookup[match(x, AMR_env$AB_lookup$ab), property, drop = TRUE] } else { # try to catch an error when inputting an invalid argument # so the 'call.' can be set to FALSE - tryCatch(x[1L] %in% AB_lookup[1, property, drop = TRUE], + tryCatch(x[1L] %in% AMR_env$AB_lookup[1, property, drop = TRUE], error = function(e) stop(e$message, call. = FALSE) ) - if (!all(x %in% AB_lookup[, property, drop = TRUE])) { + if (!all(x %in% AMR_env$AB_lookup[, property, drop = TRUE])) { x <- as.ab(x, ...) - if (all(is.na(x)) && is.list(AB_lookup[, property, drop = TRUE])) { + if (all(is.na(x)) && is.list(AMR_env$AB_lookup[, property, drop = TRUE])) { x <- rep(NA_character_, length(x)) } else { - x <- AB_lookup[match(x, AB_lookup$ab), property, drop = TRUE] + x <- AMR_env$AB_lookup[match(x, AMR_env$AB_lookup$ab), property, drop = TRUE] } } } diff --git a/R/ab_selectors.R b/R/ab_selectors.R index 766c6aa8..54f0c4a0 100644 --- a/R/ab_selectors.R +++ b/R/ab_selectors.R @@ -216,7 +216,7 @@ ab_selector <- function(filter, sort = FALSE, fn = "ab_selector" ) call <- substitute(filter) - agents <- tryCatch(AB_lookup[which(eval(call, envir = AB_lookup)), "ab", drop = TRUE], + agents <- tryCatch(AMR_env$AB_lookup[which(eval(call, envir = AMR_env$AB_lookup)), "ab", drop = TRUE], error = function(e) stop_(e$message, call = -5) ) agents <- ab_in_data[ab_in_data %in% agents] @@ -424,8 +424,8 @@ administrable_per_os <- function(only_rsi_columns = FALSE, ...) { info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE, fn = "administrable_per_os" ) - agents_all <- AB_lookup[which(!is.na(AB_lookup$oral_ddd)), "ab", drop = TRUE] - agents <- AB_lookup[which(AB_lookup$ab %in% ab_in_data & !is.na(AB_lookup$oral_ddd)), "ab", drop = TRUE] + agents_all <- AMR_env$AB_lookup[which(!is.na(AMR_env$AB_lookup$oral_ddd)), "ab", drop = TRUE] + agents <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$ab %in% ab_in_data & !is.na(AMR_env$AB_lookup$oral_ddd)), "ab", drop = TRUE] agents <- ab_in_data[ab_in_data %in% agents] message_agent_names( function_name = "administrable_per_os", @@ -462,8 +462,8 @@ administrable_iv <- function(only_rsi_columns = FALSE, ...) { info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE, fn = "administrable_iv" ) - agents_all <- AB_lookup[which(!is.na(AB_lookup$iv_ddd)), "ab", drop = TRUE] - agents <- AB_lookup[which(AB_lookup$ab %in% ab_in_data & !is.na(AB_lookup$iv_ddd)), "ab", drop = TRUE] + agents_all <- AMR_env$AB_lookup[which(!is.na(AMR_env$AB_lookup$iv_ddd)), "ab", drop = TRUE] + agents <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$ab %in% ab_in_data & !is.na(AMR_env$AB_lookup$iv_ddd)), "ab", drop = TRUE] agents <- ab_in_data[ab_in_data %in% agents] message_agent_names( function_name = "administrable_iv", @@ -544,7 +544,7 @@ ab_select_exec <- function(function_name, # untreatable drugs if (only_treatable == TRUE) { - untreatable <- AB_lookup[which(AB_lookup$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE] + untreatable <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE] if (any(untreatable %in% names(ab_in_data))) { if (message_not_thrown_before(function_name, "ab_class", "untreatable", entire_session = TRUE)) { warning_( @@ -571,16 +571,16 @@ ab_select_exec <- function(function_name, if (is.null(ab_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) { ab_group <- NULL if (isTRUE(function_name == "antifungals")) { - abx <- AB_lookup$ab[which(AB_lookup$group == "Antifungals")] + abx <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$group == "Antifungals")] } else if (isTRUE(function_name == "antimycobacterials")) { - abx <- AB_lookup$ab[which(AB_lookup$group == "Antimycobacterials")] + abx <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$group == "Antimycobacterials")] } else { # their upper case equivalent are vectors with class , created in data-raw/_pre_commit_hook.R # carbapenems() gets its codes from AMR:::AB_CARBAPENEMS abx <- get(paste0("AB_", toupper(function_name)), envir = asNamespace("AMR")) # manually added codes from add_custom_antimicrobials() must also be supported if (length(AMR_env$custom_ab_codes) > 0) { - custom_ab <- AB_lookup[which(AB_lookup$ab %in% AMR_env$custom_ab_codes), ] + custom_ab <- AMR_env$AB_lookup[which(AMR_env$AB_lookup$ab %in% AMR_env$custom_ab_codes), ] check_string <- paste0(custom_ab$group, custom_ab$atc_group1, custom_ab$atc_group2) if (function_name == "betalactams") { find_group <- "beta-lactams" @@ -602,7 +602,7 @@ ab_select_exec <- function(function_name, } else { # this for the 'manual' ab_class() function abx <- subset( - AB_lookup, + AMR_env$AB_lookup, group %like% ab_class_args | atc_group1 %like% ab_class_args | atc_group2 %like% ab_class_args @@ -792,7 +792,7 @@ is_all <- function(el1) { find_ab_group <- function(ab_class_args) { ab_class_args <- gsub("[^a-zA-Z0-9]", ".*", ab_class_args) - AB_lookup %pm>% + AMR_env$AB_lookup %pm>% subset(group %like% ab_class_args | atc_group1 %like% ab_class_args | atc_group2 %like% ab_class_args) %pm>% @@ -807,16 +807,16 @@ find_ab_names <- function(ab_group, n = 3) { ab_group <- gsub("[^a-zA-Z|0-9]", ".*", ab_group) # try popular first, they have DDDs - drugs <- AB_lookup[which((!is.na(AB_lookup$iv_ddd) | !is.na(AB_lookup$oral_ddd)) & - AB_lookup$name %unlike% " " & - AB_lookup$group %like% ab_group & - AB_lookup$ab %unlike% "[0-9]$"), ]$name + drugs <- AMR_env$AB_lookup[which((!is.na(AMR_env$AB_lookup$iv_ddd) | !is.na(AMR_env$AB_lookup$oral_ddd)) & + AMR_env$AB_lookup$name %unlike% " " & + AMR_env$AB_lookup$group %like% ab_group & + AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name if (length(drugs) < n) { # now try it all - drugs <- AB_lookup[which((AB_lookup$group %like% ab_group | - AB_lookup$atc_group1 %like% ab_group | - AB_lookup$atc_group2 %like% ab_group) & - AB_lookup$ab %unlike% "[0-9]$"), ]$name + drugs <- AMR_env$AB_lookup[which((AMR_env$AB_lookup$group %like% ab_group | + AMR_env$AB_lookup$atc_group1 %like% ab_group | + AMR_env$AB_lookup$atc_group2 %like% ab_group) & + AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name } if (length(drugs) == 0) { return("??") diff --git a/R/add_custom_antimicrobials.R b/R/add_custom_antimicrobials.R index ae39220d..76911b19 100644 --- a/R/add_custom_antimicrobials.R +++ b/R/add_custom_antimicrobials.R @@ -86,18 +86,18 @@ #' #' # even antibiotic selectors work #' x <- data.frame(random_column = "test", -#' coflu = as.rsi("S"), -#' ampicillin = as.rsi("R")) +#' coflu = as.rsi("S"), +#' ampicillin = as.rsi("R")) #' x #' x[, betalactams()] 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% AB_lookup$ab), - "Antimicrobial code(s) ", vector_and(x$ab[x$ab %in% AB_lookup$ab]), " already exist in the internal `antibiotics` data set.") + stop_if(any(x$ab %in% AMR_env$AB_lookup$ab), + "Antimicrobial code(s) ", vector_and(x$ab[x$ab %in% AMR_env$AB_lookup$ab]), " already exist in the internal `antibiotics` data set.") - x <- x[, colnames(AB_lookup)[colnames(AB_lookup) %in% colnames(x)], drop = FALSE] + 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) x$generalised_all <- as.list(x$generalised_name) if ("atc" %in% colnames(x)) { @@ -108,27 +108,16 @@ add_custom_antimicrobials <- function(x) { } AMR_env$custom_ab_codes <- c(AMR_env$custom_ab_codes, x$ab) - bind_rows <- import_fn("bind_rows", "dplyr", error_on_fail = FALSE) - if (!is.null(bind_rows)) { - new_df <- bind_rows(AB_lookup, x) - } else { - new_df <- tryCatch(rbind(AB_lookup, x, stringsAsFactors = FALSE), - error = function(x) stop("Error while adding antimicrobials. Try installing the 'dplyr' package for extended support.", call. = FALSE)) - } - new_df <- unique(new_df) + bind_rows <- import_fn("bind_rows", "dplyr", error_on_fail = TRUE) + AMR_env$AB_lookup <- unique(bind_rows(AMR_env$AB_lookup, x)) - assignInNamespace(x = "AB_lookup", - value = new_df, - ns = asNamespace("AMR")) message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal `antibiotics` data set.") } #' @rdname add_custom_antimicrobials #' @export clear_custom_antimicrobials <- function() { - assignInNamespace(x = "AB_lookup", - value = create_AB_lookup(), - ns = asNamespace("AMR")) + AMR_env$AB_lookup <- create_AB_lookup() AMR_env$custom_ab_codes <- character(0) message_("Custom antimicrobials cleared.") } diff --git a/R/eucast_rules.R b/R/eucast_rules.R index 6b25a997..d89674d1 100755 --- a/R/eucast_rules.R +++ b/R/eucast_rules.R @@ -435,11 +435,11 @@ eucast_rules <- function(x, } if (any(x$genus == "Staphylococcus", na.rm = TRUE)) { - all_staph <- MO_lookup[which(MO_lookup$genus == "Staphylococcus"), , drop = FALSE] + all_staph <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$genus == "Staphylococcus"), , drop = FALSE] all_staph$CNS_CPS <- suppressWarnings(mo_name(all_staph$mo, Becker = "all", language = NULL, info = FALSE)) } if (any(x$genus == "Streptococcus", na.rm = TRUE)) { - all_strep <- MO_lookup[which(MO_lookup$genus == "Streptococcus"), , drop = FALSE] + all_strep <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$genus == "Streptococcus"), , drop = FALSE] all_strep$Lancefield <- suppressWarnings(mo_name(all_strep$mo, Lancefield = TRUE, language = NULL, info = FALSE)) } diff --git a/R/guess_ab_col.R b/R/guess_ab_col.R index a7890bfd..361d64f5 100755 --- a/R/guess_ab_col.R +++ b/R/guess_ab_col.R @@ -173,7 +173,7 @@ get_column_abx <- function(x, # only check columns that are a valid AB code, ATC code, name, abbreviation or synonym, # or already have the class (as.rsi) # and that they have no more than 50% invalid values - vectr_antibiotics <- unlist(AB_lookup$generalised_all) + vectr_antibiotics <- unlist(AMR_env$AB_lookup$generalised_all) vectr_antibiotics <- vectr_antibiotics[!is.na(vectr_antibiotics) & nchar(vectr_antibiotics) >= 3] x_columns <- vapply( FUN.VALUE = character(1), @@ -335,7 +335,7 @@ get_ab_from_namespace <- function(x, cols_ab) { if (paste0("AB_", val) %in% ls(envir = asNamespace("AMR"))) { # antibiotic group names, as defined in data-raw/_pre_commit_hook.R, such as `AB_CARBAPENEMS` val <- eval(parse(text = paste0("AB_", val)), envir = asNamespace("AMR")) - } else if (val %in% AB_lookup$ab) { + } else if (val %in% AMR_env$AB_lookup$ab) { # separate drugs, such as `AMX` val <- as.ab(val) } else { diff --git a/R/italicise_taxonomy.R b/R/italicise_taxonomy.R index ff107777..1bba0f31 100644 --- a/R/italicise_taxonomy.R +++ b/R/italicise_taxonomy.R @@ -71,7 +71,7 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) { search_strings <- gsub("[^a-zA-Z-]", "", s_split) ind_species <- search_strings != "" & - search_strings %in% MO_lookup[which(MO_lookup$rank %in% c( + search_strings %in% AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c( "family", "genus", "species", @@ -85,7 +85,7 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) { ind_fullname <- search_strings != "" & search_strings %in% c( - MO_lookup[which(MO_lookup$rank %in% c( + AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c( "family", "genus", "species", @@ -96,7 +96,7 @@ italicise_taxonomy <- function(string, type = c("markdown", "ansi")) { "fullname", drop = TRUE ], - MO_lookup[which(MO_lookup$rank %in% c( + AMR_env$MO_lookup[which(AMR_env$MO_lookup$rank %in% c( "family", "genus", "species", diff --git a/R/join_microorganisms.R b/R/join_microorganisms.R index fb281dcc..50ce9aa0 100755 --- a/R/join_microorganisms.R +++ b/R/join_microorganisms.R @@ -145,7 +145,7 @@ join_microorganisms <- function(type, x, by, suffix, ...) { } message_('Joining, by = "', by, '"', add_fn = font_black, as_note = FALSE) # message same as dplyr::join functions } - if (!all(x[, by, drop = TRUE] %in% MO_lookup$mo, na.rm = TRUE)) { + if (!all(x[, by, drop = TRUE] %in% AMR_env$MO_lookup$mo, na.rm = TRUE)) { x$join.mo <- as.mo(x[, by, drop = TRUE]) by <- c("join.mo" = "mo") } else { diff --git a/R/mdro.R b/R/mdro.R index 47dffbce..136e7bb9 100755 --- a/R/mdro.R +++ b/R/mdro.R @@ -326,7 +326,7 @@ mdro <- function(x = NULL, "No column found as input for `col_mo`, ", font_bold(paste0("assuming all rows contain ", font_italic("Mycobacterium tuberculosis"), ".")) ) - x$mo <- as.mo("Mycobacterium tuberculosis") # consider overkill at all times: MO_lookup[which(MO_lookup$fullname == "Mycobacterium tuberculosis"), "mo", drop = TRUE] + x$mo <- as.mo("Mycobacterium tuberculosis") # consider overkill at all times: AMR_env$MO_lookup[which(AMR_env$MO_lookup$fullname == "Mycobacterium tuberculosis"), "mo", drop = TRUE] col_mo <- "mo" } stop_if(is.null(col_mo), "`col_mo` must be set") diff --git a/R/mo.R b/R/mo.R index fdce9c75..96735673 100755 --- a/R/mo.R +++ b/R/mo.R @@ -163,7 +163,7 @@ as.mo <- function(x, language <- validate_language(language) meet_criteria(info, allow_class = "logical", has_length = 1) - if (tryCatch(all(x %in% c(MO_lookup$mo, NA)) && + if (tryCatch(all(x %in% c(AMR_env$MO_lookup$mo, NA)) && isFALSE(Becker) && isFALSE(Lancefield), error = function(e) FALSE)) { # don't look into valid MO codes, just return them @@ -194,9 +194,9 @@ as.mo <- function(x, out[x %in% reference_df[[1]]] <- reference_df[[2]][match(x[x %in% reference_df[[1]]], reference_df[[1]])] } # From MO code ---- - out[is.na(out) & x %in% MO_lookup$mo] <- x[is.na(out) & x %in% MO_lookup$mo] + out[is.na(out) & x %in% AMR_env$MO_lookup$mo] <- x[is.na(out) & x %in% AMR_env$MO_lookup$mo] # From full name ---- - out[is.na(out) & x_lower %in% MO_lookup$fullname_lower] <- MO_lookup$mo[match(x_lower[is.na(out) & x_lower %in% MO_lookup$fullname_lower], MO_lookup$fullname_lower)] + out[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower] <- AMR_env$MO_lookup$mo[match(x_lower[is.na(out) & x_lower %in% AMR_env$MO_lookup$fullname_lower], AMR_env$MO_lookup$fullname_lower)] # one exception: "Fungi" matches the kingdom, but instead it should return the 'unknown' code for fungi out[out == "F_[KNG]_FUNGI"] <- "F_FUNGUS" # From known codes ---- @@ -204,7 +204,7 @@ as.mo <- function(x, # From SNOMED ---- if (any(is.na(out) & !is.na(x)) && any(is.na(out) & x %in% unlist(microorganisms$snomed), na.rm = TRUE)) { # found this extremely fast gem here: https://stackoverflow.com/a/11002456/4575331 - out[is.na(out) & x %in% unlist(microorganisms$snomed)] <- microorganisms$mo[rep(seq_along(microorganisms$snomed), vapply(FUN.VALUE = double(1), microorganisms$snomed, length))[match(x[is.na(out) & x %in% unlist(microorganisms$snomed)], unlist(microorganisms$snomed))]] + out[is.na(out) & x %in% unlist(AMR::microorganisms$snomed)] <- AMR::microorganisms$mo[rep(seq_along(AMR::microorganisms$snomed), vapply(FUN.VALUE = double(1), AMR::microorganisms$snomed, length))[match(x[is.na(out) & x %in% unlist(AMR::microorganisms$snomed)], unlist(AMR::microorganisms$snomed))]] } # From other familiar output ---- # such as Salmonella groups, colloquial names, etc. @@ -261,16 +261,16 @@ as.mo <- function(x, # do a pre-match on first character (and if it contains a space, first chars of first two terms) if (length(x_parts) %in% c(2, 3)) { # for genus + species + subspecies - filtr <- which(MO_lookup$full_first == substr(x_parts[1], 1, 1) & MO_lookup$species_first == substr(x_parts[2], 1, 1)) + filtr <- which(AMR_env$MO_lookup$full_first == substr(x_parts[1], 1, 1) & AMR_env$MO_lookup$species_first == substr(x_parts[2], 1, 1)) } else if (length(x_parts) > 3) { first_chars <- paste0("(^| )", "[", paste(substr(x_parts, 1, 1), collapse = ""), "]") - filtr <- which(MO_lookup$full_first %like_case% first_chars) + filtr <- which(AMR_env$MO_lookup$full_first %like_case% first_chars) } else if (nchar(x_out) == 4) { # no space and 4 characters - probably a code such as STAU or ESCO! if (isTRUE(info)) { message_("Input \"", x_search, "\" is assumed to be a microorganism code - trying to match on ", vector_and(c(substr(x_out, 1, 2), substr(x_out, 3, 4)), sort = FALSE)) } - filtr <- which(MO_lookup$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 2), ".* ", substr(x_out, 3, 4))) + filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", substr(x_out, 1, 2), ".* ", substr(x_out, 3, 4))) } else if (nchar(x_out) <= 6) { # no space and 5-6 characters - probably a code such as STAAUR or ESCCOL! first_part <- paste0(substr(x_out, 1, 2), "[a-z]*", substr(x_out, 3, 3)) @@ -278,14 +278,14 @@ as.mo <- function(x, if (isTRUE(info)) { message_("Input \"", x_search, "\" is assumed to be a microorganism code - trying to match on ", vector_and(c(gsub("[a-z]*", "(...)", first_part, fixed = TRUE), second_part), sort = FALSE)) } - filtr <- which(MO_lookup$fullname_lower %like_case% paste0("(^| )", first_part, ".* ", second_part)) + filtr <- which(AMR_env$MO_lookup$fullname_lower %like_case% paste0("(^| )", first_part, ".* ", second_part)) } else { - filtr <- which(MO_lookup$full_first == substr(x_out, 1, 1)) + filtr <- which(AMR_env$MO_lookup$full_first == substr(x_out, 1, 1)) } if (length(filtr) == 0) { - mo_to_search <- MO_lookup$fullname + mo_to_search <- AMR_env$MO_lookup$fullname } else { - mo_to_search <- MO_lookup$fullname[filtr] + mo_to_search <- AMR_env$MO_lookup$fullname[filtr] } AMR_env$mo_to_search <- mo_to_search # determine the matching score on the original search value @@ -293,9 +293,9 @@ as.mo <- function(x, if (is.null(minimum_matching_score)) { minimum_matching_score_current <- min(0.6, min(10, nchar(x_search_cleaned)) * 0.08) # correct back for prevalence - minimum_matching_score_current <- minimum_matching_score_current / MO_lookup$prevalence[match(mo_to_search, MO_lookup$fullname)] + minimum_matching_score_current <- minimum_matching_score_current / AMR_env$MO_lookup$prevalence[match(mo_to_search, AMR_env$MO_lookup$fullname)] # correct back for kingdom - minimum_matching_score_current <- minimum_matching_score_current / MO_lookup$kingdom_index[match(mo_to_search, MO_lookup$fullname)] + minimum_matching_score_current <- minimum_matching_score_current / AMR_env$MO_lookup$kingdom_index[match(mo_to_search, AMR_env$MO_lookup$fullname)] } else { minimum_matching_score_current <- minimum_matching_score } @@ -306,7 +306,7 @@ as.mo <- function(x, warning_("No hits found for \"", x_search, "\" with minimum_matching_score = ", ifelse(is.null(minimum_matching_score), paste0("NULL (=", round(min(minimum_matching_score_current, na.rm = TRUE), 3), ")"), minimum_matching_score), ". Try setting this value lower or even to 0.") result_mo <- NA_character_ } else { - result_mo <- MO_lookup$mo[match(top_hits[1], MO_lookup$fullname)] + result_mo <- AMR_env$MO_lookup$mo[match(top_hits[1], AMR_env$MO_lookup$fullname)] AMR_env$mo_uncertainties <- rbind(AMR_env$mo_uncertainties, data.frame( original_input = x_search, @@ -997,8 +997,8 @@ replace_old_mo_codes <- function(x, property) { name <- tolower(paste0(name, ".*", collapse = "")) name <- gsub(" .*", " ", name, fixed = TRUE) name <- paste0("^", name) - results <- MO_lookup$mo[MO_lookup$kingdom %like_case% kingdom & - MO_lookup$fullname_lower %like_case% name] + results <- AMR_env$MO_lookup$mo[AMR_env$MO_lookup$kingdom %like_case% kingdom & + AMR_env$MO_lookup$fullname_lower %like_case% name] if (length(results) > 1) { all_direct_matches <<- FALSE } diff --git a/R/mo_matching_score.R b/R/mo_matching_score.R index d3bb7b61..875a5f80 100755 --- a/R/mo_matching_score.R +++ b/R/mo_matching_score.R @@ -109,9 +109,9 @@ mo_matching_score <- function(x, n) { l_n.lev[lev == l_n] <- lev[lev == l_n] # human pathogenic prevalence (1 to 3), see ?as.mo - p_n <- MO_lookup[match(n, MO_lookup$fullname), "prevalence", drop = TRUE] + p_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "prevalence", drop = TRUE] # kingdom index (Bacteria = 1, Fungi = 2, Protozoa = 3, Archaea = 4, others = 5) - k_n <- MO_lookup[match(n, MO_lookup$fullname), "kingdom_index", drop = TRUE] + k_n <- AMR_env$MO_lookup[match(n, AMR_env$MO_lookup$fullname), "kingdom_index", drop = TRUE] # matching score: (l_n - 0.5 * l_n.lev) / (l_n * p_n * k_n) diff --git a/R/zzz.R b/R/zzz.R index 6d050bc5..e474bf17 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -147,8 +147,8 @@ if (utf8_supported && !is_latex) { # reference data - they have additional columns compared to `antibiotics` and `microorganisms` to improve speed # they cannot be part of R/sysdata.rda since CRAN thinks it would make the package too large (+3 MB) - assign(x = "AB_lookup", value = create_AB_lookup(), envir = asNamespace("AMR")) - assign(x = "MO_lookup", value = create_MO_lookup(), envir = asNamespace("AMR")) + 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")) } diff --git a/data-raw/_pre_commit_hook.R b/data-raw/_pre_commit_hook.R index d8ba5cd0..594d23d2 100644 --- a/data-raw/_pre_commit_hook.R +++ b/data-raw/_pre_commit_hook.R @@ -145,22 +145,22 @@ create_species_cons_cops <- function(type = c("CoNS", "CoPS")) { } } create_MO_fullname_lower <- function() { - MO_lookup <- AMR::microorganisms + AMR_env$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 + AMR_env$MO_lookup$fullname_lower <- tolower(trimws(paste( + AMR_env$MO_lookup$genus, + AMR_env$MO_lookup$species, + AMR_env$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 + ind <- AMR_env$MO_lookup$genus == "" | grepl("^[(]unknown ", AMR_env$MO_lookup$fullname, perl = TRUE) + AMR_env$MO_lookup[ind, "fullname_lower"] <- tolower(AMR_env$MO_lookup[ind, "fullname", drop = TRUE]) + AMR_env$MO_lookup$fullname_lower <- trimws(gsub("[^.a-z0-9/ \\-]+", "", AMR_env$MO_lookup$fullname_lower, perl = TRUE)) + AMR_env$MO_lookup$fullname_lower } MO_CONS <- create_species_cons_cops("CoNS") MO_COPS <- create_species_cons_cops("CoPS") -MO_STREP_ABCG <- MO_lookup$mo[which(MO_lookup$genus == "Streptococcus" & - MO_lookup$species %in% c( +MO_STREP_ABCG <- AMR_env$MO_lookup$mo[which(AMR_env$MO_lookup$genus == "Streptococcus" & + AMR_env$MO_lookup$species %in% c( "pyogenes", "agalactiae", "dysgalactiae", "equi", "anginosus", "sanguinis", "salivarius", "group A", "group B", "group C", "group D", "group F", "group G", "group H", "group K", "group L" ))] @@ -198,10 +198,10 @@ AB_AMINOGLYCOSIDES <- antibiotics %>% filter(group %like% "aminoglycoside") %>% pull(ab) AB_AMINOPENICILLINS <- as.ab(c("AMP", "AMX")) -AB_ANTIFUNGALS <- AB_lookup %>% +AB_ANTIFUNGALS <- AMR_env$AB_lookup %>% filter(group %like% "antifungal") %>% pull(ab) -AB_ANTIMYCOBACTERIALS <- AB_lookup %>% +AB_ANTIMYCOBACTERIALS <- AMR_env$AB_lookup %>% filter(group %like% "antimycobacterial") %>% pull(ab) AB_CARBAPENEMS <- antibiotics %>% @@ -268,16 +268,16 @@ AB_BETALACTAMS <- c(AB_PENICILLINS, AB_CEPHALOSPORINS, AB_CARBAPENEMS) DEFINED_AB_GROUPS <- ls(envir = globalenv()) DEFINED_AB_GROUPS <- DEFINED_AB_GROUPS[!DEFINED_AB_GROUPS %in% globalenv_before_ab] create_AB_lookup <- function() { - AB_lookup <- AMR::antibiotics - AB_lookup$generalised_name <- generalise_antibiotic_name(AB_lookup$name) - AB_lookup$generalised_synonyms <- lapply(AB_lookup$synonyms, generalise_antibiotic_name) - AB_lookup$generalised_abbreviations <- lapply(AB_lookup$abbreviations, generalise_antibiotic_name) - AB_lookup$generalised_loinc <- lapply(AB_lookup$loinc, generalise_antibiotic_name) - AB_lookup$generalised_all <- unname(lapply( - as.list(as.data.frame(t(AB_lookup[, + AMR_env$AB_lookup <- AMR::antibiotics + AMR_env$AB_lookup$generalised_name <- generalise_antibiotic_name(AMR_env$AB_lookup$name) + AMR_env$AB_lookup$generalised_synonyms <- lapply(AMR_env$AB_lookup$synonyms, generalise_antibiotic_name) + AMR_env$AB_lookup$generalised_abbreviations <- lapply(AMR_env$AB_lookup$abbreviations, generalise_antibiotic_name) + AMR_env$AB_lookup$generalised_loinc <- lapply(AMR_env$AB_lookup$loinc, generalise_antibiotic_name) + AMR_env$AB_lookup$generalised_all <- unname(lapply( + as.list(as.data.frame(t(AMR_env$AB_lookup[, c( "ab", "atc", "cid", "name", - colnames(AB_lookup)[colnames(AB_lookup) %like% "generalised"] + colnames(AMR_env$AB_lookup)[colnames(AMR_env$AB_lookup) %like% "generalised"] ), drop = FALSE ]), @@ -288,7 +288,7 @@ create_AB_lookup <- function() { x[x != ""] } )) - AB_lookup[, colnames(AB_lookup)[colnames(AB_lookup) %like% "^generalised"]] + AMR_env$AB_lookup[, colnames(AMR_env$AB_lookup)[colnames(AMR_env$AB_lookup) %like% "^generalised"]] } AB_LOOKUP <- create_AB_lookup() diff --git a/inst/tinytest/test-data.R b/inst/tinytest/test-data.R index cf69400c..bcd1cc79 100644 --- a/inst/tinytest/test-data.R +++ b/inst/tinytest/test-data.R @@ -64,7 +64,7 @@ if (AMR:::pkg_is_available("tibble", also_load = FALSE)) { } } -df <- AMR:::MO_lookup +df <- AMR:::AMR_env$MO_lookup expect_true(nrow(df[which(df$prevalence == 1), , drop = FALSE]) < nrow(df[which(df$prevalence == 2), , drop = FALSE])) expect_true(nrow(df[which(df$prevalence == 2), , drop = FALSE]) < nrow(df[which(df$prevalence == 3), , drop = FALSE])) expect_true(all(c( diff --git a/man/add_custom_antimicrobials.Rd b/man/add_custom_antimicrobials.Rd index 24e3f939..98dbf77b 100644 --- a/man/add_custom_antimicrobials.Rd +++ b/man/add_custom_antimicrobials.Rd @@ -69,8 +69,8 @@ ab_name("J01CR50") # even antibiotic selectors work x <- data.frame(random_column = "test", - coflu = as.rsi("S"), - ampicillin = as.rsi("R")) + coflu = as.rsi("S"), + ampicillin = as.rsi("R")) x x[, betalactams()] }