mirror of
https://github.com/msberends/AMR.git
synced 2024-12-26 22:06:11 +01:00
reftbl in plots, speedup for as.sir() and mo_validate
This commit is contained in:
parent
70c601ca11
commit
a4e2e25e3f
@ -1,5 +1,5 @@
|
||||
Package: AMR
|
||||
Version: 2.0.0.9029
|
||||
Version: 2.0.0.9030
|
||||
Date: 2023-07-10
|
||||
Title: Antimicrobial Resistance Data Analysis
|
||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||
|
||||
7
NEWS.md
7
NEWS.md
@ -1,4 +1,4 @@
|
||||
# AMR 2.0.0.9029
|
||||
# AMR 2.0.0.9030
|
||||
|
||||
## New
|
||||
* Clinical breakpoints and intrinsic resistance of EUCAST 2023 and CLSI 2023 have been added for `as.sir()`. EUCAST 2023 (v13.0) is now the new default guideline for all MIC and disks diffusion interpretations
|
||||
@ -15,6 +15,10 @@
|
||||
## Changed
|
||||
* Updated algorithm of `as.mo()` by giving more weight to fungi
|
||||
* `mo_rank()` now returns `NA` for 'unknown' microorganisms (`B_ANAER`, `B_ANAER-NEG`, `B_ANAER-POS`, `B_GRAMN`, `B_GRAMP`, `F_FUNGUS`, `F_YEAST`, and `UNKNOWN`)
|
||||
* When printing MO codes in a tibble, a mouse-hover now shows the full name of the microorganism
|
||||
* Plots for MIC and disk diffusion values:
|
||||
* Now have settable arguments for breakpoint type and PK/PD, like `as.sir()`
|
||||
* Will now contain the name of the guideline table in the subtitle of the plot
|
||||
* Fixed formatting for `sir_interpretation_history()`
|
||||
* Fixed some WHONET codes for microorganisms and consequently a couple of entries in `clinical_breakpoints`
|
||||
* Fixed a bug for `as.mo()` that led to coercion of `NA` values when using custom microorganism codes
|
||||
@ -26,6 +30,7 @@
|
||||
* Updated the code table in `microorganisms.codes`
|
||||
* Fixed an endless loop if using `reference_df` in `as.mo()`
|
||||
* Fixed bug for indicating UTIs in `as.sir()`
|
||||
* Greatly improved speed of `as.sir()`
|
||||
|
||||
|
||||
# AMR 2.0.0
|
||||
|
||||
@ -60,19 +60,19 @@ EUCAST_VERSION_EXPERT_RULES <- list(
|
||||
version_txt = "v3.3",
|
||||
year = 2021,
|
||||
title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes/"
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
|
||||
),
|
||||
"3.2" = list(
|
||||
version_txt = "v3.2",
|
||||
year = 2020,
|
||||
title = "'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes/"
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
|
||||
),
|
||||
"3.1" = list(
|
||||
version_txt = "v3.1",
|
||||
year = 2016,
|
||||
title = "'EUCAST Expert Rules, Intrinsic Resistance and Exceptional Phenotypes'",
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes/"
|
||||
url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
|
||||
)
|
||||
)
|
||||
# EUCAST_VERSION_RESISTANTPHENOTYPES <- list(
|
||||
@ -80,7 +80,7 @@ EUCAST_VERSION_EXPERT_RULES <- list(
|
||||
# version_txt = "v1.2",
|
||||
# year = 2023,
|
||||
# title = "'Expected Resistant Phenotypes'",
|
||||
# url = "https://www.eucast.org/expert_rules_and_expected_phenotypes/"
|
||||
# url = "https://www.eucast.org/expert_rules_and_expected_phenotypes"
|
||||
# )
|
||||
# )
|
||||
|
||||
|
||||
@ -1237,7 +1237,7 @@ font_grey_bg <- function(..., collapse = " ") {
|
||||
}
|
||||
font_red_bg <- function(..., collapse = " ") {
|
||||
# this is #ed553b (picked to be colourblind-safe with other SIR colours)
|
||||
try_colour(font_black(..., collapse = collapse), before = "\033[48;5;203m", after = "\033[49m", collapse = collapse)
|
||||
try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;203m", after = "\033[49m", collapse = collapse)
|
||||
}
|
||||
font_orange_bg <- function(..., collapse = " ") {
|
||||
# this is #f6d55c (picked to be colourblind-safe with other SIR colours)
|
||||
@ -1533,19 +1533,17 @@ readRDS_AMR <- function(file, refhook = NULL) {
|
||||
# Faster data.table implementations ----
|
||||
|
||||
match <- function(x, table, ...) {
|
||||
chmatch <- import_fn("chmatch", "data.table", error_on_fail = FALSE)
|
||||
if (!is.null(chmatch) && is.character(x) && is.character(table)) {
|
||||
if (!is.null(AMR_env$chmatch) && inherits(x, "character") && inherits(table, "character")) {
|
||||
# data.table::chmatch() is much faster than base::match() for character
|
||||
chmatch(x, table, ...)
|
||||
AMR_env$chmatch(x, table, ...)
|
||||
} else {
|
||||
base::match(x, table, ...)
|
||||
}
|
||||
}
|
||||
`%in%` <- function(x, table) {
|
||||
chin <- import_fn("%chin%", "data.table", error_on_fail = FALSE)
|
||||
if (!is.null(chin) && is.character(x) && is.character(table)) {
|
||||
if (!is.null(AMR_env$chin) && inherits(x, "character") && inherits(table, "character")) {
|
||||
# data.table::`%chin%`() is much faster than base::`%in%`() for character
|
||||
chin(x, table)
|
||||
AMR_env$chin(x, table)
|
||||
} else {
|
||||
base::`%in%`(x, table)
|
||||
}
|
||||
|
||||
6
R/mo.R
6
R/mo.R
@ -628,6 +628,12 @@ pillar_shaft.mo <- function(x, ...) {
|
||||
)
|
||||
}
|
||||
|
||||
# add the names to the bugs as mouse-over!
|
||||
if (tryCatch(isTRUE(getExportedValue("ansi_has_hyperlink_support", ns = asNamespace("cli"))()), error = function(e) FALSE)) {
|
||||
out[!x %in% c("UNKNOWN", NA)] <- font_url(url = mo_name(x[!x %in% c("UNKNOWN", NA)], language = NULL, keep_synonyms = TRUE),
|
||||
txt = out[!x %in% c("UNKNOWN", NA)])
|
||||
}
|
||||
|
||||
# make it always fit exactly
|
||||
max_char <- max(nchar(x))
|
||||
if (is.na(max_char)) {
|
||||
|
||||
@ -913,26 +913,36 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ..
|
||||
Lancefield <- FALSE
|
||||
}
|
||||
has_Becker_or_Lancefield <- Becker %in% c(TRUE, "all") || Lancefield %in% c(TRUE, "all")
|
||||
|
||||
# get microorganisms data set, but remove synonyms if keep_synonyms is FALSE
|
||||
mo_data_check <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$status %in% if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"), , drop = FALSE]
|
||||
|
||||
if (all(x %in% c(mo_data_check$mo, NA)) && !has_Becker_or_Lancefield) {
|
||||
# do nothing, just don't run the other if-else's
|
||||
} else if (all(x %in% c(unlist(mo_data_check[[property]]), NA)) && !has_Becker_or_Lancefield) {
|
||||
# no need to do anything, just return it
|
||||
return(x)
|
||||
|
||||
if (isFALSE(has_Becker_or_Lancefield) && isTRUE(keep_synonyms) && all(x %in% c(AMR_env$MO_lookup$mo, NA))) {
|
||||
# fastest way to get properties
|
||||
if (property == "snomed") {
|
||||
x <- lapply(x, function(y) unlist(AMR_env$MO_lookup$snomed[match(y, AMR_env$MO_lookup$mo)]))
|
||||
} else {
|
||||
x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)]
|
||||
}
|
||||
|
||||
} else {
|
||||
# we need to get MO codes now
|
||||
x <- replace_old_mo_codes(x, property = property)
|
||||
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
# get property reeaaally fast using match()
|
||||
if (property == "snomed") {
|
||||
x <- lapply(x, function(y) unlist(AMR_env$MO_lookup$snomed[match(y, AMR_env$MO_lookup$mo)]))
|
||||
} else {
|
||||
x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)]
|
||||
# get microorganisms data set, but remove synonyms if keep_synonyms is FALSE
|
||||
mo_data_check <- AMR_env$MO_lookup[which(AMR_env$MO_lookup$status %in% if (isTRUE(keep_synonyms)) c("synonym", "accepted") else "accepted"), , drop = FALSE]
|
||||
|
||||
if (all(x %in% c(mo_data_check$mo, NA)) && !has_Becker_or_Lancefield) {
|
||||
# do nothing, just don't run the other if-else's
|
||||
} else if (all(x %in% c(unlist(mo_data_check[[property]]), NA)) && !has_Becker_or_Lancefield) {
|
||||
# no need to do anything, just return it
|
||||
return(x)
|
||||
} else {
|
||||
# we need to get MO codes now
|
||||
x <- replace_old_mo_codes(x, property = property)
|
||||
x <- as.mo(x, language = language, keep_synonyms = keep_synonyms, ...)
|
||||
}
|
||||
|
||||
# get property reeaaally fast using match()
|
||||
if (property == "snomed") {
|
||||
x <- lapply(x, function(y) unlist(AMR_env$MO_lookup$snomed[match(y, AMR_env$MO_lookup$mo)]))
|
||||
} else {
|
||||
x <- AMR_env$MO_lookup[[property]][match(x, AMR_env$MO_lookup$mo)]
|
||||
}
|
||||
}
|
||||
|
||||
if (property == "mo") {
|
||||
|
||||
49
R/plot.R
49
R/plot.R
@ -40,6 +40,7 @@
|
||||
#' @param colours_SIR colours to use for filling in the bars, must be a vector of three values (in the order S, I and R). The default colours are colour-blind friendly.
|
||||
#' @param language language to be used to translate 'Susceptible', 'Increased exposure'/'Intermediate' and 'Resistant' - the default is system language (see [get_AMR_locale()]) and can be overwritten by setting the [package option][AMR-options] [`AMR_locale`][AMR-options], e.g. `options(AMR_locale = "de")`, see [translate]. Use `language = NULL` or `language = ""` to prevent translation.
|
||||
#' @param expand a [logical] to indicate whether the range on the x axis should be expanded between the lowest and highest value. For MIC values, intermediate values will be factors of 2 starting from the highest MIC value. For disk diameters, the whole diameter range will be filled.
|
||||
#' @inheritParams as.sir
|
||||
#' @details
|
||||
#' The interpretation of "I" will be named "Increased exposure" for all EUCAST guidelines since 2019, and will be named "Intermediate" in all other cases.
|
||||
#'
|
||||
@ -93,6 +94,8 @@ plot.mic <- function(x,
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
include_PKPD = getOption("AMR_include_PKPD", TRUE),
|
||||
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
|
||||
...) {
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
meet_criteria(ab, allow_class = c("ab", "character"), allow_NULL = TRUE)
|
||||
@ -123,7 +126,9 @@ plot.mic <- function(x,
|
||||
colours_SIR = colours_SIR,
|
||||
fn = as.mic,
|
||||
language = language,
|
||||
type = "MIC",
|
||||
method = "MIC",
|
||||
include_PKPD = include_PKPD,
|
||||
breakpoint_type = breakpoint_type,
|
||||
...
|
||||
)
|
||||
barplot(x,
|
||||
@ -224,6 +229,8 @@ autoplot.mic <- function(object,
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
include_PKPD = getOption("AMR_include_PKPD", TRUE),
|
||||
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
|
||||
...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(mo, allow_class = c("mo", "character"), allow_NULL = TRUE)
|
||||
@ -256,7 +263,9 @@ autoplot.mic <- function(object,
|
||||
colours_SIR = colours_SIR,
|
||||
fn = as.mic,
|
||||
language = language,
|
||||
type = "MIC",
|
||||
method = "MIC",
|
||||
include_PKPD = include_PKPD,
|
||||
breakpoint_type = breakpoint_type,
|
||||
...
|
||||
)
|
||||
df <- as.data.frame(x, stringsAsFactors = TRUE)
|
||||
@ -327,6 +336,8 @@ plot.disk <- function(x,
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
include_PKPD = getOption("AMR_include_PKPD", TRUE),
|
||||
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
|
||||
...) {
|
||||
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
|
||||
meet_criteria(ylab, allow_class = "character", has_length = 1)
|
||||
@ -357,7 +368,9 @@ plot.disk <- function(x,
|
||||
colours_SIR = colours_SIR,
|
||||
fn = as.disk,
|
||||
language = language,
|
||||
type = "disk",
|
||||
method = "disk",
|
||||
include_PKPD = include_PKPD,
|
||||
breakpoint_type = breakpoint_type,
|
||||
...
|
||||
)
|
||||
|
||||
@ -458,6 +471,8 @@ autoplot.disk <- function(object,
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
include_PKPD = getOption("AMR_include_PKPD", TRUE),
|
||||
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
|
||||
...) {
|
||||
stop_ifnot_installed("ggplot2")
|
||||
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
|
||||
@ -490,7 +505,9 @@ autoplot.disk <- function(object,
|
||||
colours_SIR = colours_SIR,
|
||||
fn = as.disk,
|
||||
language = language,
|
||||
type = "disk",
|
||||
method = "disk",
|
||||
include_PKPD = include_PKPD,
|
||||
breakpoint_type = breakpoint_type,
|
||||
...
|
||||
)
|
||||
df <- as.data.frame(x, stringsAsFactors = TRUE)
|
||||
@ -744,7 +761,7 @@ plot_name_of_I <- function(guideline) {
|
||||
}
|
||||
}
|
||||
|
||||
plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, fn, language, type, ...) {
|
||||
plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, fn, language, method, breakpoint_type, include_PKPD, ...) {
|
||||
guideline <- get_guideline(guideline, AMR::clinical_breakpoints)
|
||||
if (!is.null(mo) && !is.null(ab)) {
|
||||
# interpret and give colour based on MIC values
|
||||
@ -752,30 +769,36 @@ plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, f
|
||||
moname <- mo_name(mo, language = language)
|
||||
ab <- as.ab(ab)
|
||||
abname <- ab_name(ab, language = language)
|
||||
|
||||
# store previous interpretations to backup
|
||||
sir_history <- AMR_env$sir_interpretation_history
|
||||
# and clear previous interpretations
|
||||
AMR_env$sir_interpretation_history <- AMR_env$sir_interpretation_history[0, , drop = FALSE]
|
||||
|
||||
sir <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, include_screening = FALSE, include_PKPD = TRUE, ...)))
|
||||
sir <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, include_screening = FALSE, include_PKPD = include_PKPD, breakpoint_type = breakpoint_type, ...)))
|
||||
guideline_txt <- guideline
|
||||
if (all(is.na(sir))) {
|
||||
sir_screening <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, include_screening = TRUE, include_PKPD = TRUE, ...)))
|
||||
sir_screening <- suppressWarnings(suppressMessages(as.sir(fn(names(x)), mo = mo, ab = ab, guideline = guideline, include_screening = TRUE, include_PKPD = include_PKPD, breakpoint_type = breakpoint_type, ...)))
|
||||
if (!all(is.na(sir_screening))) {
|
||||
message_(
|
||||
"Only ", guideline, " ", type, " interpretations found for ",
|
||||
"Only ", guideline, " ", method, " interpretations found for ",
|
||||
ab_name(ab, language = NULL, tolower = TRUE), " in ", italicise(moname), " for screening"
|
||||
)
|
||||
sir <- sir_screening
|
||||
guideline_txt <- paste0("(Screen, ", guideline_txt, ")")
|
||||
} else {
|
||||
message_(
|
||||
"No ", guideline, " ", type, " interpretations found for ",
|
||||
"No ", guideline, " ", method, " interpretations found for ",
|
||||
ab_name(ab, language = NULL, tolower = TRUE), " in ", italicise(moname)
|
||||
)
|
||||
guideline_txt <- ""
|
||||
guideline_txt <- paste0("(", guideline_txt, ")")
|
||||
}
|
||||
} else {
|
||||
if (isTRUE(list(...)$uti)) {
|
||||
guideline_txt <- paste("UTIs,", guideline_txt)
|
||||
}
|
||||
guideline_txt <- paste0("(", guideline_txt, ")")
|
||||
ref_tbl <- paste0('"', unique(AMR_env$sir_interpretation_history$ref_table), '"', collapse = "/")
|
||||
guideline_txt <- paste0("(", guideline_txt, ": ", ref_tbl, ")")
|
||||
}
|
||||
cols <- character(length = length(sir))
|
||||
cols[is.na(sir)] <- "#BEBEBE"
|
||||
@ -787,5 +810,9 @@ plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, f
|
||||
cols <- "#BEBEBE"
|
||||
sub <- NULL
|
||||
}
|
||||
|
||||
# restore previous interpretations to backup
|
||||
AMR_env$sir_interpretation_history <- sir_history
|
||||
|
||||
list(cols = cols, count = as.double(x), sub = sub, guideline = guideline)
|
||||
}
|
||||
|
||||
39
R/sir.R
39
R/sir.R
@ -793,7 +793,7 @@ as_sir_method <- function(method_short,
|
||||
mo.bak <- mo
|
||||
}
|
||||
# be sure to take current taxonomy, as the 'clinical_breakpoints' data set only contains current taxonomy
|
||||
mo <- suppressWarnings(suppressMessages(as.mo(mo, keep_synonyms = FALSE, inf0 = FALSE)))
|
||||
mo <- suppressWarnings(suppressMessages(as.mo(mo, keep_synonyms = FALSE, info = FALSE)))
|
||||
guideline_coerced <- get_guideline(guideline, reference_data)
|
||||
if (is.na(ab)) {
|
||||
message_("Returning NAs for unknown antibiotic: '", font_bold(ab.bak),
|
||||
@ -846,12 +846,13 @@ as_sir_method <- function(method_short,
|
||||
message_(intro_txt, appendLF = FALSE, as_note = FALSE)
|
||||
|
||||
msg_note <- function(messages) {
|
||||
messages <- unique(messages)
|
||||
for (i in seq_len(length(messages))) {
|
||||
messages[i] <- word_wrap(extra_indent = 5, messages[i])
|
||||
}
|
||||
message(
|
||||
font_yellow_bg(paste0(" NOTE", ifelse(length(messages) > 1, "S", ""), " \n")),
|
||||
paste0(" ", font_black(AMR_env$bullet_icon), " ", font_black(messages, collapse = NULL), collapse = "\n")
|
||||
paste0(" ", font_black(AMR_env$bullet_icon), " ", font_black(messages, collapse = NULL), collapse = "\n")
|
||||
)
|
||||
}
|
||||
|
||||
@ -879,7 +880,6 @@ as_sir_method <- function(method_short,
|
||||
rise_note <- FALSE
|
||||
method_coerced <- toupper(method)
|
||||
ab_coerced <- ab
|
||||
mo_coerced <- mo
|
||||
|
||||
if (identical(reference_data, AMR::clinical_breakpoints)) {
|
||||
breakpoints <- reference_data %pm>%
|
||||
@ -928,7 +928,7 @@ as_sir_method <- function(method_short,
|
||||
p <- progress_ticker(n = nrow(df_unique), n_min = 10, title = font_blue(intro_txt), only_bar_percent = TRUE)
|
||||
has_progress_bar <- !is.null(import_fn("progress_bar", "progress", error_on_fail = FALSE)) && nrow(df_unique) >= 10
|
||||
on.exit(close(p))
|
||||
|
||||
|
||||
# run the rules
|
||||
for (i in seq_len(nrow(df_unique))) {
|
||||
p$tick()
|
||||
@ -943,21 +943,23 @@ as_sir_method <- function(method_short,
|
||||
values <- df[rows, "values", drop = TRUE]
|
||||
new_sir <- rep(NA_sir_, length(rows))
|
||||
|
||||
# find different mo properties
|
||||
mo_current_genus <- as.mo(mo_genus(mo_current, language = NULL))
|
||||
mo_current_family <- as.mo(mo_family(mo_current, language = NULL))
|
||||
mo_current_order <- as.mo(mo_order(mo_current, language = NULL))
|
||||
mo_current_class <- as.mo(mo_class(mo_current, language = NULL))
|
||||
# find different mo properties, as fast as possible
|
||||
mo_current_genus <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$genus[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$genus)]
|
||||
mo_current_family <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$family[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$family)]
|
||||
mo_current_order <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$order[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$order)]
|
||||
mo_current_class <- AMR_env$MO_lookup$mo[match(AMR_env$MO_lookup$class[match(mo_current, AMR_env$MO_lookup$mo)], AMR_env$MO_lookup$class)]
|
||||
mo_current_rank <- AMR_env$MO_lookup$rank[match(mo_current, AMR_env$MO_lookup$mo)]
|
||||
mo_current_name <- AMR_env$MO_lookup$fullname[match(mo_current, AMR_env$MO_lookup$mo)]
|
||||
if (mo_current %in% AMR::microorganisms.groups$mo) {
|
||||
# get the species group
|
||||
mo_current_species_group <- AMR::microorganisms.groups$mo_group[match(mo_current, AMR::microorganisms.groups$mo)]
|
||||
} else {
|
||||
mo_current_species_group <- mo_current
|
||||
}
|
||||
mo_current_other <- as.mo("UNKNOWN")
|
||||
mo_current_other <- structure("UNKNOWN", class = c("mo", "character"))
|
||||
# formatted for notes
|
||||
mo_formatted <- suppressMessages(suppressWarnings(mo_fullname(mo_current, language = NULL, keep_synonyms = FALSE)))
|
||||
if (!mo_rank(mo_current) %in% c("kingdom", "phylum", "class", "order")) {
|
||||
mo_formatted <- mo_current_name
|
||||
if (!mo_current_rank %in% c("kingdom", "phylum", "class", "order")) {
|
||||
mo_formatted <- font_italic(mo_formatted)
|
||||
}
|
||||
ab_formatted <- paste0(
|
||||
@ -1106,8 +1108,7 @@ as_sir_method <- function(method_short,
|
||||
sir_interpretation_history <- function(clean = FALSE) {
|
||||
meet_criteria(clean, allow_class = "logical", has_length = 1)
|
||||
|
||||
out.bak <- AMR_env$sir_interpretation_history
|
||||
out <- out.bak
|
||||
out <- AMR_env$sir_interpretation_history
|
||||
if (NROW(out) == 0) {
|
||||
message_("No results to return. Run `as.sir()` on MIC values or disk diffusion zones first to see a 'logbook' data set here.")
|
||||
return(invisible(NULL))
|
||||
@ -1118,10 +1119,8 @@ sir_interpretation_history <- function(clean = FALSE) {
|
||||
# keep stored for next use
|
||||
if (isTRUE(clean)) {
|
||||
AMR_env$sir_interpretation_history <- AMR_env$sir_interpretation_history[0, , drop = FALSE]
|
||||
} else {
|
||||
AMR_env$sir_interpretation_history <- out.bak
|
||||
}
|
||||
|
||||
|
||||
# sort descending on time
|
||||
out <- out[order(out$datetime, decreasing = TRUE), , drop = FALSE]
|
||||
|
||||
@ -1141,7 +1140,11 @@ pillar_shaft.sir <- function(x, ...) {
|
||||
out[is.na(x)] <- font_grey(" NA")
|
||||
out[x == "S"] <- font_green_bg(" S ")
|
||||
out[x == "I"] <- font_orange_bg(" I ")
|
||||
out[x == "R"] <- font_red_bg(" R ")
|
||||
if (is_dark()) {
|
||||
out[x == "R"] <- font_red_bg(" R ")
|
||||
} else {
|
||||
out[x == "R"] <- font_rose_bg(" R ")
|
||||
}
|
||||
}
|
||||
create_pillar_column(out, align = "left", width = 5)
|
||||
}
|
||||
|
||||
2
R/zzz.R
2
R/zzz.R
@ -73,6 +73,8 @@ AMR_env$sir_interpretation_history <- data.frame(
|
||||
AMR_env$custom_ab_codes <- character(0)
|
||||
AMR_env$custom_mo_codes <- character(0)
|
||||
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")) {
|
||||
|
||||
@ -133,7 +133,7 @@ The \code{\link[=ab_selector]{ab_selector()}} function can be used to internally
|
||||
|
||||
The \code{\link[=administrable_per_os]{administrable_per_os()}} and \code{\link[=administrable_iv]{administrable_iv()}} functions also rely on the \link{antibiotics} data set - antibiotic columns will be matched where a DDD (defined daily dose) for resp. oral and IV treatment is available in the \link{antibiotics} data set.
|
||||
|
||||
The \code{\link[=not_intrinsic_resistant]{not_intrinsic_resistant()}} function can be used to only select antibiotic columns that pose no intrinsic resistance for the microorganisms in the data set. For example, if a data set contains only microorganism codes or names of \emph{E. coli} and \emph{K. pneumoniae} and contains a column "vancomycin", this column will be removed (or rather, unselected) using this function. It currently applies \href{https://www.eucast.org/expert_rules_and_expected_phenotypes/}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021) to determine intrinsic resistance, using the \code{\link[=eucast_rules]{eucast_rules()}} function internally. Because of this determination, this function is quite slow in terms of performance.
|
||||
The \code{\link[=not_intrinsic_resistant]{not_intrinsic_resistant()}} function can be used to only select antibiotic columns that pose no intrinsic resistance for the microorganisms in the data set. For example, if a data set contains only microorganism codes or names of \emph{E. coli} and \emph{K. pneumoniae} and contains a column "vancomycin", this column will be removed (or rather, unselected) using this function. It currently applies \href{https://www.eucast.org/expert_rules_and_expected_phenotypes}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021) to determine intrinsic resistance, using the \code{\link[=eucast_rules]{eucast_rules()}} function internally. Because of this determination, this function is quite slow in terms of performance.
|
||||
}
|
||||
\section{Full list of supported (antibiotic) classes}{
|
||||
|
||||
|
||||
@ -94,7 +94,7 @@ sir_interpretation_history(clean = FALSE)
|
||||
|
||||
\item{conserve_capped_values}{a \link{logical} to indicate that MIC values starting with \code{">"} (but not \code{">="}) must always return "R" , and that MIC values starting with \code{"<"} (but not \code{"<="}) must always return "S"}
|
||||
|
||||
\item{add_intrinsic_resistance}{\emph{(only useful when using a EUCAST guideline)} a \link{logical} to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in \emph{Klebsiella} species. Determination is based on the \link{intrinsic_resistant} data set, that itself is based on \href{https://www.eucast.org/expert_rules_and_expected_phenotypes/}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021).}
|
||||
\item{add_intrinsic_resistance}{\emph{(only useful when using a EUCAST guideline)} a \link{logical} to indicate whether intrinsic antibiotic resistance must also be considered for applicable bug-drug combinations, meaning that e.g. ampicillin will always return "R" in \emph{Klebsiella} species. Determination is based on the \link{intrinsic_resistant} data set, that itself is based on \href{https://www.eucast.org/expert_rules_and_expected_phenotypes}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021).}
|
||||
|
||||
\item{reference_data}{a \link{data.frame} to be used for interpretation, which defaults to the \link{clinical_breakpoints} data set. Changing this argument allows for using own interpretation guidelines. This argument must contain a data set that is equal in structure to the \link{clinical_breakpoints} data set (same column names and column types). Please note that the \code{guideline} argument will be ignored when \code{reference_data} is manually set.}
|
||||
|
||||
|
||||
@ -18,7 +18,7 @@ intrinsic_resistant
|
||||
Data set containing defined intrinsic resistance by EUCAST of all bug-drug combinations.
|
||||
}
|
||||
\details{
|
||||
This data set is based on \href{https://www.eucast.org/expert_rules_and_expected_phenotypes/}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021).
|
||||
This data set is based on \href{https://www.eucast.org/expert_rules_and_expected_phenotypes}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021).
|
||||
\subsection{Direct download}{
|
||||
|
||||
Like all data sets in this package, this data set is publicly available for download in the following formats: R, MS Excel, Apache Feather, Apache Parquet, SPSS, SAS, and Stata. Please visit \href{https://msberends.github.io/AMR/articles/datasets.html}{our website for the download links}. The actual files are of course available on \href{https://github.com/msberends/AMR/tree/main/data-raw}{our GitHub repository}.
|
||||
|
||||
@ -327,7 +327,7 @@ Determination of the Gram stain (\code{\link[=mo_gramstain]{mo_gramstain()}}) wi
|
||||
|
||||
Determination of yeasts (\code{\link[=mo_is_yeast]{mo_is_yeast()}}) will be based on the taxonomic kingdom and class. \emph{Budding yeasts} are fungi of the phylum Ascomycota, class Saccharomycetes (also called Hemiascomycetes). \emph{True yeasts} are aggregated into the underlying order Saccharomycetales. Thus, for all microorganisms that are member of the taxonomic class Saccharomycetes, the function will return \code{TRUE}. It returns \code{FALSE} otherwise (or \code{NA} when the input is \code{NA} or the MO code is \code{UNKNOWN}).
|
||||
|
||||
Determination of intrinsic resistance (\code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}}) will be based on the \link{intrinsic_resistant} data set, which is based on \href{https://www.eucast.org/expert_rules_and_expected_phenotypes/}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021). The \code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}} function can be vectorised over both argument \code{x} (input for microorganisms) and \code{ab} (input for antibiotics).
|
||||
Determination of intrinsic resistance (\code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}}) will be based on the \link{intrinsic_resistant} data set, which is based on \href{https://www.eucast.org/expert_rules_and_expected_phenotypes}{'EUCAST Expert Rules' and 'EUCAST Intrinsic Resistance and Unusual Phenotypes' v3.3} (2021). The \code{\link[=mo_is_intrinsic_resistant]{mo_is_intrinsic_resistant()}} function can be vectorised over both argument \code{x} (input for microorganisms) and \code{ab} (input for antibiotics).
|
||||
|
||||
Determination of bacterial oxygen tolerance (\code{\link[=mo_oxygen_tolerance]{mo_oxygen_tolerance()}}) will be based on BacDive, see \emph{Source}. The function \code{\link[=mo_is_anaerobic]{mo_is_anaerobic()}} only returns \code{TRUE} if the oxygen tolerance is \code{"anaerobe"}, indicting an obligate anaerobic species or genus. It always returns \code{FALSE} for species outside the taxonomic kingdom of Bacteria.
|
||||
|
||||
|
||||
12
man/plot.Rd
12
man/plot.Rd
@ -24,6 +24,8 @@
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
include_PKPD = getOption("AMR_include_PKPD", TRUE),
|
||||
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
|
||||
...
|
||||
)
|
||||
|
||||
@ -38,6 +40,8 @@
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
include_PKPD = getOption("AMR_include_PKPD", TRUE),
|
||||
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
|
||||
...
|
||||
)
|
||||
|
||||
@ -54,6 +58,8 @@
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
include_PKPD = getOption("AMR_include_PKPD", TRUE),
|
||||
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
|
||||
...
|
||||
)
|
||||
|
||||
@ -68,6 +74,8 @@
|
||||
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
|
||||
language = get_AMR_locale(),
|
||||
expand = TRUE,
|
||||
include_PKPD = getOption("AMR_include_PKPD", TRUE),
|
||||
breakpoint_type = getOption("AMR_breakpoint_type", "human"),
|
||||
...
|
||||
)
|
||||
|
||||
@ -113,6 +121,10 @@
|
||||
|
||||
\item{expand}{a \link{logical} to indicate whether the range on the x axis should be expanded between the lowest and highest value. For MIC values, intermediate values will be factors of 2 starting from the highest MIC value. For disk diameters, the whole diameter range will be filled.}
|
||||
|
||||
\item{include_PKPD}{a \link{logical} to indicate that PK/PD clinical breakpoints must be applied as a last resort - the default is \code{TRUE}. Can also be set with the \link[=AMR-options]{package option} \code{\link[=AMR-options]{AMR_include_PKPD}}.}
|
||||
|
||||
\item{breakpoint_type}{the type of breakpoints to use, either "ECOFF", "animal", or "human". ECOFF stands for Epidemiological Cut-Off values. The default is \code{"human"}, which can also be set with the \link[=AMR-options]{package option} \code{\link[=AMR-options]{AMR_breakpoint_type}}.}
|
||||
|
||||
\item{...}{arguments passed on to methods}
|
||||
}
|
||||
\value{
|
||||
|
||||
Loading…
Reference in New Issue
Block a user