new mo_group_members()

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 2.1.1.9018
+Version: 2.1.1.9021
-Date: 2024-04-08
+Date: 2024-04-19
 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

NAMESPACE

@@ -254,6 +254,7 @@ export(mo_fullname)
 export(mo_gbif)
 export(mo_genus)
 export(mo_gramstain)
+export(mo_group_members)
 export(mo_info)
 export(mo_is_anaerobic)
 export(mo_is_gram_negative)

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 2.1.1.9018
+# AMR 2.1.1.9021
 
 *(this beta version will eventually become v3.0. We're happy to reach a new major milestone soon, which will be all about the new One Health support!)*
 
@@ -17,13 +17,15 @@ This package now supports not only tools for AMR data analysis in clinical setti
   * `ab_url()` now supports retrieving the WHOCC url of their ATCvet pages
 * The function group `scale_*_mic()`, namely: `scale_x_mic()`, `scale_y_mic()`, `scale_colour_mic()` and `scale_fill_mic()`. They are advanced ggplot2 extensions to allow easy plotting of MIC values. They allow for manual range definition and plotting missing intermediate log2 levels.
 * Function `limit_mic_range()`, which allows to limit MIC values to a manually set range. This is the powerhouse behind the `scale_*_mic()` functions, but it can be used by users directly to e.g. compare equality in MIC distributions by rescaling them to the same range first.
+* Function `mo_group_members()` to retrieve the member microorganisms. For example, `mo_group_members("Strep group C")` returns a vector of all microorganisms that are in that group.
 
 ## Changed
 * For MICs:
   * Added as valid levels: 4096, 6 powers of 0.0625, and 5 powers of 192 (192, 384, 576, 768, 960)
   * Added new argument `keep_operators` to `as.mic()`. This can be `"all"` (default), `"none"`, or `"edges"`. This argument is also available in the new `limit_mic_range()` and `scale_*_mic()` functions.
   * Comparisons of MIC values are now more strict. For example, `>32` is higher than (and never equal to) `32`. Thus, `as.mic(">32") == as.mic(32)` now returns `FALSE`, and `as.mic(">32") > as.mic(32)` now returns `TRUE`.
-* Updated `italicise_taxonomy()` to support HTML
+* Updated `italicise_taxonomy()` to support HTML output
+* `mo_info()` now contains an extra element `group_members`, with the contents of the new `mo_group_members()` function
 * Greatly improved `vctrs` integration, a Tidyverse package working in the background for many Tidyverse functions. For users, this means that functions such as `dplyr`'s `bind_rows()`, `rowwise()` and `c_across()` are now supported for e.g. columns of class `mic`. Despite this, this `AMR` package is still zero-dependent on any other package, including `dplyr` and `vctrs`.
 * Updated all ATC codes from WHOCC
 * Updated all antibiotic DDDs from WHOCC

R/aa_helper_functions.R

@@ -835,7 +835,7 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
     return(invisible())
   }
 
-  if (!is.null(allow_class)) {
+  if (!is.null(allow_class) && !(suppressWarnings(all(is.na(object))) && allow_NA == TRUE)) {
     stop_ifnot(inherits(object, allow_class), "argument `", obj_name,
       "` must be ", format_class(allow_class, plural = isTRUE(has_length > 1)),
       ", i.e. not be ", format_class(class(object), plural = isTRUE(has_length > 1)),

R/mic.R

@@ -360,6 +360,10 @@ all_valid_mics <- function(x) {
 
 # will be exported using s3_register() in R/zzz.R
 pillar_shaft.mic <- function(x, ...) {
+  if(!identical(levels(x), VALID_MIC_LEVELS) && message_not_thrown_before("pillar_shaft.mic")) {
+    warning_(AMR_env$sup_1_icon, " These columns contain an outdated or altered structure - convert with `as.mic()` to update",
+             call = FALSE)
+  }
   crude_numbers <- as.double(x)
   operators <- gsub("[^<=>]+", "", as.character(x))
   operators[!is.na(operators) & operators != ""] <- font_silver(operators[!is.na(operators) & operators != ""], collapse = NULL)
@@ -372,17 +376,22 @@ pillar_shaft.mic <- function(x, ...) {
 
 # will be exported using s3_register() in R/zzz.R
 type_sum.mic <- function(x, ...) {
-  "mic"
+  if(!identical(levels(x), VALID_MIC_LEVELS)) {
+    paste0("mic", AMR_env$sup_1_icon)
+  } else {
+    "mic"
+  }
 }
 
 #' @method print mic
 #' @export
 #' @noRd
 print.mic <- function(x, ...) {
-  cat("Class 'mic'\n")
+  cat("Class 'mic'")
   if(!identical(levels(x), VALID_MIC_LEVELS)) {
-    cat(font_red("This object has an outdated or altered structure - convert with `as.mic()` to update\n"))
+    cat(font_red(" with an outdated or altered structure - convert with `as.mic()` to update"))
   }
+  cat("\n")
   print(as.character(x), quote = FALSE)
   att <- attributes(x)
   if ("na.action" %in% names(att)) {
@@ -411,7 +420,7 @@ as.vector.mic <- function(x, mode = "numneric", ...) {
   y <- as.mic(y)
   calls <- unlist(lapply(sys.calls(), as.character))
   if (any(calls %in% c("rbind", "cbind")) && message_not_thrown_before("as.vector.mic")) {
-    warning_("Functions `rbind()` and `cbind()` cannot preserve the structure of MIC values. Use dplyr's `bind_rows()` or `bind_cols()` instead. To solve, you can also use `your_data %>% mutate_if(is.ordered, as.mic)`.", call = FALSE)
+    warning_("Functions `rbind()` and `cbind()` cannot preserve the structure of MIC values. Use dplyr's `bind_rows()` or `bind_cols()` instead.", call = FALSE)
   }
   y
 }
@@ -561,7 +570,7 @@ Ops.mic <- function(e1, e2) {
   e2_chr <- character(0)
   e1 <- as.double(e1)
   if (!missing(e2)) {
-    # when e1 is `!`, e2 is missing
+    # when .Generic is `!`, e2 is missing
     e2_chr <- as.character(e2)
     e2 <- as.double(e2)
   }

R/mo_property.R

@@ -107,6 +107,11 @@
 #' mo_url("Klebsiella pneumoniae")
 #' mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
 #' 
+#' mo_group_members("Streptococcus group A")
+#' mo_group_members(c("Streptococcus group C",
+#'                    "Streptococcus group G",
+#'                    "Streptococcus group L"))
+#' 
 #'
 #' # scientific reference -----------------------------------------------------
 #'
@@ -796,6 +801,37 @@ mo_current <- function(x, language = get_AMR_locale(), ...) {
   mo_name(out, language = language)
 }
 
+
+#' @rdname mo_property
+#' @export
+mo_group_members <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
+  if (missing(x)) {
+    # this tries to find the data and an 'mo' column
+    x <- find_mo_col(fn = "mo_synonyms")
+  }
+  meet_criteria(x, allow_NA = TRUE)
+  language <- validate_language(language)
+  meet_criteria(keep_synonyms, allow_class = "logical", has_length = 1)
+  
+  add_MO_lookup_to_AMR_env()
+  
+  x.mo <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
+  metadata <- get_mo_uncertainties()
+  
+  members <- lapply(x.mo, function(y) {
+    AMR::microorganisms.groups$mo_name[which(AMR::microorganisms.groups$mo_group == y)]
+  })
+  names(members) <- mo_name(x, keep_synonyms = TRUE, language = language)
+  
+  if (length(members) == 1) {
+    members <- unname(unlist(members))
+  }
+  
+  load_mo_uncertainties(metadata)
+  members
+}
+
+
 #' @rdname mo_property
 #' @export
 mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("AMR_keep_synonyms", FALSE), ...) {
@@ -823,7 +859,8 @@ mo_info <- function(x, language = get_AMR_locale(), keep_synonyms = getOption("A
         ref = mo_ref(y, keep_synonyms = keep_synonyms),
         snomed = unlist(mo_snomed(y, keep_synonyms = keep_synonyms)),
         lpsn = mo_lpsn(y, language = language, keep_synonyms = keep_synonyms),
-        gbif = mo_gbif(y, language = language, keep_synonyms = keep_synonyms)
+        gbif = mo_gbif(y, language = language, keep_synonyms = keep_synonyms),
+        group_members = mo_group_members(y, language = language, keep_synonyms = keep_synonyms)
       )
     )
   })

R/plot.R

@@ -178,7 +178,6 @@ plot.mic <- function(x,
                      include_PKPD = getOption("AMR_include_PKPD", TRUE),
                      breakpoint_type = getOption("AMR_breakpoint_type", "human"),
                      ...) {
-  x <- as.mic(x) # make sure that currently implemented MIC levels are used
   meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
   meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
   meet_criteria(guideline, allow_class = "character", has_length = 1)
@@ -189,6 +188,8 @@ plot.mic <- function(x,
   language <- validate_language(language)
   meet_criteria(expand, allow_class = "logical", has_length = 1)
 
+  x <- as.mic(x) # make sure that currently implemented MIC levels are used
+  
   if (length(colours_SIR) == 1) {
     colours_SIR <- rep(colours_SIR, 3)
   }
@@ -264,7 +265,6 @@ barplot.mic <- function(height,
                         language = get_AMR_locale(),
                         expand = TRUE,
                         ...) {
-  height <- as.mic(height) # make sure that currently implemented MIC levels are used
   meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
   meet_criteria(ylab, allow_class = "character", has_length = 1)
   meet_criteria(xlab, allow_class = "character", has_length = 1)
@@ -277,6 +277,8 @@ barplot.mic <- function(height,
 
   main <- gsub(" +", " ", paste0(main, collapse = " "))
   
+  height <- as.mic(height) # make sure that currently implemented MIC levels are used
+
   plot(
     x = height,
     main = main,

R/zzz.R

@@ -78,17 +78,11 @@ AMR_env$is_dark_theme <- NULL
 AMR_env$chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE)
 AMR_env$chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
 
-# determine info icon for messages
+# take cli symbols if available
-if (pkg_is_available("cli")) {
+AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %or% "i"
-  # let cli do the determination of supported symbols
+AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %or% "*"
-  AMR_env$info_icon <- import_fn("symbol", "cli")$info
+AMR_env$dots <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %or% "..."
-  AMR_env$bullet_icon <- import_fn("symbol", "cli")$bullet
+AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %or% "*"
-  AMR_env$dots <- import_fn("symbol", "cli")$ellipsis
-} else {
-  AMR_env$info_icon <- "i"
-  AMR_env$bullet_icon <- "*"
-  AMR_env$dots <- "..."
-}
 
 .onLoad <- function(lib, pkg) {
   # Support for tibble headers (type_sum) and tibble columns content (pillar_shaft)

inst/tinytest/test-mo_property.R

@@ -98,9 +98,11 @@ expect_equal(names(mo_info("Escherichia coli")), c(
   "mo",
   "kingdom", "phylum", "class", "order", "family", "genus", "species", "subspecies",
   "status", "synonyms", "gramstain", "oxygen_tolerance",
-  "url", "ref", "snomed", "lpsn", "gbif"
+  "url", "ref", "snomed", "lpsn", "gbif", "group_members"
 ))
 expect_inherits(mo_info(c("Escherichia coli", "Staphylococcus aureus")), "list")
+expect_true(length(mo_group_members("B_HACEK")) > 1)
+expect_inherits(mo_group_members(c("Candida albicans", "Escherichia coli")), "list")
 
 expect_identical(mo_oxygen_tolerance(c("Klebsiella pneumoniae", "Clostridioides difficile")),
                  c("aerobe", "anaerobe"))

man/mo_property.Rd

@@ -34,6 +34,7 @@
 \alias{mo_taxonomy}
 \alias{mo_synonyms}
 \alias{mo_current}
+\alias{mo_group_members}
 \alias{mo_info}
 \alias{mo_url}
 \title{Get Properties of a Microorganism}
@@ -258,6 +259,13 @@ mo_synonyms(
 
 mo_current(x, language = get_AMR_locale(), ...)
 
+mo_group_members(
+  x,
+  language = get_AMR_locale(),
+  keep_synonyms = getOption("AMR_keep_synonyms", FALSE),
+  ...
+)
+
 mo_info(
   x,
   language = get_AMR_locale(),
@@ -396,6 +404,11 @@ mo_rank("Klebsiella pneumoniae")
 mo_url("Klebsiella pneumoniae")
 mo_is_yeast(c("Candida", "Trichophyton", "Klebsiella"))
 
+mo_group_members("Streptococcus group A")
+mo_group_members(c("Streptococcus group C",
+                   "Streptococcus group G",
+                   "Streptococcus group L"))
+
 
 # scientific reference -----------------------------------------------------