mirror of https://github.com/msberends/AMR.git
new `mo_group_members()`
This commit is contained in:
parent
7e7bc9d56e
commit
2899b3c840
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
6
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
|
||||
|
|
|
|||
|
|
@ -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
19
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)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
6
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,
|
||||
|
|
|
|||
16
R/zzz.R
16
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)
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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 -----------------------------------------------------
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue