P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-19 23:53:15 +02:00
Code Releases Activity

(v3.0.0.9008) fix ggplot_sir(), support lighter green for SDD

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-07-17 17:05:41 +02:00
parent 8dab0a3730
commit d94bdd2c6a
23 changed files with 237 additions and 164 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

@ -1,5 +1,5 @@
Package: AMR
Version: 3.0.0.9007
Version: 3.0.0.9008
Date: 2025-07-17
Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR)

4
NEWS.md
View File

@ -1,4 +1,4 @@
# AMR 3.0.0.9007
# AMR 3.0.0.9008
This is primarily a bugfix release, though we added one nice feature too.
@ -13,6 +13,8 @@ This is primarily a bugfix release, though we added one nice feature too.
* Fixed a bug in `as.ab()` for antimicrobial codes with a number in it if they are preceded by a space
* Fixed a bug in `eucast_rules()` for using specific custom rules
* Fixed a bug in `as.sir()` to allow any tidyselect language (#220)
* Fixed a bug in `ggplot_sir()` when using `combine_SI = FALSE` (#213)
* Fixed all plotting to contain a separate colour for SDD (susceptible dose-dependent)
* Fixed some specific Dutch translations for antimicrobials
* Updated `random_mic()` and `random_disk()` to set skewedness of the distribution and allow multiple microorganisms

6
R/aa_helper_functions.R
View File

@ -789,7 +789,7 @@ meet_criteria <- function(object, # can be literally `list(...)` for `allow_argu
# if object is missing, or another error:
tryCatch(invisible(object),
error = function(e) AMR_env$meet_criteria_error_txt <- e$message
error = function(e) AMR_env$meet_criteria_error_txt <- conditionMessage(e)
)
if (!is.null(AMR_env$meet_criteria_error_txt)) {
error_txt <- AMR_env$meet_criteria_error_txt
@ -1294,6 +1294,10 @@ font_green_bg <- function(..., collapse = " ") {
# this is #3caea3 (picked to be colourblind-safe with other SIR colours)
try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;79m", after = "\033[49m", collapse = collapse)
}
font_green_lighter_bg <- function(..., collapse = " ") {
# this is #8FD6C4 (picked to be colourblind-safe with other SIR colours)
try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;158m", after = "\033[49m", collapse = collapse)
}
font_purple_bg <- function(..., collapse = " ") {
try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;89m", after = "\033[49m", collapse = collapse)
}

2
R/ab_property.R
View File

@ -445,7 +445,7 @@ ab_validate <- function(x, property, ...) {
# try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE
tryCatch(x[1L] %in% AMR_env$AB_lookup[1, property, drop = TRUE],
error = function(e) stop(e$message, call. = FALSE)
error = function(e) stop(conditionMessage(e), call. = FALSE)
)
if (!all(x %in% AMR_env$AB_lookup[, property, drop = TRUE])) {

4
R/amr_selectors.R
View File

@ -527,7 +527,7 @@ amr_selector <- function(filter,
)
call <- substitute(filter)
agents <- tryCatch(AMR_env$AB_lookup[which(eval(call, envir = AMR_env$AB_lookup)), "ab", drop = TRUE],
error = function(e) stop_(e$message, call = -5)
error = function(e) stop_(conditionMessage(e), call = -5)
)
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(
@ -640,7 +640,7 @@ not_intrinsic_resistant <- function(only_sir_columns = FALSE, col_mo = NULL, ver
)
}
),
error = function(e) stop_("in not_intrinsic_resistant(): ", e$message, call = FALSE)
error = function(e) stop_("in not_intrinsic_resistant(): ", conditionMessage(e), call = FALSE)
)
agents <- ab_in_data[ab_in_data %in% names(vars_df_R[which(vars_df_R)])]

2
R/av_property.R
View File

@ -264,7 +264,7 @@ av_validate <- function(x, property, ...) {
# try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE
tryCatch(x[1L] %in% AMR_env$AV_lookup[1, property, drop = TRUE],
error = function(e) stop(e$message, call. = FALSE)
error = function(e) stop(conditionMessage(e), call. = FALSE)
)
if (!all(x %in% AMR_env$AV_lookup[, property, drop = TRUE])) {

18
R/count.R
View File

@ -126,7 +126,7 @@ count_resistant <- function(..., only_all_tested = FALSE) {
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -139,7 +139,7 @@ count_susceptible <- function(..., only_all_tested = FALSE) {
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -152,7 +152,7 @@ count_S <- function(..., only_all_tested = FALSE) {
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -165,7 +165,7 @@ count_SI <- function(..., only_all_tested = FALSE) {
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -178,7 +178,7 @@ count_I <- function(..., only_all_tested = FALSE) {
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -191,7 +191,7 @@ count_IR <- function(..., only_all_tested = FALSE) {
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -204,7 +204,7 @@ count_R <- function(..., only_all_tested = FALSE) {
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -217,7 +217,7 @@ count_all <- function(..., only_all_tested = FALSE) {
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -240,6 +240,6 @@ count_df <- function(data,
combine_SI = combine_SI,
confidence_level = 0.95 # doesn't matter, will be removed
),
error = function(e) stop_(gsub("in sir_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc_df(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}

4
R/custom_mdro_guideline.R
View File

@ -175,7 +175,7 @@ custom_mdro_guideline <- function(..., as_factor = TRUE) {
# Value
val <- tryCatch(eval(dots[[i]][[3]]), error = function(e) NULL)
stop_if(is.null(val), "rule ", i, " must return a valid value, it now returns an error: ", tryCatch(eval(dots[[i]][[3]]), error = function(e) e$message))
stop_if(is.null(val), "rule ", i, " must return a valid value, it now returns an error: ", tryCatch(eval(dots[[i]][[3]]), error = function(e) conditionMessage(e)))
stop_if(length(val) > 1, "rule ", i, " must return a value of length 1, not ", length(val))
out[[i]]$value <- as.character(val)
}
@ -254,7 +254,7 @@ run_custom_mdro_guideline <- function(df, guideline, info) {
for (i in seq_len(n_dots)) {
qry <- tryCatch(eval(parse(text = guideline[[i]]$query), envir = df, enclos = parent.frame()),
error = function(e) {
AMR_env$err_msg <- e$message
AMR_env$err_msg <- conditionMessage(e)
return("error")
}
)

2
R/eucast_rules.R
View File

@ -1178,7 +1178,7 @@ edit_sir <- function(x,
ifelse(length(rows) > 10, "...", ""),
" while writing value '", to,
"' to column(s) `", paste(cols, collapse = "`, `"),
"`:\n", e$message
"`:\n", conditionMessage(e)
),
call. = FALSE
)

1
R/ggplot_sir.R
View File

@ -178,6 +178,7 @@ ggplot_sir <- function(data,
colours = c(
S = "#3CAEA3",
SI = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
IR = "#ED553B",
R = "#ED553B"

2
R/mo.R
View File

@ -1186,7 +1186,7 @@ parse_and_convert <- function(x) {
parsed <- gsub('"', "", parsed, fixed = TRUE)
parsed
},
error = function(e) stop(e$message, call. = FALSE)
error = function(e) stop(conditionMessage(e), call. = FALSE)
) # this will also be thrown when running `as.mo(no_existing_object)`
}
out <- trimws2(out)

2
R/mo_property.R
View File

@ -974,7 +974,7 @@ mo_validate <- function(x, property, language, keep_synonyms = keep_synonyms, ..
# try to catch an error when inputting an invalid argument
# so the 'call.' can be set to FALSE
tryCatch(x[1L] %in% unlist(AMR_env$MO_lookup[1, property, drop = TRUE]),
error = function(e) stop(e$message, call. = FALSE)
error = function(e) stop(conditionMessage(e), call. = FALSE)
)
dots <- list(...)

2
R/pca.R
View File

@ -99,7 +99,7 @@ pca <- function(x,
new_list <- list(0)
for (i in seq_len(length(dots) - 1)) {
new_list[[i]] <- tryCatch(eval(dots[[i + 1]], envir = x),
error = function(e) stop(e$message, call. = FALSE)
error = function(e) stop(conditionMessage(e), call. = FALSE)
)
if (length(new_list[[i]]) == 1) {
if (is.character(new_list[[i]]) && new_list[[i]] %in% colnames(x)) {

245
R/plotting.R
View File

@ -377,6 +377,13 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
args <- list(...)
args[c("value", "labels", "limits")] <- NULL
if (length(colours_SIR) == 1) {
colours_SIR <- rep(colours_SIR, 4)
} else if (length(colours_SIR) == 3) {
colours_SIR <- c(colours_SIR[1], colours_SIR[1], colours_SIR[2], colours_SIR[3])
}
colours_SIR <- unname(colours_SIR)
if (identical(aesthetics, "x")) {
ggplot_fn <- ggplot2::scale_x_discrete
} else {
@ -388,8 +395,8 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
values = c(
S = colours_SIR[1],
SDD = colours_SIR[2],
I = colours_SIR[2],
R = colours_SIR[3],
I = colours_SIR[3],
R = colours_SIR[4],
NI = "grey30"
)
)
@ -427,11 +434,16 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
#' @rdname plot
#' @export
scale_x_sir <- function(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
scale_x_sir <- function(colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST",
...) {
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
language <- validate_language(language)
meet_criteria(eucast_I, allow_class = "logical", has_length = 1)
create_scale_sir(aesthetics = "x", colours_SIR = colours_SIR, language = language, eucast_I = eucast_I)
@ -439,11 +451,16 @@ scale_x_sir <- function(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
#' @rdname plot
#' @export
scale_colour_sir <- function(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
scale_colour_sir <- function(colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST",
...) {
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
language <- validate_language(language)
meet_criteria(eucast_I, allow_class = "logical", has_length = 1)
args <- list(...)
@ -463,11 +480,16 @@ scale_color_sir <- scale_colour_sir
#' @rdname plot
#' @export
scale_fill_sir <- function(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
scale_fill_sir <- function(colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST",
...) {
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
language <- validate_language(language)
meet_criteria(eucast_I, allow_class = "logical", has_length = 1)
args <- list(...)
@ -491,7 +513,12 @@ plot.mic <- function(x,
main = deparse(substitute(x)),
ylab = translate_AMR("Frequency", language = language),
xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
expand = TRUE,
include_PKPD = getOption("AMR_include_PKPD", TRUE),
@ -503,15 +530,11 @@ plot.mic <- function(x,
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)
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
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)
}
main <- gsub(" +", " ", paste0(main, collapse = " "))
x <- plotrange_as_table(x, expand = expand)
@ -549,13 +572,17 @@ plot.mic <- function(x,
legend_col <- colours_SIR[1]
}
if (any(cols_sub$cols == colours_SIR[2] & cols_sub$count > 0)) {
legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
legend_txt <- c(legend_txt, "(SDD) Susceptible dose-dependent")
legend_col <- c(legend_col, colours_SIR[2])
}
if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
legend_txt <- c(legend_txt, "(R) Resistant")
legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
legend_col <- c(legend_col, colours_SIR[3])
}
if (any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) {
legend_txt <- c(legend_txt, "(R) Resistant")
legend_col <- c(legend_col, colours_SIR[4])
}
legend("top",
x.intersp = 0.5,
@ -580,7 +607,12 @@ barplot.mic <- function(height,
main = deparse(substitute(height)),
ylab = translate_AMR("Frequency", language = language),
xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
expand = TRUE,
...) {
@ -590,7 +622,7 @@ barplot.mic <- function(height,
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)
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -622,7 +654,12 @@ autoplot.mic <- function(object,
title = deparse(substitute(object)),
ylab = translate_AMR("Frequency", language = language),
xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language = language),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
expand = TRUE,
include_PKPD = getOption("AMR_include_PKPD", TRUE),
@ -635,7 +672,7 @@ autoplot.mic <- function(object,
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -731,7 +768,12 @@ plot.disk <- function(x,
mo = NULL,
ab = NULL,
guideline = getOption("AMR_guideline", "EUCAST"),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
expand = TRUE,
include_PKPD = getOption("AMR_include_PKPD", TRUE),
@ -743,13 +785,10 @@ plot.disk <- function(x,
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)
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
if (length(colours_SIR) == 1) {
colours_SIR <- rep(colours_SIR, 3)
}
main <- gsub(" +", " ", paste0(main, collapse = " "))
x <- plotrange_as_table(x, expand = expand)
@ -783,12 +822,16 @@ plot.disk <- function(x,
if (any(colours_SIR %in% cols_sub$cols)) {
legend_txt <- character(0)
legend_col <- character(0)
if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
if (any(cols_sub$cols == colours_SIR[4] & cols_sub$count > 0)) {
legend_txt <- "(R) Resistant"
legend_col <- colours_SIR[3]
legend_col <- colours_SIR[4]
}
if (any(cols_sub$cols == colours_SIR[3] & cols_sub$count > 0)) {
legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
legend_col <- c(legend_col, colours_SIR[3])
}
if (any(cols_sub$cols == colours_SIR[2] & cols_sub$count > 0)) {
legend_txt <- c(legend_txt, paste("(I)", plot_name_of_I(cols_sub$guideline)))
legend_txt <- c(legend_txt, "(SDD) Susceptible dose-dependent")
legend_col <- c(legend_col, colours_SIR[2])
}
if (any(cols_sub$cols == colours_SIR[1] & cols_sub$count > 0)) {
@ -818,7 +861,12 @@ barplot.disk <- function(height,
mo = NULL,
ab = NULL,
guideline = getOption("AMR_guideline", "EUCAST"),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
expand = TRUE,
...) {
@ -828,7 +876,7 @@ barplot.disk <- function(height,
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)
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -858,7 +906,12 @@ autoplot.disk <- function(object,
ylab = translate_AMR("Frequency", language = language),
xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
guideline = getOption("AMR_guideline", "EUCAST"),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
expand = TRUE,
include_PKPD = getOption("AMR_include_PKPD", TRUE),
@ -871,7 +924,7 @@ autoplot.disk <- function(object,
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)
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
@ -1024,22 +1077,31 @@ barplot.sir <- function(height,
main = deparse(substitute(height)),
xlab = translate_AMR("Antimicrobial Interpretation", language = language),
ylab = translate_AMR("Frequency", language = language),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
expand = TRUE,
...) {
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(main, allow_class = "character", has_length = 1, allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1)
if (length(colours_SIR) == 1) {
colours_SIR <- rep(colours_SIR, 3)
colours_SIR <- rep(colours_SIR, 4)
} else if (length(colours_SIR) == 3) {
colours_SIR <- c(colours_SIR[1], colours_SIR[1], colours_SIR[2], colours_SIR[3])
}
colours_SIR <- unname(colours_SIR)
# add SDD and N to colours
colours_SIR <- c(colours_SIR[1:2], colours_SIR[2], colours_SIR[3], "#888888")
colours_SIR <- c(colours_SIR, "grey30")
main <- gsub(" +", " ", paste0(main, collapse = " "))
x <- table(height)
@ -1065,14 +1127,19 @@ autoplot.sir <- function(object,
title = deparse(substitute(object)),
xlab = translate_AMR("Antimicrobial Interpretation", language = language),
ylab = translate_AMR("Frequency", language = language),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
),
language = get_AMR_locale(),
...) {
stop_ifnot_installed("ggplot2")
meet_criteria(title, allow_class = "character", allow_NULL = TRUE)
meet_criteria(ylab, allow_class = "character", has_length = 1)
meet_criteria(xlab, allow_class = "character", has_length = 1)
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
if ("main" %in% names(list(...))) {
title <- list(...)$main
@ -1082,8 +1149,11 @@ autoplot.sir <- function(object,
}
if (length(colours_SIR) == 1) {
colours_SIR <- rep(colours_SIR, 3)
colours_SIR <- rep(colours_SIR, 4)
} else if (length(colours_SIR) == 3) {
colours_SIR <- c(colours_SIR[1], colours_SIR[1], colours_SIR[2], colours_SIR[3])
}
colours_SIR <- unname(colours_SIR)
df <- as.data.frame(table(object), stringsAsFactors = TRUE)
colnames(df) <- c("x", "n")
@ -1095,9 +1165,9 @@ autoplot.sir <- function(object,
values = c(
"S" = colours_SIR[1],
"SDD" = colours_SIR[2],
"I" = colours_SIR[2],
"R" = colours_SIR[3],
"NI" = "#888888"
"I" = colours_SIR[3],
"R" = colours_SIR[4],
"NI" = "grey30"
),
limits = force
) +
@ -1182,6 +1252,13 @@ plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, f
guideline <- get_guideline(guideline, AMR::clinical_breakpoints)
if (length(colours_SIR) == 1) {
colours_SIR <- rep(colours_SIR, 4)
} else if (length(colours_SIR) == 3) {
colours_SIR <- c(colours_SIR[1], colours_SIR[1], colours_SIR[2], colours_SIR[3])
}
colours_SIR <- unname(colours_SIR)
# store previous interpretations to backup
sir_history <- AMR_env$sir_interpretation_history
# and clear previous interpretations
@ -1223,9 +1300,9 @@ plot_colours_subtitle_guideline <- function(x, mo, ab, guideline, colours_SIR, f
cols[is.na(sir)] <- "#BEBEBE"
cols[sir == "S"] <- colours_SIR[1]
cols[sir == "SDD"] <- colours_SIR[2]
cols[sir == "I"] <- colours_SIR[2]
cols[sir == "R"] <- colours_SIR[3]
cols[sir == "NI"] <- "#888888"
cols[sir == "I"] <- colours_SIR[3]
cols[sir == "R"] <- colours_SIR[4]
cols[sir == "NI"] <- "grey30"
sub <- bquote(.(abname) ~ "-" ~ italic(.(moname)) ~ .(guideline_txt))
} else {
cols <- "#BEBEBE"
@ -1284,10 +1361,15 @@ scale_y_percent <- function(breaks = function(x) seq(0, max(x, na.rm = TRUE), 0.
#' @export
scale_sir_colours <- function(...,
aesthetics,
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B")) {
colours_SIR = c(
S = "#3CAEA3",
SDD = "#8FD6C4",
I = "#F6D55C",
R = "#ED553B"
)) {
stop_ifnot_installed("ggplot2")
meet_criteria(aesthetics, allow_class = "character", is_in = c("alpha", "colour", "color", "fill", "linetype", "shape", "size"))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3))
meet_criteria(colours_SIR, allow_class = "character", has_length = c(1, 3, 4))
if ("fill" %in% aesthetics && message_not_thrown_before("scale_sir_colours", "fill", entire_session = TRUE)) {
warning_("Using `scale_sir_colours()` for the `fill` aesthetic has been superseded by `scale_fill_sir()`, please use that instead. This warning will be shown once per session.")
@ -1296,67 +1378,52 @@ scale_sir_colours <- function(...,
warning_("Using `scale_sir_colours()` for the `colour` aesthetic has been superseded by `scale_colour_sir()`, please use that instead. This warning will be shown once per session.")
}
if (length(colours_SIR) == 1) {
colours_SIR <- rep(colours_SIR, 3)
}
# behaviour until AMR pkg v1.5.0 and also when coming from ggplot_sir()
if ("colours" %in% names(list(...))) {
original_cols <- c(
S = colours_SIR[1],
SI = colours_SIR[1],
I = colours_SIR[2],
IR = colours_SIR[3],
R = colours_SIR[3]
)
colours <- replace(original_cols, names(list(...)$colours), list(...)$colours)
colours_SIR <- list(...)$colours
}
if (length(colours_SIR) == 1) {
colours_SIR <- rep(colours_SIR, 4)
} else if (length(colours_SIR) == 3) {
colours_SIR <- c(colours_SIR[1], colours_SIR[1], colours_SIR[2], colours_SIR[3])
}
# behaviour when coming from ggplot_sir()
if ("colours" %in% names(list(...))) {
# limits = force is needed in ggplot2 3.3.4 and 3.3.5, see here;
# https://github.com/tidyverse/ggplot2/issues/4511#issuecomment-866185530
return(ggplot2::scale_fill_manual(values = colours, limits = force, aesthetics = aesthetics))
return(ggplot2::scale_fill_manual(values = colours_SIR, limits = force, aesthetics = aesthetics))
}
if (identical(unlist(list(...)), FALSE)) {
return(invisible())
}
names_susceptible <- c(
"S", "SI", "IS", "S+I", "I+S", "susceptible", "Susceptible",
unique(TRANSLATIONS[which(TRANSLATIONS$pattern == "Susceptible"),
"replacement",
drop = TRUE
])
)
colours_SIR <- unname(colours_SIR)
names_susceptible <- c("S", "SI", "IS", "S+I", "I+S", "susceptible", "Susceptible")
names_susceptible_dose_dep <- c("SDD", "susceptible dose-dependent", "Susceptible dose-dependent")
names_incr_exposure <- c(
"I", "intermediate", "increased exposure", "incr. exposure",
"Increased exposure", "Incr. exposure", "Susceptible, incr. exp.",
unique(TRANSLATIONS[which(TRANSLATIONS$pattern == "Intermediate"),
"replacement",
drop = TRUE
]),
unique(TRANSLATIONS[which(TRANSLATIONS$pattern == "Susceptible, incr. exp."),
"replacement",
drop = TRUE
])
)
names_resistant <- c(
"R", "IR", "RI", "R+I", "I+R", "resistant", "Resistant",
unique(TRANSLATIONS[which(TRANSLATIONS$pattern == "Resistant"),
"replacement",
drop = TRUE
])
"Increased exposure", "Incr. exposure", "Susceptible, incr. exp."
)
names_resistant <- c("R", "IR", "RI", "R+I", "I+R", "resistant", "Resistant")
susceptible <- rep(colours_SIR[1], length(names_susceptible))
names(susceptible) <- names_susceptible
incr_exposure <- rep(colours_SIR[2], length(names_incr_exposure))
susceptible_dose_dep <- rep(colours_SIR[2], length(names_susceptible_dose_dep))
names(susceptible_dose_dep) <- names_susceptible_dose_dep
incr_exposure <- rep(colours_SIR[3], length(names_incr_exposure))
names(incr_exposure) <- names_incr_exposure
resistant <- rep(colours_SIR[3], length(names_resistant))
resistant <- rep(colours_SIR[4], length(names_resistant))
names(resistant) <- names_resistant
original_cols <- c(susceptible, incr_exposure, resistant)
original_cols <- c(susceptible, susceptible_dose_dep, incr_exposure, resistant)
dots <- c(...)
# replace S, I, R as colours: scale_sir_colours(mydatavalue = "S")
# replace S, SDD, I, R as colours: scale_sir_colours(mydatavalue = "S")
dots[dots == "S"] <- colours_SIR[1]
dots[dots == "I"] <- colours_SIR[2]
dots[dots == "R"] <- colours_SIR[3]
dots[dots == "SDD"] <- colours_SIR[2]
dots[dots == "I"] <- colours_SIR[3]
dots[dots == "R"] <- colours_SIR[4]
cols <- replace(original_cols, names(dots), dots)
# limits = force is needed in ggplot2 3.3.4 and 3.3.5, see here;
# https://github.com/tidyverse/ggplot2/issues/4511#issuecomment-866185530

20
R/proportion.R
View File

@ -237,7 +237,7 @@ resistance <- function(...,
only_all_tested = only_all_tested,
only_count = FALSE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -255,7 +255,7 @@ susceptibility <- function(...,
only_all_tested = only_all_tested,
only_count = FALSE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -283,7 +283,7 @@ sir_confidence_interval <- function(...,
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
n <- tryCatch(
sir_calc(...,
@ -291,7 +291,7 @@ sir_confidence_interval <- function(...,
only_all_tested = only_all_tested,
only_count = TRUE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
if (x == 0) {
@ -347,7 +347,7 @@ proportion_R <- function(...,
only_all_tested = only_all_tested,
only_count = FALSE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -365,7 +365,7 @@ proportion_IR <- function(...,
only_all_tested = only_all_tested,
only_count = FALSE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -383,7 +383,7 @@ proportion_I <- function(...,
only_all_tested = only_all_tested,
only_count = FALSE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -401,7 +401,7 @@ proportion_SI <- function(...,
only_all_tested = only_all_tested,
only_count = FALSE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -419,7 +419,7 @@ proportion_S <- function(...,
only_all_tested = only_all_tested,
only_count = FALSE
),
error = function(e) stop_(gsub("in sir_calc(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}
@ -443,6 +443,6 @@ proportion_df <- function(data,
combine_SI = combine_SI,
confidence_level = confidence_level
),
error = function(e) stop_(gsub("in sir_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc_df(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}

6
R/sir.R
View File

@ -868,7 +868,7 @@ as.sir.data.frame <- function(x,
cl <- tryCatch(parallel::makeCluster(n_cores, type = "PSOCK"),
error = function(e) {
if (isTRUE(info)) {
message_("Could not create parallel cluster, using single-core computation. Error message: ", e$message, add_fn = font_red)
message_("Could not create parallel cluster, using single-core computation. Error message: ", conditionMessage(e), add_fn = font_red)
}
return(NULL)
}
@ -1909,11 +1909,11 @@ pillar_shaft.sir <- function(x, ...) {
# colours will anyway not work when has_colour() == FALSE,
# but then the indentation should also not be applied
out[is.na(x)] <- font_grey(" NA")
out[x == "NI"] <- font_grey_bg(font_black(" NI "))
out[x == "S"] <- font_green_bg(" S ")
out[x == "SDD"] <- font_green_lighter_bg(" SDD ")
out[x == "I"] <- font_orange_bg(" I ")
out[x == "SDD"] <- font_orange_bg(" SDD ")
out[x == "R"] <- font_rose_bg(" R ")
out[x == "NI"] <- font_grey_bg(font_black(" NI "))
}
create_pillar_column(out, align = "left", width = 5)
}

19
R/sir_calc.R
View File

@ -244,7 +244,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
translate_ab <- get_translate_ab(translate_ab)
data.bak <- data
# select only groups and antimicrobials
# select only groups and antibiotics
if (is_null_or_grouped_tbl(data)) {
data_has_groups <- TRUE
groups <- get_group_names(data)
@ -255,15 +255,14 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
}
data <- as.data.frame(data, stringsAsFactors = FALSE)
if (isTRUE(combine_SI)) {
for (i in seq_len(ncol(data))) {
if (is.sir(data[, i, drop = TRUE])) {
data[, i] <- as.character(data[, i, drop = TRUE])
if ("SDD" %in% data[, i, drop = TRUE] && message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) {
message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE)
}
data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE])
for (i in seq_len(ncol(data))) {
data[, i] <- as.character(as.sir(data[, i, drop = TRUE]))
if (isTRUE(combine_SI)) {
if ("SDD" %in% data[, i, drop = TRUE] && message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) {
message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE)
}
data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE])
}
}
@ -364,7 +363,7 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
} else {
# don't use as.sir() here, as it would add the class 'sir' and we would like
# the same data structure as output, regardless of input
if (out$value[out$interpretation == "SDD"] > 0) {
if (any(out$value[out$interpretation == "SDD"] > 0, na.rm = TRUE)) {
out$interpretation <- factor(out$interpretation, levels = c("S", "SDD", "I", "R"), ordered = TRUE)
} else {
out$interpretation <- factor(out$interpretation, levels = c("S", "I", "R"), ordered = TRUE)

2
R/sir_df.R
View File

@ -47,6 +47,6 @@ sir_df <- function(data,
combine_SI = combine_SI,
confidence_level = confidence_level
),
error = function(e) stop_(gsub("in sir_calc_df(): ", "", e$message, fixed = TRUE), call = -5)
error = function(e) stop_(gsub("in sir_calc_df(): ", "", conditionMessage(e), fixed = TRUE), call = -5)
)
}

4
R/zzz.R
View File

@ -127,7 +127,7 @@ AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
suppressWarnings(suppressMessages(add_custom_antimicrobials(x)))
packageStartupMessage("OK.")
},
error = function(e) packageStartupMessage("Failed: ", e$message)
error = function(e) packageStartupMessage("Failed: ", conditionMessage(e))
)
}
}
@ -143,7 +143,7 @@ AMR_env$cross_icon <- if (isTRUE(base::l10n_info()$`UTF-8`)) "\u00d7" else "x"
suppressWarnings(suppressMessages(add_custom_microorganisms(x)))
packageStartupMessage("OK.")
},
error = function(e) packageStartupMessage("Failed: ", e$message)
error = function(e) packageStartupMessage("Failed: ", conditionMessage(e))
)
}
}

2
data-raw/_reproduction_scripts/reproduction_of_microorganisms.R
View File

@ -288,7 +288,7 @@ for (page in LETTERS) {
url <- paste0("https://lpsn.dsmz.de/genus?page=", page)
x <- tryCatch(read_html(url),
error = function(e) {
message("Waiting 10 seconds because of error: ", e$message)
message("Waiting 10 seconds because of error: ", conditionMessage(e))
Sys.sleep(10)
read_html(url)
})

2
data-raw/read_EUCAST.R
View File

@ -283,7 +283,7 @@ for (i in 2:length(sheets_to_analyse)) {
guideline_name = guideline_name
)
),
error = function(e) message(e$message)
error = function(e) message(conditionMessage(e))
)
}

8
man/ggplot_sir.Rd
View File

@ -9,10 +9,10 @@ ggplot_sir(data, position = NULL, x = "antibiotic",
fill = "interpretation", facet = NULL, breaks = seq(0, 1, 0.1),
limits = NULL, translate_ab = "name", combine_SI = TRUE,
minimum = 30, language = get_AMR_locale(), nrow = NULL, colours = c(S
= "#3CAEA3", SI = "#3CAEA3", I = "#F6D55C", IR = "#ED553B", R = "#ED553B"),
datalabels = TRUE, datalabels.size = 2.5, datalabels.colour = "grey15",
title = NULL, subtitle = NULL, caption = NULL,
x.title = "Antimicrobial", y.title = "Proportion", ...)
= "#3CAEA3", SI = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", IR = "#ED553B",
R = "#ED553B"), datalabels = TRUE, datalabels.size = 2.5,
datalabels.colour = "grey15", title = NULL, subtitle = NULL,
caption = NULL, x.title = "Antimicrobial", y.title = "Proportion", ...)
geom_sir(position = NULL, x = c("antibiotic", "interpretation"),
fill = "interpretation", translate_ab = "name", minimum = 30,

42
man/plot.Rd
View File

@ -33,25 +33,25 @@ scale_colour_mic(keep_operators = "edges", mic_range = NULL, ...)
scale_fill_mic(keep_operators = "edges", mic_range = NULL, ...)
scale_x_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
language = get_AMR_locale(), eucast_I = getOption("AMR_guideline",
"EUCAST") == "EUCAST", ...)
scale_x_sir(colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R
= "#ED553B"), language = get_AMR_locale(),
eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST", ...)
scale_colour_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
language = get_AMR_locale(), eucast_I = getOption("AMR_guideline",
"EUCAST") == "EUCAST", ...)
scale_colour_sir(colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I =
"#F6D55C", R = "#ED553B"), language = get_AMR_locale(),
eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST", ...)
scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
language = get_AMR_locale(), eucast_I = getOption("AMR_guideline",
"EUCAST") == "EUCAST", ...)
scale_fill_sir(colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C",
R = "#ED553B"), language = get_AMR_locale(),
eucast_I = getOption("AMR_guideline", "EUCAST") == "EUCAST", ...)
\method{plot}{mic}(x, mo = NULL, ab = NULL,
guideline = getOption("AMR_guideline", "EUCAST"),
main = deparse(substitute(x)), ylab = translate_AMR("Frequency", language
= language),
xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language =
language), colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
language = get_AMR_locale(), expand = TRUE,
language), colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R
= "#ED553B"), language = get_AMR_locale(), expand = TRUE,
include_PKPD = getOption("AMR_include_PKPD", TRUE),
breakpoint_type = getOption("AMR_breakpoint_type", "human"), ...)
@ -60,8 +60,8 @@ scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
title = deparse(substitute(object)), ylab = translate_AMR("Frequency",
language = language),
xlab = translate_AMR("Minimum Inhibitory Concentration (mg/L)", language =
language), colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
language = get_AMR_locale(), expand = TRUE,
language), colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R
= "#ED553B"), language = get_AMR_locale(), expand = TRUE,
include_PKPD = getOption("AMR_include_PKPD", TRUE),
breakpoint_type = getOption("AMR_breakpoint_type", "human"), ...)
@ -69,8 +69,8 @@ scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
ylab = translate_AMR("Frequency", language = language),
xlab = translate_AMR("Disk diffusion diameter (mm)", language = language),
mo = NULL, ab = NULL, guideline = getOption("AMR_guideline", "EUCAST"),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
language = get_AMR_locale(), expand = TRUE,
colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R =
"#ED553B"), language = get_AMR_locale(), expand = TRUE,
include_PKPD = getOption("AMR_include_PKPD", TRUE),
breakpoint_type = getOption("AMR_breakpoint_type", "human"), ...)
@ -78,8 +78,8 @@ scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
title = deparse(substitute(object)), ylab = translate_AMR("Frequency",
language = language), xlab = translate_AMR("Disk diffusion diameter (mm)",
language = language), guideline = getOption("AMR_guideline", "EUCAST"),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
language = get_AMR_locale(), expand = TRUE,
colours_SIR = c(S = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R =
"#ED553B"), language = get_AMR_locale(), expand = TRUE,
include_PKPD = getOption("AMR_include_PKPD", TRUE),
breakpoint_type = getOption("AMR_breakpoint_type", "human"), ...)
@ -90,8 +90,8 @@ scale_fill_sir(colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
\method{autoplot}{sir}(object, title = deparse(substitute(object)),
xlab = translate_AMR("Antimicrobial Interpretation", language = language),
ylab = translate_AMR("Frequency", language = language),
colours_SIR = c("#3CAEA3", "#F6D55C", "#ED553B"),
ylab = translate_AMR("Frequency", language = language), colours_SIR = c(S
= "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", R = "#ED553B"),
language = get_AMR_locale(), ...)
facet_sir(facet = c("interpretation", "antibiotic"), nrow = NULL)
@ -99,8 +99,8 @@ facet_sir(facet = c("interpretation", "antibiotic"), nrow = NULL)
scale_y_percent(breaks = function(x) seq(0, max(x, na.rm = TRUE), 0.1),
limits = c(0, NA))
scale_sir_colours(..., aesthetics, colours_SIR = c("#3CAEA3", "#F6D55C",
"#ED553B"))
scale_sir_colours(..., aesthetics, colours_SIR = c(S = "#3CAEA3", SDD =
"#8FD6C4", I = "#F6D55C", R = "#ED553B"))
theme_sir()