Merge branch 'main' into breakpoints

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)

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)

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
+}

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
     }
   )
 }

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.}
 

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")))
   }
 })