(v3.0.1.9007) fix #246

R/ab_property.R

@@ -164,10 +164,29 @@ ab_tradenames <- function(x, ...) {
 
 #' @rdname ab_property
 #' @export
-ab_group <- function(x, language = get_AMR_locale(), ...) {
+ab_group <- function(x, language = get_AMR_locale(), all_groups = FALSE, ...) {
   meet_criteria(x, allow_NA = TRUE)
   language <- validate_language(language)
-  translate_into_language(ab_validate(x = x, property = "group", ...), language = language, only_affect_ab_names = TRUE)
+  meet_criteria(all_groups, allow_class = "logical", has_length = 1)
+
+  grps <- ab_validate(x = x, property = "group", ...)
+  for (i in seq_along(grps)) {
+    # take the first match based on ABX_PRIORITY_LIST
+    if (all_groups == FALSE) {
+      grps[[i]] <- grps[[i]][1]
+    } else if (length(grps[[i]]) > 1) {
+      grps[[i]] <- grps[[i]][grps[[i]] != "Beta-lactamase inhibitors"] # leave these out if there are other groups
+    }
+    if (language != "en") {
+      grps[[i]] <- translate_into_language(grps[[i]], language = language, only_affect_ab_names = TRUE)
+    }
+  }
+  names(grps) <- x
+  if (length(grps) == 1 || all_groups == FALSE) {
+    unname(unlist(grps))
+  } else {
+    grps
+  }
 }
 
 #' @rdname ab_property

R/amr_selectors.R

@@ -425,6 +425,14 @@ phenicols <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
   amr_select_exec("phenicols", only_sir_columns = only_sir_columns, return_all = return_all)
 }
 
+#' @rdname antimicrobial_selectors
+#' @export
+phosphonics <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
+  meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  meet_criteria(return_all, allow_class = "logical", has_length = 1)
+  amr_select_exec("phosphonics", only_sir_columns = only_sir_columns, return_all = return_all)
+}
+
 #' @rdname antimicrobial_selectors
 #' @export
 polymyxins <- function(only_sir_columns = FALSE, only_treatable = TRUE, return_all = TRUE, ...) {
@@ -450,6 +458,14 @@ rifamycins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
   amr_select_exec("rifamycins", only_sir_columns = only_sir_columns, return_all = return_all)
 }
 
+#' @rdname antimicrobial_selectors
+#' @export
+spiropyrimidinetriones <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
+  meet_criteria(only_sir_columns, allow_class = "logical", has_length = 1)
+  meet_criteria(return_all, allow_class = "logical", has_length = 1)
+  amr_select_exec("spiropyrimidinetriones", only_sir_columns = only_sir_columns, return_all = return_all)
+}
+
 #' @rdname antimicrobial_selectors
 #' @export
 streptogramins <- function(only_sir_columns = FALSE, return_all = TRUE, ...) {
@@ -685,7 +701,7 @@ amr_select_exec <- function(function_name,
   }
 
   # untreatable drugs
-  untreatable <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$name %like% "(-high|EDTA|polysorbate|macromethod|screening|nacubactam)")]
+  untreatable <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$name %like% "(-high|EDTA|polysorbate|macromethod|screening|nacubactam|inducible)")]
   if (!is.null(vars_df) && only_treatable == TRUE) {
     if (any(untreatable %in% names(ab_in_data))) {
       if (message_not_thrown_before(function_name, "amr_class", "untreatable")) {
@@ -713,9 +729,9 @@ amr_select_exec <- function(function_name,
   if (is.null(amr_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
     ab_group <- NULL
     if (isTRUE(function_name == "antifungals")) {
-      abx <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$group == "Antifungals")]
+      abx <- AMR_env$AB_lookup$ab[which(vapply(FUN.VALUE = logical(1), AMR_env$AB_lookup$group, function(x) "Antifungals" %in% x))]
     } else if (isTRUE(function_name == "antimycobacterials")) {
-      abx <- AMR_env$AB_lookup$ab[which(AMR_env$AB_lookup$group == "Antimycobacterials")]
+      abx <- AMR_env$AB_lookup$ab[which(vapply(FUN.VALUE = logical(1), AMR_env$AB_lookup$group, function(x) "Antimycobacterials" %in% x))]
     } else {
       # their upper case equivalent are vectors with class 'ab', created in data-raw/_pre_commit_checks.R
       # carbapenems() gets its codes from AMR:::AB_CARBAPENEMS
@@ -723,7 +739,11 @@ amr_select_exec <- function(function_name,
       # manually added codes from add_custom_antimicrobials() must also be supported
       if (length(AMR_env$custom_ab_codes) > 0) {
         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)
+        check_string <- paste0(
+          vapply(FUN.VALUE = character(1), custom_ab$group, function(x) paste(x, collapse = " ")),
+          custom_ab$atc_group1,
+          custom_ab$atc_group2
+        )
         if (function_name == "betalactams") {
           find_group <- "beta[-]?lactams"
         } else if (function_name %like% "cephalosporins_") {
@@ -1001,11 +1021,11 @@ find_ab_names <- function(ab_group, n = 3) {
   # try popular first, they have DDDs
   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 &
+    vapply(FUN.VALUE = character(1), AMR_env$AB_lookup$group, function(x) paste(x, collapse = " ")) %like% ab_group &
     AMR_env$AB_lookup$ab %unlike% "[0-9]$"), ]$name
   if (length(drugs) < n) {
     # now try it all
-    drugs <- AMR_env$AB_lookup[which((AMR_env$AB_lookup$group %like% ab_group |
+    drugs <- AMR_env$AB_lookup[which((vapply(FUN.VALUE = character(1), AMR_env$AB_lookup$group, function(x) paste(x, collapse = " ")) %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

R/antibiogram.R

@@ -584,7 +584,7 @@ antibiogram.default <- function(x,
     if (length(existing_ab_combined_cols) > 0 && !is.null(ab_transform)) {
       ab_transform <- NULL
       warning_(
-        "Detected column name(s) containing the '+' character, which conflicts with the expected syntax in `antibiogram()`: the '+' is used to combine separate antimicrobial agent columns (e.g., \"AMP+GEN\").\n\n",
+        "Detected column name(s) containing the '+' character, which conflicts with the expected syntax in `antibiogram()`: the '+' is used to combine separate antimicrobial drug columns (e.g., \"AMP+GEN\").\n\n",
         "To avoid incorrectly guessing which antimicrobials this represents, `ab_transform` was automatically set to `NULL`.\n\n",
         "If this is unintended, please rename the column(s) to avoid using '+' in the name, or set `ab_transform = NULL` explicitly to suppress this message."
       )

R/data.R

@@ -38,7 +38,7 @@
 #' - `ab`\cr antimicrobial ID as used in this package (such as `AMC`), using the official EARS-Net (European Antimicrobial Resistance Surveillance Network) codes where available. ***This is a unique identifier.***
 #' - `cid`\cr Compound ID as found in PubChem. ***This is a unique identifier.***
 #' - `name`\cr Official name as used by WHONET/EARS-Net or the WHO. ***This is a unique identifier.***
-#' - `group`\cr A short and concise group name, based on WHONET and WHOCC definitions
+#' - `group`\cr One or more short and concise group names, based on WHONET and WHOCC definitions
 #' - `atc`\cr ATC codes (Anatomical Therapeutic Chemical) as defined by the WHOCC, like `J01CR02` (last updated `r documentation_date(TAXONOMY_VERSION$ATC_DDD$accessed_date)`):
 #' - `atc_group1`\cr Official pharmacological subgroup (3rd level ATC code) as defined by the WHOCC, like `"Macrolides, lincosamides and streptogramins"`
 #' - `atc_group2`\cr Official chemical subgroup (4th level ATC code) as defined by the WHOCC, like `"Macrolides"`
@@ -368,7 +368,7 @@
 #' @format A [tibble][tibble::tibble] with `r format(nrow(esbl_isolates), big.mark = " ")` observations and `r ncol(esbl_isolates)` variables:
 #' - `esbl`\cr Logical indicator if the isolate is ESBL-producing
 #' - `genus`\cr Genus of the microorganism
-#' - `AMC:COL`\cr MIC values for 17 antimicrobial agents, transformed to class [`mic`] (see [as.mic()])
+#' - `AMC:COL`\cr MIC values for 17 antimicrobial drugs, transformed to class [`mic`] (see [as.mic()])
 #' @details See our [tidymodels integration][amr-tidymodels] for an example using this data set.
 #' @examples
 #' esbl_isolates

R/translate.R

@@ -263,20 +263,47 @@ translate_into_language <- function(from,
     df_trans$pattern[df_trans$regular_expr == TRUE] <- gsub("$$", "$", df_trans$pattern[df_trans$regular_expr == TRUE], fixed = TRUE)
   }
 
+  # regex part
   lapply(
     # starting with longest pattern, since more general translations are shorter, such as 'Group'
-    order(nchar(df_trans$pattern), decreasing = TRUE),
+    order(nchar(df_trans$pattern), decreasing = TRUE)[df_trans$regular_expr == TRUE],
     function(i) {
       from_unique_translated <<- gsub(
         pattern = df_trans$pattern[i],
         replacement = df_trans[i, lang, drop = TRUE],
         x = from_unique_translated,
-        ignore.case = !df_trans$case_sensitive[i] & df_trans$regular_expr[i],
-        fixed = !df_trans$regular_expr[i],
-        perl = df_trans$regular_expr[i]
+        ignore.case = !df_trans$case_sensitive[i],
+        fixed = FALSE,
+        perl = TRUE
       )
     }
   )
+  # non-regex part
+  from_unique_translated <- vapply(
+    FUN.VALUE = character(1),
+    USE.NAMES = FALSE,
+    from_unique_translated,
+    function(x) {
+      words <- strsplit(x, " ", fixed = TRUE)[[1]]
+      # print(words)
+      for (i in seq_along(words)) {
+        word_trans <- df_trans[[lang]][df_trans$regular_expr == FALSE][match(words[i], df_trans$pattern[df_trans$regular_expr == FALSE])]
+        if (!is.na(word_trans)) {
+          words[i] <- word_trans
+        }
+      }
+      words <- paste(words, collapse = " ")
+      words <- strsplit(x, "/", fixed = TRUE)[[1]]
+      # print(words)
+      for (i in seq_along(words)) {
+        word_trans <- df_trans[[lang]][df_trans$regular_expr == FALSE][match(words[i], df_trans$pattern[df_trans$regular_expr == FALSE])]
+        if (!is.na(word_trans)) {
+          words[i] <- word_trans
+        }
+      }
+      paste(words, collapse = " ")
+    }
+  )
 
   # force UTF-8 for diacritics
   from_unique_translated <- enc2utf8(from_unique_translated)