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

(v3.0.0.9016) fix for plotting

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2025-07-23 22:05:20 +02:00
parent 6cb724a208
commit 2f866985c9
3 changed files with 21 additions and 16 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.9015 Version: 3.0.0.9016
Date: 2025-07-19 Date: 2025-07-23
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.9015 # AMR 3.0.0.9016
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.

31
R/plotting.R
View File

@ -381,7 +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
colours_SIR <- expand_SIR_colours(colours_SIR) colours_SIR <- expand_SIR_colours(colours_SIR, unname = FALSE)
if (identical(aesthetics, "x")) { if (identical(aesthetics, "x")) {
ggplot_fn <- ggplot2::scale_x_discrete ggplot_fn <- ggplot2::scale_x_discrete
@ -391,24 +391,19 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
args, args,
list( list(
aesthetics = aesthetics, aesthetics = aesthetics,
values = c( values = c(colours_SIR, NI = "grey30")
S = colours_SIR[1],
SDD = colours_SIR[2],
I = colours_SIR[3],
R = colours_SIR[4],
NI = "grey30"
)
) )
) )
} }
scale <- do.call(ggplot_fn, args) scale <- do.call(ggplot_fn, args)
scale$labels <- function(x) { scale$labels <- function(x) {
stop_ifnot(all(x %in% c(levels(NA_sir_), NA)), stop_ifnot(all(x %in% c(levels(NA_sir_), "SI", "IR", NA)),
"Apply `scale_", aesthetics[1], "_sir()` to a variable of class 'sir', see `?as.sir`.", "Apply `scale_", aesthetics[1], "_sir()` to a variable of class 'sir', see `?as.sir`.",
call = FALSE call = FALSE
) )
x <- as.character(as.sir(x)) x <- as.character(x)
x[!x %in% c("SI", "IR")] <- as.character(as.sir(x[!x %in% c("SI", "IR")]))
if (!is.null(language)) { if (!is.null(language)) {
x[x == "S"] <- "(S) Susceptible" x[x == "S"] <- "(S) Susceptible"
x[x == "SDD"] <- "(SDD) Susceptible dose-dependent" x[x == "SDD"] <- "(SDD) Susceptible dose-dependent"
@ -418,6 +413,8 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
x[x == "I"] <- "(I) Intermediate" x[x == "I"] <- "(I) Intermediate"
} }
x[x == "R"] <- "(R) Resistant" x[x == "R"] <- "(R) Resistant"
x[x == "SI"] <- "(S/I) Susceptible"
x[x == "IR"] <- "(I/R) Non-susceptible"
x[x == "NI"] <- "(NI) Non-interpretable" x[x == "NI"] <- "(NI) Non-interpretable"
x <- translate_AMR(x, language = language) x <- translate_AMR(x, language = language)
} }
@ -425,7 +422,7 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
} }
scale$limits <- function(x, ...) { scale$limits <- function(x, ...) {
# force SIR in the right order # force SIR in the right order
as.character(sort(factor(x, levels = levels(NA_sir_)))) as.character(sort(factor(x, levels = c(levels(NA_sir_), "SI", "IR"))))
} }
scale scale
@ -1490,7 +1487,7 @@ labels_sir_count <- function(position = NULL,
} }
expand_SIR_colours <- function(colours_SIR, unname = TRUE) { expand_SIR_colours <- function(colours_SIR, unname = TRUE) {
sir_order <- c("S", "SDD", "SI", "I", "IR", "R") sir_order <- c("S", "SDD", "I", "R", "SI", "IR")
if (is.null(names(colours_SIR))) { if (is.null(names(colours_SIR))) {
if (length(colours_SIR) == 1) { if (length(colours_SIR) == 1) {
@ -1500,13 +1497,21 @@ expand_SIR_colours <- function(colours_SIR, unname = TRUE) {
# fill in green for SDD as extra colour # fill in green for SDD as extra colour
colours_SIR <- c(colours_SIR[1], colours_SIR[1], colours_SIR[2], colours_SIR[3]) colours_SIR <- c(colours_SIR[1], colours_SIR[1], colours_SIR[2], colours_SIR[3])
} }
if (length(colours_SIR) == 4) {
# add colours for SI (same as S) and IR (same as R)
colours_SIR <- c(colours_SIR[1:4], colours_SIR[1], colours_SIR[4])
}
names(colours_SIR) <- sir_order names(colours_SIR) <- sir_order
} else { } else {
# named input: match and reorder # named input: match and reorder
stop_ifnot( stop_ifnot(
all(names(colours_SIR) %in% sir_order), all(names(colours_SIR) %in% sir_order),
"Unknown names in `colours_SIR`. Expected any of: ", vector_or(sir_order, quotes = FALSE, sort = FALSE), "." "Unknown names in `colours_SIR`. Expected any of: ", vector_or(levels(NA_sir_), quotes = FALSE, sort = FALSE), "."
) )
if (length(colours_SIR) == 4) {
# add colours for SI (same as S) and IR (same as R)
colours_SIR <- c(colours_SIR[1:4], SI = unname(colours_SIR[1]), IR = unname(colours_SIR[4]))
}
colours_SIR <- colours_SIR[sir_order] colours_SIR <- colours_SIR[sir_order]
} }