P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2024-12-26 07:26:13 +01:00
Code Releases Activity

new mo_group_members()

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends 2024-04-19 10:18:21 +02:00
parent 7e7bc9d56e
commit 2899b3c840
10 changed files with 86 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -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

1
NAMESPACE
View File

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

6
NEWS.md
View File

@ -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

2
R/aa_helper_functions.R
View File

@ -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)),

19
R/mic.R
View File

@ -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)
}

41
R/mo_property.R
View File

@ -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)
)
)
})

6
R/plot.R
View File

@ -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,

16
R/zzz.R
View File

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

4
inst/tinytest/test-mo_property.R
View File

@ -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"))

13
man/mo_property.Rd
View File

@ -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 -----------------------------------------------------