diff --git a/DESCRIPTION b/DESCRIPTION index 1ec15635c..a81294019 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: AMR -Version: 3.1.0.9020 +Version: 3.1.0.9021 Date: 2026-11-09 Title: Antimicrobial Resistance Data Analysis Description: Functions to simplify and standardise antimicrobial resistance (AMR) diff --git a/NEWS.md b/NEWS.md index 4f2728e22..7e685bc53 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# AMR 3.1.0.9020 +# AMR 3.1.0.9021 This version fixes a critical bug in WISCA that biased all coverage estimates of `wisca()` and `antibiogram(..., wisca = TRUE)` downwards since AMR 3.0.0. Users are strongly advised to re-run their WISCA analyses. @@ -44,8 +44,9 @@ It also adds a `site` argument to `as.sir()`, stores EUCAST MIC breakpoints exac * Fixed punctuation being italicised along with taxonomic names, e.g., `"(S. aureus)"` now gives `"(*S. aureus*)"` instead of `"(S. *aureus)*"` * `NA` values now return `NA` instead of `"NA"` * Taxonomic names are now looked up once per session, making the function considerably faster for long vectors -* `labels_sir_count()` and `ggplot_sir()` +* `ggplot_sir()`, `geom_sir()` and `labels_sir_count()` * Fixed the data labels being placed on the wrong bars with `position = "dodge"` or `position = "stack"`. They are now grouped like the bars, using the new `fill` argument of `labels_sir_count()`, which `ggplot_sir()` sets automatically + * If the interpretation is not shown in the plot, e.g., with `fill = "species"`, only the susceptible proportion is now plotted, following the guideline: S+SDD+I for EUCAST, S+SDD for CLSI, and S with `guideline = NULL`. Previously, the bars of all interpretations were drawn on top of each other. The y axis title of `ggplot_sir()` then states the category, e.g., "Proportion SI" * `ggplot_pca()` * Fixed an error when setting `groups` together with `labels`, and setting `groups` without `labels` now colours the points by these groups instead of using them as labels, as documented * *Morganella* is interpreted as reported, with the breakpoints of Enterobacterales or Morganellaceae and not of *M. morganii*, which is now tested (#330) diff --git a/R/ggplot_sir.R b/R/ggplot_sir.R index 7452bf9bf..3bfa9598a 100755 --- a/R/ggplot_sir.R +++ b/R/ggplot_sir.R @@ -33,7 +33,7 @@ #' @param data A [data.frame] with column(s) of class [`sir`] (see [as.sir()]). #' @param position Position adjustment of bars, either `"fill"`, `"stack"` or `"dodge"`. #' @param x Variable to show on x axis, either `"antibiotic"` (default) or `"interpretation"` or a grouping variable. -#' @param fill Variable to categorise using the plots legend, either `"interpretation"` (default) or `"antibiotic"` or a grouping variable. For [labels_sir_count()], this must be the same as the `fill` of [geom_sir()], so that the labels are placed on the right bars. +#' @param fill Variable to categorise using the plots legend, either `"interpretation"` (default) or `"antibiotic"` or a grouping variable. For [labels_sir_count()], this must be the same as the `fill` of [geom_sir()], so that the labels are placed on the right bars. If the interpretation is not shown in the plot (i.e., neither in `x`, `fill`, nor `facet`), only the susceptible proportion is plotted, which follows the guideline (see `guideline`): S+SDD+I for EUCAST, S+SDD for CLSI, and S if `guideline = NULL`. #' @param breaks A [numeric] vector of positions. #' @param limits A [numeric] vector of length two providing limits of the scale, use `NA` to refer to the existing minimum or maximum. #' @param facet Variable to split plots by, either `"interpretation"` (default) or `"antibiotic"` or a grouping variable. @@ -241,8 +241,8 @@ ggplot_sir <- function(data, } p <- ggplot2::ggplot(data = data) + - geom_sir( - position = position, x = x, fill = fill, translate_ab = translate_ab, + create_geom_sir( + position = position, x = x, fill = fill, facet = facet, translate_ab = translate_ab, minimum = minimum, language = language, guideline = guideline, ... ) + @@ -258,10 +258,11 @@ ggplot_sir <- function(data, } if (datalabels == TRUE) { - p <- p + labels_sir_count( + p <- p + create_labels_sir_count( position = position, x = x, fill = fill, + facet = facet, translate_ab = translate_ab, minimum = minimum, language = language, @@ -284,6 +285,17 @@ ggplot_sir <- function(data, p <- p + do.call(facet_sir, list(facet = facet, nrow = nrow)) } + if (missing(y.title) && !"interpretation" %in% c(normalise_sir_plot_var(x), normalise_sir_plot_var(fill), normalise_sir_plot_var(facet))) { + # only the susceptible proportion is shown, e.g. "Proportion SI" for EUCAST + susceptible <- tryCatch( + levels(sir_df(data = data, translate_ab = translate_ab, language = language, minimum = minimum, guideline = guideline)$interpretation)[1], + error = function(e) NULL + ) + if (!is.null(susceptible)) { + y.title <- paste(y.title, susceptible) + } + } + p <- p + ggplot2::labs( title = title, subtitle = subtitle, @@ -317,15 +329,6 @@ geom_sir <- function(position = NULL, language <- validate_language(language) guideline <- get_aggregation_guideline(guideline, missing(guideline), combine_SI, missing(combine_SI), fn = "geom_sir") - y <- "value" - if (missing(position) || is.null(position)) { - position <- "fill" - } - - if (identical(position, "fill")) { - position <- ggplot2::position_fill(vjust = 0.5, reverse = TRUE) - } - x_deparse <- deparse(substitute(x)) if (x_deparse != "x") { x <- x_deparse @@ -334,24 +337,59 @@ geom_sir <- function(position = NULL, x <- substr(x, 2, nchar(x) - 1) } - if (tolower(x) %in% tolower(c("ab", "abx", "antimicrobials"))) { - x <- "antibiotic" - } else if (tolower(x) %in% tolower(c("SIR", "sir", "interpretations", "result"))) { - x <- "interpretation" - } + create_geom_sir( + position = position, x = x, fill = fill, facet = NULL, translate_ab = translate_ab, + minimum = minimum, language = language, guideline = guideline, ... + ) +} +normalise_sir_plot_var <- function(v) { + # aliases for the columns of sir_df(), as also used by facet_sir() + if (is.null(v)) { + return(NULL) + } + if (tolower(v) %in% tolower(c("ab", "abx", "antimicrobials"))) { + v <- "antibiotic" + } else if (tolower(v) %in% tolower(c("SIR", "sir", "interpretations", "result"))) { + v <- "interpretation" + } + v +} + +create_geom_sir <- function(position, x, fill, facet, translate_ab, minimum, language, guideline, ...) { + if (is.null(position)) { + position <- "fill" + } + if (identical(position, "fill")) { + position <- ggplot2::position_fill(vjust = 0.5, reverse = TRUE) + } + x <- normalise_sir_plot_var(x) ggplot2::geom_col( - data = function(x) { - sir_df( - data = x, - translate_ab = translate_ab, - language = language, - minimum = minimum, - guideline = guideline + data = function(data) { + sir_plot_data( + data = data, x = x, fill = fill, facet = facet, translate_ab = translate_ab, + minimum = minimum, language = language, guideline = guideline ) }, - mapping = utils::modifyList(ggplot2::aes(), list(x = str2lang(x), y = str2lang(y), fill = str2lang(fill))), + mapping = utils::modifyList(ggplot2::aes(), list(x = str2lang(x), y = str2lang("value"), fill = str2lang(fill))), position = position, ... ) } + +sir_plot_data <- function(data, x, fill, facet, translate_ab, minimum, language, guideline) { + out <- sir_df( + data = data, + translate_ab = translate_ab, + language = language, + minimum = minimum, + guideline = guideline + ) + if (!"interpretation" %in% c(normalise_sir_plot_var(x), normalise_sir_plot_var(fill), normalise_sir_plot_var(facet))) { + # the interpretation is not shown, so the bars of all interpretations would overlap; + # keep only the susceptible proportion, which is the first level and follows the guideline: + # S+SDD+I ("SI") for EUCAST, S+SDD ("S") for CLSI, and S for guideline = NULL + out <- out[which(as.character(out$interpretation) == levels(out$interpretation)[1]), , drop = FALSE] + } + out +} diff --git a/R/plotting.R b/R/plotting.R index 3e0387928..e8ffa727a 100755 --- a/R/plotting.R +++ b/R/plotting.R @@ -1473,9 +1473,18 @@ labels_sir_count <- function(position = NULL, meet_criteria(datalabels.size, allow_class = c("numeric", "integer"), has_length = 1, is_positive = TRUE, is_finite = TRUE) meet_criteria(datalabels.colour, allow_class = "character", has_length = 1) + create_labels_sir_count( + position = position, x = x, fill = fill, facet = NULL, translate_ab = translate_ab, + minimum = minimum, language = language, guideline = guideline, + datalabels.size = datalabels.size, datalabels.colour = datalabels.colour + ) +} + +create_labels_sir_count <- function(position, x, fill, facet, translate_ab, minimum, language, guideline, datalabels.size, datalabels.colour) { if (is.null(position)) { position <- "fill" } + x <- normalise_sir_plot_var(x) # labels are grouped like the bars of geom_sir(), so that they are placed on the right bar vjust <- 0.5 if (identical(position, "fill")) { @@ -1499,20 +1508,14 @@ labels_sir_count <- function(position = NULL, colour = datalabels.colour, lineheight = 0.75, vjust = vjust, - data = function(x) { - transformed <- sir_df( - data = x, - translate_ab = translate_ab, - minimum = minimum, - language = language, - guideline = guideline + data = function(data) { + # the same rows as the bars of geom_sir() + transformed <- sir_plot_data( + data = data, x = x_name, fill = fill, facet = facet, translate_ab = translate_ab, + minimum = minimum, language = language, guideline = guideline ) - transformed$gr <- transformed[, x_name, drop = TRUE] - transformed %pm>% - pm_group_by(gr) %pm>% - pm_mutate(lbl = paste0("n=", isolates)) %pm>% - pm_ungroup() %pm>% - pm_select(-gr) + transformed$lbl <- paste0("n=", transformed$isolates) + transformed } ) } diff --git a/man/ggplot_sir.Rd b/man/ggplot_sir.Rd index cefb35c4c..1968afe46 100644 --- a/man/ggplot_sir.Rd +++ b/man/ggplot_sir.Rd @@ -65,7 +65,7 @@ labels_sir_count( \item{x}{Variable to show on x axis, either \code{"antibiotic"} (default) or \code{"interpretation"} or a grouping variable.} -\item{fill}{Variable to categorise using the plots legend, either \code{"interpretation"} (default) or \code{"antibiotic"} or a grouping variable. For \code{\link[=labels_sir_count]{labels_sir_count()}}, this must be the same as the \code{fill} of \code{\link[=geom_sir]{geom_sir()}}, so that the labels are placed on the right bars.} +\item{fill}{Variable to categorise using the plots legend, either \code{"interpretation"} (default) or \code{"antibiotic"} or a grouping variable. For \code{\link[=labels_sir_count]{labels_sir_count()}}, this must be the same as the \code{fill} of \code{\link[=geom_sir]{geom_sir()}}, so that the labels are placed on the right bars. If the interpretation is not shown in the plot (i.e., neither in \code{x}, \code{fill}, nor \code{facet}), only the susceptible proportion is plotted, which follows the guideline (see \code{guideline}): S+SDD+I for EUCAST, S+SDD for CLSI, and S if \code{guideline = NULL}.} \item{facet}{Variable to split plots by, either \code{"interpretation"} (default) or \code{"antibiotic"} or a grouping variable.} diff --git a/tests/testthat/test-ggplot_sir.R b/tests/testthat/test-ggplot_sir.R index 32d34b740..5c6f2297a 100644 --- a/tests/testthat/test-ggplot_sir.R +++ b/tests/testthat/test-ggplot_sir.R @@ -175,5 +175,21 @@ test_that("test-ggplot_sir.R", { expect_equal(labels$y, (bars$ymin + bars$ymax) / 2) } } + + # without the interpretation in the plot, only the susceptible proportion is shown, following the guideline + grouped <- example_isolates[, c("gender", "AMX")] + grouped <- structure(grouped, class = c("grouped_df", "tbl_df", "tbl", "data.frame"), groups = data.frame(gender = c("F", "M"), .rows = I(list(which(grouped$gender == "F"), which(grouped$gender == "M"))))) + for (gl in list("EUCAST", "CLSI", NULL)) { + expected <- sir_df(grouped, guideline = gl) + expected <- expected[which(as.character(expected$interpretation) == levels(expected$interpretation)[1]), , drop = FALSE] + p <- ggplot_sir(grouped, x = "antibiotic", fill = "gender", position = "dodge", guideline = gl) + built <- ggplot_build(p) + expect_equal(sort(built$data[[1]]$y), sort(expected$value)) + expect_equal(nrow(built$data[[2]]), nrow(expected)) + expect_identical(p$labels$y, paste("Proportion", levels(expected$interpretation)[1])) + } + # all interpretations when they are shown in the facets + built <- ggplot_build(ggplot_sir(grouped, x = "antibiotic", fill = "gender", facet = "interpretation", position = "dodge", guideline = "EUCAST")) + expect_equal(nrow(built$data[[1]]), nrow(sir_df(grouped, guideline = "EUCAST"))) } })