diff --git a/DESCRIPTION b/DESCRIPTION index 0e542fcf..79013426 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 1.8.2.9012 -Date: 2022-10-10 +Version: 1.8.2.9013 +Date: 2022-10-11 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 71a1d94c..1fa982fa 100755 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 1.8.2.9012 +# AMR 1.8.2.9013 This version will eventually become v2.0! We're happy to reach a new major milestone soon! diff --git a/R/ab_selectors.R b/R/ab_selectors.R index cc6f2b2a..766c6aa8 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(AMR::antibiotics[which(eval(call, envir = AMR::antibiotics)), "ab", drop = TRUE], + agents <- tryCatch(AB_lookup[which(eval(call, envir = 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 <- AMR::antibiotics[which(!is.na(AMR::antibiotics$oral_ddd)), "ab", drop = TRUE] - agents <- AMR::antibiotics[which(AMR::antibiotics$ab %in% ab_in_data & !is.na(AMR::antibiotics$oral_ddd)), "ab", drop = TRUE] + 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 <- 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 <- AMR::antibiotics[which(!is.na(AMR::antibiotics$iv_ddd)), "ab", drop = TRUE] - agents <- AMR::antibiotics[which(AMR::antibiotics$ab %in% ab_in_data & !is.na(AMR::antibiotics$iv_ddd)), "ab", drop = TRUE] + 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 <- ab_in_data[ab_in_data %in% agents] message_agent_names( function_name = "administrable_iv", @@ -541,9 +541,10 @@ ab_select_exec <- function(function_name, info = FALSE, only_rsi_columns = only_rsi_columns, sort = FALSE, fn = function_name ) + # untreatable drugs if (only_treatable == TRUE) { - untreatable <- AMR::antibiotics[which(AMR::antibiotics$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE] + untreatable <- AB_lookup[which(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_( @@ -570,13 +571,26 @@ 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 <- antibiotics$ab[which(antibiotics$group == "Antifungals")] + abx <- AB_lookup$ab[which(AB_lookup$group == "Antifungals")] } else if (isTRUE(function_name == "antimycobacterials")) { - abx <- antibiotics$ab[which(antibiotics$group == "Antimycobacterials")] + abx <- AB_lookup$ab[which(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), ] + check_string <- paste0(custom_ab$group, custom_ab$atc_group1, custom_ab$atc_group2) + if (function_name == "betalactams") { + find_group <- "beta-lactams" + } else if (function_name %like% "cephalosporins_") { + find_group <- gsub("_(.*)$", paste0(" (\\1 gen.)"), function_name) + } else { + find_group <- function_name + } + abx <- c(abx, custom_ab$ab[which(check_string %like% find_group)]) + } ab_group <- function_name } examples <- paste0(" (such as ", vector_or(ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE), @@ -793,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 <- AMR::antibiotics[which((!is.na(AMR::antibiotics$iv_ddd) | !is.na(AMR::antibiotics$oral_ddd)) & - AMR::antibiotics$name %unlike% " " & - AMR::antibiotics$group %like% ab_group & - AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name + 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 if (length(drugs) < n) { # now try it all - drugs <- antibiotics[which((AMR::antibiotics$group %like% ab_group | - AMR::antibiotics$atc_group1 %like% ab_group | - AMR::antibiotics$atc_group2 %like% ab_group) & - AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name + 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 } if (length(drugs) == 0) { return("??") diff --git a/R/add_custom_antimicrobials.R b/R/add_custom_antimicrobials.R index 9c320f93..29929b62 100644 --- a/R/add_custom_antimicrobials.R +++ b/R/add_custom_antimicrobials.R @@ -69,6 +69,25 @@ #' ab_group("test") #' #' ab_info("test") +#' +#' +#' # Add Co-fluampicil, which is one of the many J01CR50 codes, see +#' # https://www.whocc.no/ddd/list_of_ddds_combined_products/ +#' add_custom_antimicrobials( +#' data.frame(ab = "COFLU", +#' name = "Co-fluampicil", +#' atc = "J01CR50", +#' group = "Beta-lactams/penicillines") +#' ) +#' ab_atc("Co-fluampicil") +#' ab_name("J01CR50") +#' +#' # even antibiotic selectors work +#' x <- data.frame(random_column = "test", +#' 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)), @@ -79,18 +98,27 @@ add_custom_antimicrobials <- function(x) { x <- x[, colnames(AB_lookup)[colnames(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)) { + x$atc <- as.list(x$atc) + } + if ("loinc" %in% colnames(x)) { + x$loinc <- as.list(x$loinc) + } + 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 <- rbind(AB_lookup, x, stringsAsFactors = FALSE) + 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) assignInNamespace(x = "AB_lookup", value = new_df, ns = asNamespace("AMR")) - message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to internal `antibiotics` data set.") + message_("Added ", nr2char(nrow(x)), " record", ifelse(nrow(x) > 1, "s", ""), " to the internal `antibiotics` data set.") } #' @rdname add_custom_antimicrobials @@ -99,5 +127,6 @@ clear_custom_antimicrobials <- function() { assignInNamespace(x = "AB_lookup", value = create_AB_lookup(), ns = asNamespace("AMR")) + AMR_env$custom_ab_codes <- character(0) message_("Manual antimicrobials cleared.") } diff --git a/R/zzz.R b/R/zzz.R index 0b305d9c..6d050bc5 100755 --- a/R/zzz.R +++ b/R/zzz.R @@ -67,6 +67,7 @@ AMR_env$rsi_interpretation_history <- data.frame( stringsAsFactors = FALSE ) AMR_env$has_data.table <- pkg_is_available("data.table", also_load = FALSE) +AMR_env$custom_ab_codes <- character(0) # determine info icon for messages utf8_supported <- isTRUE(base::l10n_info()$`UTF-8`) diff --git a/man/add_custom_antimicrobials.Rd b/man/add_custom_antimicrobials.Rd index 36b1f450..24043afd 100644 --- a/man/add_custom_antimicrobials.Rd +++ b/man/add_custom_antimicrobials.Rd @@ -52,4 +52,23 @@ ab_name("test") ab_group("test") ab_info("test") + + +# Add Co-fluampicil, which is one of the many J01CR50 codes, see +# https://www.whocc.no/ddd/list_of_ddds_combined_products/ +add_custom_antimicrobials( + data.frame(ab = "COFLU", + name = "Co-fluampicil", + atc = "J01CR50", + group = "Beta-lactams/penicillines") +) +ab_atc("Co-fluampicil") +ab_name("J01CR50") + +# even antibiotic selectors work +x <- data.frame(random_column = "test", + coflu = as.rsi("S"), + ampicillin = as.rsi("R")) +x +x[, betalactams()] }