support ab selectors for manual AB codes

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

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!
 

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 <ab>, 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("??")

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.")
 }

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`)

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()]
 }