mirror of
https://github.com/msberends/AMR.git
synced 2025-07-20 00:33:26 +02:00
(v3.0.0.9014) fix plot colours
This commit is contained in:
@ -1,6 +1,6 @@
|
||||
Package: AMR
|
||||
Version: 3.0.0.9012
|
||||
Date: 2025-07-17
|
||||
Version: 3.0.0.9014
|
||||
Date: 2025-07-18
|
||||
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
|
||||
|
||||
2
NEWS.md
2
NEWS.md
@ -1,4 +1,4 @@
|
||||
# AMR 3.0.0.9012
|
||||
# AMR 3.0.0.9014
|
||||
|
||||
This is primarily a bugfix release, though we added one nice feature too.
|
||||
|
||||
|
||||
106
R/plotting.R
106
R/plotting.R
@ -90,6 +90,10 @@
|
||||
#' autoplot(some_mic_values, mo = "Escherichia coli", ab = "cipro")
|
||||
#' }
|
||||
#' if (require("ggplot2")) {
|
||||
#' autoplot(some_mic_values, mo = "Staph aureus", ab = "Ceftaroline", guideline = "CLSI")
|
||||
#' }
|
||||
#'
|
||||
#' if (require("ggplot2")) {
|
||||
#' # support for 27 languages, various guidelines, and many options
|
||||
#' autoplot(some_disk_values,
|
||||
#' mo = "Escherichia coli", ab = "cipro",
|
||||
@ -146,7 +150,7 @@
|
||||
#' aes(group, mic)
|
||||
#' ) +
|
||||
#' geom_boxplot() +
|
||||
#' geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
#' geom_violin(linetype = 2, colour = "grey30", fill = NA) +
|
||||
#' scale_y_mic()
|
||||
#' }
|
||||
#' if (require("ggplot2")) {
|
||||
@ -158,7 +162,7 @@
|
||||
#' aes(group, mic)
|
||||
#' ) +
|
||||
#' geom_boxplot() +
|
||||
#' geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
#' geom_violin(linetype = 2, colour = "grey30", fill = NA) +
|
||||
#' scale_y_mic(mic_range = c(NA, 0.25))
|
||||
#' }
|
||||
#'
|
||||
@ -191,7 +195,7 @@
|
||||
#' aes(x = group, y = mic, colour = sir)
|
||||
#' ) +
|
||||
#' theme_minimal() +
|
||||
#' geom_boxplot(fill = NA, colour = "grey") +
|
||||
#' geom_boxplot(fill = NA, colour = "grey30") +
|
||||
#' geom_jitter(width = 0.25)
|
||||
#'
|
||||
#' plain
|
||||
@ -377,12 +381,7 @@ 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)
|
||||
colours_SIR <- expand_SIR_colours(colours_SIR)
|
||||
|
||||
if (identical(aesthetics, "x")) {
|
||||
ggplot_fn <- ggplot2::scale_x_discrete
|
||||
@ -536,6 +535,7 @@ plot.mic <- function(x,
|
||||
|
||||
x <- as.mic(x) # make sure that currently implemented MIC levels are used
|
||||
main <- gsub(" +", " ", paste0(main, collapse = " "))
|
||||
colours_SIR <- expand_SIR_colours(colours_SIR)
|
||||
|
||||
x <- plotrange_as_table(x, expand = expand)
|
||||
cols_sub <- plot_colours_subtitle_guideline(
|
||||
@ -683,6 +683,8 @@ autoplot.mic <- function(object,
|
||||
title <- gsub(" +", " ", paste0(title, collapse = " "))
|
||||
}
|
||||
|
||||
colours_SIR <- expand_SIR_colours(colours_SIR)
|
||||
|
||||
object <- as.mic(object) # make sure that currently implemented MIC levels are used
|
||||
x <- plotrange_as_table(object, expand = expand)
|
||||
cols_sub <- plot_colours_subtitle_guideline(
|
||||
@ -702,12 +704,14 @@ autoplot.mic <- function(object,
|
||||
colnames(df) <- c("mic", "count")
|
||||
df$cols <- cols_sub$cols
|
||||
df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible"
|
||||
df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
|
||||
df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
|
||||
df$cols[df$cols == colours_SIR[2]] <- "(SDD) Susceptible dose-dependent"
|
||||
df$cols[df$cols == colours_SIR[3]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
|
||||
df$cols[df$cols == colours_SIR[4]] <- "(R) Resistant"
|
||||
df$cols <- factor(translate_into_language(df$cols, language = language),
|
||||
levels = translate_into_language(
|
||||
c(
|
||||
"(S) Susceptible",
|
||||
"(SDD) Susceptible dose-dependent",
|
||||
paste("(I)", plot_name_of_I(cols_sub$guideline)),
|
||||
"(R) Resistant"
|
||||
),
|
||||
@ -721,10 +725,10 @@ autoplot.mic <- function(object,
|
||||
vals <- c(
|
||||
"(S) Susceptible" = colours_SIR[1],
|
||||
"(SDD) Susceptible dose-dependent" = colours_SIR[2],
|
||||
"(I) Susceptible, incr. exp." = colours_SIR[2],
|
||||
"(I) Intermediate" = colours_SIR[2],
|
||||
"(R) Resistant" = colours_SIR[3],
|
||||
"(NI) Non-interpretable" = "grey"
|
||||
"(I) Susceptible, incr. exp." = colours_SIR[3],
|
||||
"(I) Intermediate" = colours_SIR[3],
|
||||
"(R) Resistant" = colours_SIR[4],
|
||||
"(NI) Non-interpretable" = "grey30"
|
||||
)
|
||||
names(vals) <- translate_into_language(names(vals), language = language)
|
||||
p <- p +
|
||||
@ -790,6 +794,7 @@ plot.disk <- function(x,
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
main <- gsub(" +", " ", paste0(main, collapse = " "))
|
||||
colours_SIR <- expand_SIR_colours(colours_SIR)
|
||||
|
||||
x <- plotrange_as_table(x, expand = expand)
|
||||
cols_sub <- plot_colours_subtitle_guideline(
|
||||
@ -935,6 +940,8 @@ autoplot.disk <- function(object,
|
||||
title <- gsub(" +", " ", paste0(title, collapse = " "))
|
||||
}
|
||||
|
||||
colours_SIR <- expand_SIR_colours(colours_SIR)
|
||||
|
||||
x <- plotrange_as_table(object, expand = expand)
|
||||
cols_sub <- plot_colours_subtitle_guideline(
|
||||
x = x,
|
||||
@ -952,10 +959,10 @@ autoplot.disk <- function(object,
|
||||
df <- as.data.frame(x, stringsAsFactors = TRUE)
|
||||
colnames(df) <- c("disk", "count")
|
||||
df$cols <- cols_sub$cols
|
||||
|
||||
df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible"
|
||||
df$cols[df$cols == colours_SIR[2]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
|
||||
df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant"
|
||||
df$cols[df$cols == colours_SIR[2]] <- "(SDD) Susceptible dose-dependent"
|
||||
df$cols[df$cols == colours_SIR[3]] <- paste("(I)", plot_name_of_I(cols_sub$guideline))
|
||||
df$cols[df$cols == colours_SIR[4]] <- "(R) Resistant"
|
||||
df$cols <- factor(translate_into_language(df$cols, language = language),
|
||||
levels = translate_into_language(
|
||||
c(
|
||||
@ -973,10 +980,10 @@ autoplot.disk <- function(object,
|
||||
vals <- c(
|
||||
"(S) Susceptible" = colours_SIR[1],
|
||||
"(SDD) Susceptible dose-dependent" = colours_SIR[2],
|
||||
"(I) Susceptible, incr. exp." = colours_SIR[2],
|
||||
"(I) Intermediate" = colours_SIR[2],
|
||||
"(R) Resistant" = colours_SIR[3],
|
||||
"(NI) Non-interpretable" = "grey"
|
||||
"(I) Susceptible, incr. exp." = colours_SIR[3],
|
||||
"(I) Intermediate" = colours_SIR[3],
|
||||
"(R) Resistant" = colours_SIR[4],
|
||||
"(NI) Non-interpretable" = "grey30"
|
||||
)
|
||||
names(vals) <- translate_into_language(names(vals), language = language)
|
||||
p <- p +
|
||||
@ -1093,12 +1100,7 @@ barplot.sir <- function(height,
|
||||
language <- validate_language(language)
|
||||
meet_criteria(expand, allow_class = "logical", has_length = 1)
|
||||
|
||||
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)
|
||||
colours_SIR <- expand_SIR_colours(colours_SIR)
|
||||
|
||||
# add SDD and N to colours
|
||||
colours_SIR <- c(colours_SIR, "grey30")
|
||||
@ -1148,12 +1150,7 @@ autoplot.sir <- function(object,
|
||||
title <- gsub(" +", " ", paste0(title, collapse = " "))
|
||||
}
|
||||
|
||||
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)
|
||||
colours_SIR <- expand_SIR_colours(colours_SIR)
|
||||
|
||||
df <- as.data.frame(table(object), stringsAsFactors = TRUE)
|
||||
colnames(df) <- c("x", "n")
|
||||
@ -1252,13 +1249,6 @@ 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
|
||||
@ -1382,11 +1372,7 @@ scale_sir_colours <- function(...,
|
||||
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])
|
||||
}
|
||||
colours_SIR <- expand_SIR_colours(colours_SIR, unname = FALSE)
|
||||
|
||||
# behaviour when coming from ggplot_sir()
|
||||
if ("colours" %in% names(list(...))) {
|
||||
@ -1502,3 +1488,31 @@ labels_sir_count <- function(position = NULL,
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
expand_SIR_colours <- function(colours_SIR, unname = TRUE) {
|
||||
sir_order <- c("S", "SDD", "I", "R")
|
||||
|
||||
if (is.null(names(colours_SIR))) {
|
||||
if (length(colours_SIR) == 1) {
|
||||
colours_SIR <- rep(colours_SIR, 4)
|
||||
} else if (length(colours_SIR) == 3) {
|
||||
# old method for AMR < 3.0.1 which allowed for 3 colours
|
||||
# fill in green for SDD as extra colour
|
||||
colours_SIR <- c(colours_SIR[1], colours_SIR[1], colours_SIR[2], colours_SIR[3])
|
||||
}
|
||||
names(colours_SIR) <- sir_order
|
||||
} else {
|
||||
# named input: match and reorder
|
||||
stop_ifnot(
|
||||
all(names(colours_SIR) %in% sir_order),
|
||||
"Unknown names in `colours_SIR`. Expected any of: ", vector_or(sir_order, quotes = FALSE, sort = FALSE), "."
|
||||
)
|
||||
colours_SIR <- colours_SIR[sir_order]
|
||||
}
|
||||
|
||||
if (unname) {
|
||||
colours_SIR <- unname(colours_SIR)
|
||||
}
|
||||
|
||||
return(colours_SIR)
|
||||
}
|
||||
|
||||
@ -133,7 +133,7 @@ ggplot(data.frame(mic = some_mic_values,
|
||||
sir = interpretation),
|
||||
aes(x = group, y = mic, colour = sir)) +
|
||||
theme_minimal() +
|
||||
geom_boxplot(fill = NA, colour = "grey") +
|
||||
geom_boxplot(fill = NA, colour = "grey30") +
|
||||
geom_jitter(width = 0.25) +
|
||||
|
||||
# NEW scale function: plot MIC values to x, y, colour or fill
|
||||
|
||||
22
index.md
22
index.md
@ -171,14 +171,14 @@ example_isolates %>%
|
||||
select(bacteria,
|
||||
aminoglycosides(),
|
||||
carbapenems())
|
||||
#> ℹ Using column 'mo' as input for mo_fullname()
|
||||
#> ℹ Using column 'mo' as input for mo_is_gram_negative()
|
||||
#> ℹ Using column 'mo' as input for mo_is_intrinsic_resistant()
|
||||
#> ℹ Using column 'mo' as input for `mo_fullname()`
|
||||
#> ℹ Using column 'mo' as input for `mo_is_gram_negative()`
|
||||
#> ℹ Using column 'mo' as input for `mo_is_intrinsic_resistant()`
|
||||
#> ℹ Determining intrinsic resistance based on 'EUCAST Expected Resistant
|
||||
#> Phenotypes' v1.2 (2023). This note will be shown once per session.
|
||||
#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB'
|
||||
#> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
|
||||
#> (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin)
|
||||
#> ℹ For carbapenems() using columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||
#> ℹ For `carbapenems()` using columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||
#> # A tibble: 35 × 7
|
||||
#> bacteria GEN TOB AMK KAN IPM MEM
|
||||
#> <chr> <sir> <sir> <sir> <sir> <sir> <sir>
|
||||
@ -215,9 +215,9 @@ output format automatically (such as markdown, LaTeX, HTML, etc.).
|
||||
``` r
|
||||
antibiogram(example_isolates,
|
||||
antimicrobials = c(aminoglycosides(), carbapenems()))
|
||||
#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB'
|
||||
#> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
|
||||
#> (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin)
|
||||
#> ℹ For carbapenems() using columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||
#> ℹ For `carbapenems()` using columns 'IPM' (imipenem) and 'MEM' (meropenem)
|
||||
```
|
||||
|
||||
| Pathogen | Amikacin | Gentamicin | Imipenem | Kanamycin | Meropenem | Tobramycin |
|
||||
@ -289,7 +289,7 @@ ggplot(data.frame(mic = some_mic_values,
|
||||
sir = interpretation),
|
||||
aes(x = group, y = mic, colour = sir)) +
|
||||
theme_minimal() +
|
||||
geom_boxplot(fill = NA, colour = "grey") +
|
||||
geom_boxplot(fill = NA, colour = "grey30") +
|
||||
geom_jitter(width = 0.25) +
|
||||
|
||||
# NEW scale function: plot MIC values to x, y, colour or fill
|
||||
@ -340,15 +340,15 @@ out <- example_isolates %>%
|
||||
# calculate AMR using resistance(), over all aminoglycosides and polymyxins:
|
||||
summarise(across(c(aminoglycosides(), polymyxins()),
|
||||
resistance))
|
||||
#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB'
|
||||
#> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
|
||||
#> (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin)
|
||||
#> ℹ For polymyxins() using column 'COL' (colistin)
|
||||
#> ℹ For `polymyxins()` using column 'COL' (colistin)
|
||||
#> Warning: There was 1 warning in `summarise()`.
|
||||
#> ℹ In argument: `across(c(aminoglycosides(), polymyxins()), resistance)`.
|
||||
#> ℹ In group 3: `ward = "Outpatient"`.
|
||||
#> Caused by warning:
|
||||
#> ! Introducing NA: only 23 results available for KAN in group: ward =
|
||||
#> "Outpatient" (minimum = 30).
|
||||
#> "Outpatient" (`minimum` = 30).
|
||||
out
|
||||
#> # A tibble: 3 × 6
|
||||
#> ward GEN TOB AMK KAN COL
|
||||
|
||||
10
man/plot.Rd
10
man/plot.Rd
@ -210,6 +210,10 @@ if (require("ggplot2")) {
|
||||
# when providing the microorganism and antibiotic, colours will show interpretations:
|
||||
autoplot(some_mic_values, mo = "Escherichia coli", ab = "cipro")
|
||||
}
|
||||
if (require("ggplot2")) {
|
||||
autoplot(some_mic_values, mo = "Staph aureus", ab = "Ceftaroline", guideline = "CLSI")
|
||||
}
|
||||
|
||||
if (require("ggplot2")) {
|
||||
# support for 27 languages, various guidelines, and many options
|
||||
autoplot(some_disk_values,
|
||||
@ -267,7 +271,7 @@ if (require("ggplot2")) {
|
||||
aes(group, mic)
|
||||
) +
|
||||
geom_boxplot() +
|
||||
geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
geom_violin(linetype = 2, colour = "grey30", fill = NA) +
|
||||
scale_y_mic()
|
||||
}
|
||||
if (require("ggplot2")) {
|
||||
@ -279,7 +283,7 @@ if (require("ggplot2")) {
|
||||
aes(group, mic)
|
||||
) +
|
||||
geom_boxplot() +
|
||||
geom_violin(linetype = 2, colour = "grey", fill = NA) +
|
||||
geom_violin(linetype = 2, colour = "grey30", fill = NA) +
|
||||
scale_y_mic(mic_range = c(NA, 0.25))
|
||||
}
|
||||
|
||||
@ -312,7 +316,7 @@ if (require("ggplot2")) {
|
||||
aes(x = group, y = mic, colour = sir)
|
||||
) +
|
||||
theme_minimal() +
|
||||
geom_boxplot(fill = NA, colour = "grey") +
|
||||
geom_boxplot(fill = NA, colour = "grey30") +
|
||||
geom_jitter(width = 0.25)
|
||||
|
||||
plain
|
||||
|
||||
@ -190,6 +190,15 @@ this shows on top of every sidebar to the right
|
||||
}
|
||||
}
|
||||
|
||||
.template-reference-topic h3,
|
||||
.template-reference-topic h3 code {
|
||||
color: var(--amr-green-dark) !important;
|
||||
}
|
||||
.template-reference-topic h3 {
|
||||
font-weight: normal;
|
||||
margin-top: 2rem;
|
||||
}
|
||||
|
||||
/* replace 'Developers' with 'Maintainers' */
|
||||
.developers h2 {
|
||||
display: none;
|
||||
|
||||
Reference in New Issue
Block a user