P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-21 17:33:14 +02:00
Code Releases Activity

(v3.0.0.9014) fix plot colours

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-07-18 15:57:48 +02:00
parent 8da0f525b5
commit 49274f010b
7 changed files with 91 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
DESCRIPTION
View File

@ -1,6 +1,6 @@
Package: AMR Package: AMR
Version: 3.0.0.9012 Version: 3.0.0.9014
Date: 2025-07-17 Date: 2025-07-18
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)
data analysis and to work with microbial and antimicrobial properties by data analysis and to work with microbial and antimicrobial properties by

2
NEWS.md
View File

@ -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. This is primarily a bugfix release, though we added one nice feature too.

106
R/plotting.R
View File

@ -90,6 +90,10 @@
#' autoplot(some_mic_values, mo = "Escherichia coli", ab = "cipro") #' autoplot(some_mic_values, mo = "Escherichia coli", ab = "cipro")
#' } #' }
#' if (require("ggplot2")) { #' 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 #' # support for 27 languages, various guidelines, and many options
#' autoplot(some_disk_values, #' autoplot(some_disk_values,
#' mo = "Escherichia coli", ab = "cipro", #' mo = "Escherichia coli", ab = "cipro",
@ -146,7 +150,7 @@
#' aes(group, mic) #' aes(group, mic)
#' ) + #' ) +
#' geom_boxplot() + #' geom_boxplot() +
#' geom_violin(linetype = 2, colour = "grey", fill = NA) + #' geom_violin(linetype = 2, colour = "grey30", fill = NA) +
#' scale_y_mic() #' scale_y_mic()
#' } #' }
#' if (require("ggplot2")) { #' if (require("ggplot2")) {
@ -158,7 +162,7 @@
#' aes(group, mic) #' aes(group, mic)
#' ) + #' ) +
#' geom_boxplot() + #' 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)) #' scale_y_mic(mic_range = c(NA, 0.25))
#' } #' }
#' #'
@ -191,7 +195,7 @@
#' aes(x = group, y = mic, colour = sir) #' aes(x = group, y = mic, colour = sir)
#' ) + #' ) +
#' theme_minimal() + #' theme_minimal() +
#' geom_boxplot(fill = NA, colour = "grey") + #' geom_boxplot(fill = NA, colour = "grey30") +
#' geom_jitter(width = 0.25) #' geom_jitter(width = 0.25)
#' #'
#' plain #' plain
@ -377,12 +381,7 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
args <- list(...) args <- list(...)
args[c("value", "labels", "limits")] <- NULL args[c("value", "labels", "limits")] <- NULL
if (length(colours_SIR) == 1) { colours_SIR <- expand_SIR_colours(colours_SIR)
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")) { if (identical(aesthetics, "x")) {
ggplot_fn <- ggplot2::scale_x_discrete 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 x <- as.mic(x) # make sure that currently implemented MIC levels are used
main <- gsub(" +", " ", paste0(main, collapse = " ")) main <- gsub(" +", " ", paste0(main, collapse = " "))
colours_SIR <- expand_SIR_colours(colours_SIR)
x <- plotrange_as_table(x, expand = expand) x <- plotrange_as_table(x, expand = expand)
cols_sub <- plot_colours_subtitle_guideline( cols_sub <- plot_colours_subtitle_guideline(
@ -683,6 +683,8 @@ autoplot.mic <- function(object,
title <- gsub(" +", " ", paste0(title, collapse = " ")) 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 object <- as.mic(object) # make sure that currently implemented MIC levels are used
x <- plotrange_as_table(object, expand = expand) x <- plotrange_as_table(object, expand = expand)
cols_sub <- plot_colours_subtitle_guideline( cols_sub <- plot_colours_subtitle_guideline(
@ -702,12 +704,14 @@ autoplot.mic <- function(object,
colnames(df) <- c("mic", "count") colnames(df) <- c("mic", "count")
df$cols <- cols_sub$cols df$cols <- cols_sub$cols
df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible" 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[2]] <- "(SDD) Susceptible dose-dependent"
df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant" 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), df$cols <- factor(translate_into_language(df$cols, language = language),
levels = translate_into_language( levels = translate_into_language(
c( c(
"(S) Susceptible", "(S) Susceptible",
"(SDD) Susceptible dose-dependent",
paste("(I)", plot_name_of_I(cols_sub$guideline)), paste("(I)", plot_name_of_I(cols_sub$guideline)),
"(R) Resistant" "(R) Resistant"
), ),
@ -721,10 +725,10 @@ autoplot.mic <- function(object,
vals <- c( vals <- c(
"(S) Susceptible" = colours_SIR[1], "(S) Susceptible" = colours_SIR[1],
"(SDD) Susceptible dose-dependent" = colours_SIR[2], "(SDD) Susceptible dose-dependent" = colours_SIR[2],
"(I) Susceptible, incr. exp." = colours_SIR[2], "(I) Susceptible, incr. exp." = colours_SIR[3],
"(I) Intermediate" = colours_SIR[2], "(I) Intermediate" = colours_SIR[3],
"(R) Resistant" = colours_SIR[3], "(R) Resistant" = colours_SIR[4],
"(NI) Non-interpretable" = "grey" "(NI) Non-interpretable" = "grey30"
) )
names(vals) <- translate_into_language(names(vals), language = language) names(vals) <- translate_into_language(names(vals), language = language)
p <- p + p <- p +
@ -790,6 +794,7 @@ plot.disk <- function(x,
meet_criteria(expand, allow_class = "logical", has_length = 1) meet_criteria(expand, allow_class = "logical", has_length = 1)
main <- gsub(" +", " ", paste0(main, collapse = " ")) main <- gsub(" +", " ", paste0(main, collapse = " "))
colours_SIR <- expand_SIR_colours(colours_SIR)
x <- plotrange_as_table(x, expand = expand) x <- plotrange_as_table(x, expand = expand)
cols_sub <- plot_colours_subtitle_guideline( cols_sub <- plot_colours_subtitle_guideline(
@ -935,6 +940,8 @@ autoplot.disk <- function(object,
title <- gsub(" +", " ", paste0(title, collapse = " ")) title <- gsub(" +", " ", paste0(title, collapse = " "))
} }
colours_SIR <- expand_SIR_colours(colours_SIR)
x <- plotrange_as_table(object, expand = expand) x <- plotrange_as_table(object, expand = expand)
cols_sub <- plot_colours_subtitle_guideline( cols_sub <- plot_colours_subtitle_guideline(
x = x, x = x,
@ -952,10 +959,10 @@ autoplot.disk <- function(object,
df <- as.data.frame(x, stringsAsFactors = TRUE) df <- as.data.frame(x, stringsAsFactors = TRUE)
colnames(df) <- c("disk", "count") colnames(df) <- c("disk", "count")
df$cols <- cols_sub$cols df$cols <- cols_sub$cols
df$cols[df$cols == colours_SIR[1]] <- "(S) Susceptible" 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[2]] <- "(SDD) Susceptible dose-dependent"
df$cols[df$cols == colours_SIR[3]] <- "(R) Resistant" 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), df$cols <- factor(translate_into_language(df$cols, language = language),
levels = translate_into_language( levels = translate_into_language(
c( c(
@ -973,10 +980,10 @@ autoplot.disk <- function(object,
vals <- c( vals <- c(
"(S) Susceptible" = colours_SIR[1], "(S) Susceptible" = colours_SIR[1],
"(SDD) Susceptible dose-dependent" = colours_SIR[2], "(SDD) Susceptible dose-dependent" = colours_SIR[2],
"(I) Susceptible, incr. exp." = colours_SIR[2], "(I) Susceptible, incr. exp." = colours_SIR[3],
"(I) Intermediate" = colours_SIR[2], "(I) Intermediate" = colours_SIR[3],
"(R) Resistant" = colours_SIR[3], "(R) Resistant" = colours_SIR[4],
"(NI) Non-interpretable" = "grey" "(NI) Non-interpretable" = "grey30"
) )
names(vals) <- translate_into_language(names(vals), language = language) names(vals) <- translate_into_language(names(vals), language = language)
p <- p + p <- p +
@ -1093,12 +1100,7 @@ barplot.sir <- function(height,
language <- validate_language(language) language <- validate_language(language)
meet_criteria(expand, allow_class = "logical", has_length = 1) meet_criteria(expand, allow_class = "logical", has_length = 1)
if (length(colours_SIR) == 1) { colours_SIR <- expand_SIR_colours(colours_SIR)
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 # add SDD and N to colours
colours_SIR <- c(colours_SIR, "grey30") colours_SIR <- c(colours_SIR, "grey30")
@ -1148,12 +1150,7 @@ autoplot.sir <- function(object,
title <- gsub(" +", " ", paste0(title, collapse = " ")) title <- gsub(" +", " ", paste0(title, collapse = " "))
} }
if (length(colours_SIR) == 1) { colours_SIR <- expand_SIR_colours(colours_SIR)
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) df <- as.data.frame(table(object), stringsAsFactors = TRUE)
colnames(df) <- c("x", "n") 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) 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 # store previous interpretations to backup
sir_history <- AMR_env$sir_interpretation_history sir_history <- AMR_env$sir_interpretation_history
# and clear previous interpretations # and clear previous interpretations
@ -1382,11 +1372,7 @@ scale_sir_colours <- function(...,
colours_SIR <- list(...)$colours colours_SIR <- list(...)$colours
} }
if (length(colours_SIR) == 1) { colours_SIR <- expand_SIR_colours(colours_SIR, unname = FALSE)
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() # behaviour when coming from ggplot_sir()
if ("colours" %in% names(list(...))) { 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)
}

2
index.Rmd
View File

@ -133,7 +133,7 @@ ggplot(data.frame(mic = some_mic_values,
sir = interpretation), sir = interpretation),
aes(x = group, y = mic, colour = sir)) + aes(x = group, y = mic, colour = sir)) +
theme_minimal() + theme_minimal() +
geom_boxplot(fill = NA, colour = "grey") + geom_boxplot(fill = NA, colour = "grey30") +
geom_jitter(width = 0.25) + geom_jitter(width = 0.25) +
# NEW scale function: plot MIC values to x, y, colour or fill # NEW scale function: plot MIC values to x, y, colour or fill

22
index.md
View File

@ -171,14 +171,14 @@ example_isolates %>%
select(bacteria, select(bacteria,
aminoglycosides(), aminoglycosides(),
carbapenems()) carbapenems())
#> ℹ Using column 'mo' as input for mo_fullname() #> ℹ 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_gram_negative()`
#> ℹ Using column 'mo' as input for mo_is_intrinsic_resistant() #> ℹ Using column 'mo' as input for `mo_is_intrinsic_resistant()`
#> ℹ Determining intrinsic resistance based on 'EUCAST Expected Resistant #> ℹ Determining intrinsic resistance based on 'EUCAST Expected Resistant
#> Phenotypes' v1.2 (2023). This note will be shown once per session. #> 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) #> (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 #> # A tibble: 35 × 7
#> bacteria GEN TOB AMK KAN IPM MEM #> bacteria GEN TOB AMK KAN IPM MEM
#> <chr> <sir> <sir> <sir> <sir> <sir> <sir> #> <chr> <sir> <sir> <sir> <sir> <sir> <sir>
@ -215,9 +215,9 @@ output format automatically (such as markdown, LaTeX, HTML, etc.).
``` r ``` r
antibiogram(example_isolates, antibiogram(example_isolates,
antimicrobials = c(aminoglycosides(), carbapenems())) antimicrobials = c(aminoglycosides(), carbapenems()))
#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB' #> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
#> (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin) #> (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 | | Pathogen | Amikacin | Gentamicin | Imipenem | Kanamycin | Meropenem | Tobramycin |
@ -289,7 +289,7 @@ ggplot(data.frame(mic = some_mic_values,
sir = interpretation), sir = interpretation),
aes(x = group, y = mic, colour = sir)) + aes(x = group, y = mic, colour = sir)) +
theme_minimal() + theme_minimal() +
geom_boxplot(fill = NA, colour = "grey") + geom_boxplot(fill = NA, colour = "grey30") +
geom_jitter(width = 0.25) + geom_jitter(width = 0.25) +
# NEW scale function: plot MIC values to x, y, colour or fill # 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: # calculate AMR using resistance(), over all aminoglycosides and polymyxins:
summarise(across(c(aminoglycosides(), polymyxins()), summarise(across(c(aminoglycosides(), polymyxins()),
resistance)) resistance))
#> ℹ For aminoglycosides() using columns 'GEN' (gentamicin), 'TOB' #> ℹ For `aminoglycosides()` using columns 'GEN' (gentamicin), 'TOB'
#> (tobramycin), 'AMK' (amikacin), and 'KAN' (kanamycin) #> (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()`. #> Warning: There was 1 warning in `summarise()`.
#> ℹ In argument: `across(c(aminoglycosides(), polymyxins()), resistance)`. #> ℹ In argument: `across(c(aminoglycosides(), polymyxins()), resistance)`.
#> ℹ In group 3: `ward = "Outpatient"`. #> ℹ In group 3: `ward = "Outpatient"`.
#> Caused by warning: #> Caused by warning:
#> ! Introducing NA: only 23 results available for KAN in group: ward = #> ! Introducing NA: only 23 results available for KAN in group: ward =
#> "Outpatient" (minimum = 30). #> "Outpatient" (`minimum` = 30).
out out
#> # A tibble: 3 × 6 #> # A tibble: 3 × 6
#> ward GEN TOB AMK KAN COL #> ward GEN TOB AMK KAN COL

10
man/plot.Rd
View File

@ -210,6 +210,10 @@ if (require("ggplot2")) {
# when providing the microorganism and antibiotic, colours will show interpretations: # when providing the microorganism and antibiotic, colours will show interpretations:
autoplot(some_mic_values, mo = "Escherichia coli", ab = "cipro") 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")) { if (require("ggplot2")) {
# support for 27 languages, various guidelines, and many options # support for 27 languages, various guidelines, and many options
autoplot(some_disk_values, autoplot(some_disk_values,
@ -267,7 +271,7 @@ if (require("ggplot2")) {
aes(group, mic) aes(group, mic)
) + ) +
geom_boxplot() + geom_boxplot() +
geom_violin(linetype = 2, colour = "grey", fill = NA) + geom_violin(linetype = 2, colour = "grey30", fill = NA) +
scale_y_mic() scale_y_mic()
} }
if (require("ggplot2")) { if (require("ggplot2")) {
@ -279,7 +283,7 @@ if (require("ggplot2")) {
aes(group, mic) aes(group, mic)
) + ) +
geom_boxplot() + 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)) scale_y_mic(mic_range = c(NA, 0.25))
} }
@ -312,7 +316,7 @@ if (require("ggplot2")) {
aes(x = group, y = mic, colour = sir) aes(x = group, y = mic, colour = sir)
) + ) +
theme_minimal() + theme_minimal() +
geom_boxplot(fill = NA, colour = "grey") + geom_boxplot(fill = NA, colour = "grey30") +
geom_jitter(width = 0.25) geom_jitter(width = 0.25)
plain plain

9
pkgdown/extra.css
View File

@ -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' */ /* replace 'Developers' with 'Maintainers' */
.developers h2 { .developers h2 {
display: none; display: none;