diff --git a/DESCRIPTION b/DESCRIPTION index 7994d0bb..ba85da6c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: AMR -Version: 2.1.1.9018 -Date: 2024-04-08 +Version: 2.1.1.9021 +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 diff --git a/NAMESPACE b/NAMESPACE index 2921200b..1dac7af9 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index e882ad3c..5ac35536 100644 --- a/NEWS.md +++ b/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 diff --git a/R/aa_helper_functions.R b/R/aa_helper_functions.R index b1e8e99e..7f70ec57 100644 --- a/R/aa_helper_functions.R +++ b/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)), diff --git a/R/mic.R b/R/mic.R index 6182d6d3..1ba1b13e 100644 --- a/R/mic.R +++ b/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) } diff --git a/R/mo_property.R b/R/mo_property.R index 222bfe24..c6eca15b 100755 --- a/R/mo_property.R +++ b/R/mo_property.R @@ -106,7 +106,12 @@ #' 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 ----------------------------------------------------- #' @@ -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) ) ) }) diff --git a/R/plot.R b/R/plot.R index 8fc504ed..66a81f6b 100755 --- a/R/plot.R +++ b/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) @@ -276,6 +276,8 @@ barplot.mic <- function(height, meet_criteria(expand, allow_class = "logical", has_length = 1) main <- gsub(" +", " ", paste0(main, collapse = " ")) + + height <- as.mic(height) # make sure that currently implemented MIC levels are used plot( x = height, diff --git a/R/zzz.R b/R/zzz.R index be2dd282..6399a473 100755 --- a/R/zzz.R +++ b/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 -if (pkg_is_available("cli")) { - # let cli do the determination of supported symbols - AMR_env$info_icon <- import_fn("symbol", "cli")$info - AMR_env$bullet_icon <- import_fn("symbol", "cli")$bullet - AMR_env$dots <- import_fn("symbol", "cli")$ellipsis -} else { - AMR_env$info_icon <- "i" - AMR_env$bullet_icon <- "*" - AMR_env$dots <- "..." -} +# take cli symbols if available +AMR_env$info_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$info %or% "i" +AMR_env$bullet_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$bullet %or% "*" +AMR_env$dots <- import_fn("symbol", "cli", error_on_fail = FALSE)$ellipsis %or% "..." +AMR_env$sup_1_icon <- import_fn("symbol", "cli", error_on_fail = FALSE)$sup_1 %or% "*" .onLoad <- function(lib, pkg) { # Support for tibble headers (type_sum) and tibble columns content (pillar_shaft) diff --git a/inst/tinytest/test-mo_property.R b/inst/tinytest/test-mo_property.R index a083ab46..edd50d2a 100644 --- a/inst/tinytest/test-mo_property.R +++ b/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")) diff --git a/man/mo_property.Rd b/man/mo_property.Rd index f94f1066..5779ad4e 100644 --- a/man/mo_property.Rd +++ b/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 -----------------------------------------------------