update sir to include interpretation details

.github/prehooks/pre-commit

@@ -68,49 +68,56 @@ echo ""
 # ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 echo "Updating semantic versioning and date..."
 
-# Get tags from remote and remove tags not on remote
+current_branch=$(git rev-parse --abbrev-ref HEAD)
-git fetch origin --prune --prune-tags --quiet
+if [ "$current_branch" != "main" ]; then
-currenttagfull=$(git describe --tags --abbrev=0)
+  echo "- Current branch is '$current_branch'; skipping version/date update (only runs on 'main')"
-currenttag=$(git describe --tags --abbrev=0 | sed 's/v//')
-
-# Assume main branch to be 'main' or 'master'
-defaultbranch=$(git branch | cut -c 3- | grep -E '^master$|^main$')
-if [ "$currenttag" = "" ]; then
-  currenttag="0.0.1"
-  currentcommit=$(git rev-list --count ${defaultbranch})
-  echo "- No git tags found, creating one in format 'v(x).(y).(z)' - currently ${currentcommit} previous commits in '${defaultbranch}'"
 else
-  currentcommit=$(git rev-list --count ${currenttagfull}..${defaultbranch})
+  # Version update logic begins here
-  echo "- Latest tag is '${currenttagfull}', with ${currentcommit} previous commits in '${defaultbranch}'"
+  
-fi
+  # Get tags from remote and remove tags not on remote
-
+  git fetch origin --prune --prune-tags --quiet
-# Combine tag and commit number
+  currenttagfull=$(git describe --tags --abbrev=0)
-currentversion="$currenttag.$((currentcommit + 9001))"
+  currenttag=$(git describe --tags --abbrev=0 | sed 's/v//')
-echo "- ${currentpkg} pkg version set to ${currentversion}"
+  
-
+  # Assume main branch to be 'main' or 'master'
-# Update version number and date in DESCRIPTION
+  defaultbranch=$(git branch | cut -c 3- | grep -E '^master$|^main$')
-sed -i -- "s/^Version: .*/Version: ${currentversion}/" DESCRIPTION
+  if [ "$currenttag" = "" ]; then
-sed -i -- "s/^Date: .*/Date: $(date '+%Y-%m-%d')/" DESCRIPTION
+    currenttag="0.0.1"
-echo "- Updated version number and date in ./DESCRIPTION"
+    currentcommit=$(git rev-list --count ${defaultbranch})
-rm -f DESCRIPTION--
+    echo "- No git tags found, creating one in format 'v(x).(y).(z)' - currently ${currentcommit} previous commits in '${defaultbranch}'"
-git add DESCRIPTION
+  else
-
+    currentcommit=$(git rev-list --count ${currenttagfull}..${defaultbranch})
-# Update version number in NEWS.md
+    echo "- Latest tag is '${currenttagfull}', with ${currentcommit} previous commits in '${defaultbranch}'"
-if [ -e "NEWS.md" ]; then
-  if [ "$currentpkg" = "your" ]; then
-    currentpkg=""
   fi
-  sed -i -- "1s/.*/# ${currentpkg} ${currentversion}/" NEWS.md
+  
-  echo "- Updated version number in ./NEWS.md"
+  # Combine tag and commit number
-  rm -f NEWS.md--
+  currentversion="$currenttag.$((currentcommit + 9001))"
-  git add NEWS.md
+  echo "- ${currentpkg} pkg version set to ${currentversion}"
-else
+  
-  echo "- No NEWS.md found!"
+  # Update version number and date in DESCRIPTION
+  sed -i -- "s/^Version: .*/Version: ${currentversion}/" DESCRIPTION
+  sed -i -- "s/^Date: .*/Date: $(date '+%Y-%m-%d')/" DESCRIPTION
+  echo "- Updated version number and date in ./DESCRIPTION"
+  rm -f DESCRIPTION--
+  git add DESCRIPTION
+  
+  # Update version number in NEWS.md
+  if [ -e "NEWS.md" ]; then
+    if [ "$currentpkg" = "your" ]; then
+      currentpkg=""
+    fi
+    sed -i -- "1s/.*/# ${currentpkg} ${currentversion}/" NEWS.md
+    echo "- Updated version number in ./NEWS.md"
+    rm -f NEWS.md--
+    git add NEWS.md
+  else
+    echo "- No NEWS.md found!"
+  fi
+  echo ""
+  
+  # Save the version number for use in the commit-msg hook
+  echo "${currentversion}" > .git/commit_version.tmp
 fi
-echo ""
-
-# Save the version number for use in the commit-msg hook
-echo "${currentversion}" > .git/commit_version.tmp
 
 git add data-raw/*
 git add data/*

.github/workflows/check-old-tinytest.yaml

@@ -59,8 +59,15 @@ jobs:
 
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
+      LANG: en_US.UTF-8
+      LC_ALL: en_US.UTF-8
 
     steps:
+      - name: Set up locales
+        run: |
+          sudo locale-gen en_US.UTF-8
+          sudo update-locale LANG=en_US.UTF-8
+
       - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-r@v2

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: AMR
-Version: 3.0.0.9012
+Version: 3.0.0.9017
-Date: 2025-07-17
+Date: 2025-07-28
 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

NAMESPACE

@@ -12,6 +12,7 @@ S3method("[",deprecated_amr_dataset)
 S3method("[",disk)
 S3method("[",mic)
 S3method("[",mo)
+S3method("[",sir)
 S3method("[<-",ab)
 S3method("[<-",av)
 S3method("[<-",disk)
@@ -24,6 +25,7 @@ S3method("[[",deprecated_amr_dataset)
 S3method("[[",disk)
 S3method("[[",mic)
 S3method("[[",mo)
+S3method("[[",sir)
 S3method("[[<-",ab)
 S3method("[[<-",av)
 S3method("[[<-",disk)
@@ -99,6 +101,7 @@ S3method(print,custom_eucast_rules)
 S3method(print,custom_mdro_guideline)
 S3method(print,deprecated_amr_dataset)
 S3method(print,disk)
+S3method(print,interpreted_sir)
 S3method(print,mic)
 S3method(print,mo)
 S3method(print,mo_renamed)

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 3.0.0.9012
+# AMR 3.0.0.9017
 
 This is primarily a bugfix release, though we added one nice feature too.
 

R/ggplot_sir.R

@@ -177,8 +177,8 @@ ggplot_sir <- function(data,
                        nrow = NULL,
                        colours = c(
                          S = "#3CAEA3",
-                         SI = "#3CAEA3",
                          SDD = "#8FD6C4",
+                         SI = "#3CAEA3",
                          I = "#F6D55C",
                          IR = "#ED553B",
                          R = "#ED553B"

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 <- 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])
-  }
-  colours_SIR <- unname(colours_SIR)
 
   if (identical(aesthetics, "x")) {
     ggplot_fn <- ggplot2::scale_x_discrete
@@ -392,24 +391,19 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
       args,
       list(
         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$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`.",
       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)) {
       x[x == "S"] <- "(S) Susceptible"
       x[x == "SDD"] <- "(SDD) Susceptible dose-dependent"
@@ -419,6 +413,8 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
         x[x == "I"] <- "(I) Intermediate"
       }
       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 <- translate_AMR(x, language = language)
     }
@@ -426,7 +422,7 @@ create_scale_sir <- function(aesthetics, colours_SIR, language, eucast_I, ...) {
   }
   scale$limits <- function(x, ...) {
     # 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
@@ -536,6 +532,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 +680,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 +701,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[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),
     levels = translate_into_language(
       c(
         "(S) Susceptible",
+        "(SDD) Susceptible dose-dependent",
         paste("(I)", plot_name_of_I(cols_sub$guideline)),
         "(R) Resistant"
       ),
@@ -721,10 +722,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) 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)
     p <- p +
@@ -790,6 +791,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 +937,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 +956,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[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),
     levels = translate_into_language(
       c(
@@ -973,10 +977,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) 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)
     p <- p +
@@ -1093,12 +1097,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 <- 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
   colours_SIR <- c(colours_SIR, "grey30")
@@ -1148,12 +1147,7 @@ autoplot.sir <- function(object,
     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)
   colnames(df) <- c("x", "n")
@@ -1252,13 +1246,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 +1369,7 @@ scale_sir_colours <- function(...,
     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()
   if ("colours" %in% names(list(...))) {
@@ -1502,3 +1485,39 @@ labels_sir_count <- function(position = NULL,
     }
   )
 }
+
+expand_SIR_colours <- function(colours_SIR, unname = TRUE) {
+  sir_order <- c("S", "SDD", "I", "R", "SI", "IR")
+
+  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])
+    }
+    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
+  } 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(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]
+  }
+
+  if (unname) {
+    colours_SIR <- unname(colours_SIR)
+  }
+
+  return(colours_SIR)
+}

R/sir.R

@@ -385,26 +385,15 @@ as.sir <- function(x, ...) {
   UseMethod("as.sir")
 }
 
-as_sir_structure <- function(x,
+as_sir_structure <- function(x) {
-                             guideline = NULL,
+  int <- attr(x, "interpretation_details")
-                             mo = NULL,
-                             ab = NULL,
-                             method = NULL,
-                             ref_tbl = NULL,
-                             ref_breakpoints = NULL) {
   structure(
     factor(as.character(unlist(unname(x))),
       levels = c("S", "SDD", "I", "R", "NI"),
       ordered = TRUE
     ),
-    # TODO for #170
+    interpretation_details = int,
-    # guideline = guideline,
+    class = c(if (!is.null(int)) "interpreted_sir" else NULL, "sir", "ordered", "factor")
-    # mo = mo,
-    # ab = ab,
-    # method = method,
-    # ref_tbl = ref_tbl,
-    # ref_breakpoints = ref_breakpoints,
-    class = c("sir", "ordered", "factor")
   )
 }
 
@@ -1649,9 +1638,11 @@ as_sir_method <- function(method_short,
         breakpoint_S_R = vectorise_log_entry(NA_character_, length(rows)),
         stringsAsFactors = FALSE
       )
+      attr(new_sir, "interpretation_details") <- out
       out <- subset(out, !is.na(input_given))
       AMR_env$sir_interpretation_history <- rbind_AMR(AMR_env$sir_interpretation_history, out)
       notes <- c(notes, notes_current)
+      df[rows, "result"] <- new_sir
       next
     }
 
@@ -1827,6 +1818,7 @@ as_sir_method <- function(method_short,
         breakpoint_S_R = vectorise_log_entry(paste0(breakpoints_current[, "breakpoint_S", drop = TRUE], "-", breakpoints_current[, "breakpoint_R", drop = TRUE]), length(rows)),
         stringsAsFactors = FALSE
       )
+      attr(new_sir, "interpretation_details") <- out
       out <- subset(out, !is.na(input_given))
       AMR_env$sir_interpretation_history <- rbind_AMR(AMR_env$sir_interpretation_history, out)
     }
@@ -1871,20 +1863,33 @@ as_sir_method <- function(method_short,
   new_part <- new_part[order(new_part$index), , drop = FALSE]
   AMR_env$sir_interpretation_history <- rbind_AMR(old_part, new_part)
 
-  df$result
+  as_sir_structure(df$result)
 }
 
 #' @rdname as.sir
+#' @param sir_values SIR values that were interpreted from MIC or disk diffusion values using [as.sir()].
 #' @param clean A [logical] to indicate whether previously stored results should be forgotten after returning the 'logbook' with results.
 #' @export
-sir_interpretation_history <- function(clean = FALSE) {
+sir_interpretation_history <- function(sir_values = NULL, clean = FALSE) {
+  # for AMR v3.0.0 and lower, the first argument was `clean`, so allow `sir_interpretation_history(TRUE)` to keep working
+  if (is.logical(sir_values) && missing(clean)) {
+    clean <- sir_values
+    sir_values <- NULL
+    warning_("For `sir_interpretation_history()`, the `clean` argument is no longer the first argument, please update your code to explicitly state 'clean': `sir_interpretation_history(clean = ", clean, ")`.")
+  }
+  meet_criteria(sir_values, allow_class = "sir", allow_NULL = TRUE)
   meet_criteria(clean, allow_class = "logical", has_length = 1)
-  out <- AMR_env$sir_interpretation_history
+
-  out <- out[which(!is.na(out$datetime)), , drop = FALSE]
+  if (!is.null(sir_values)) {
-  out$outcome <- as.sir(out$outcome)
+    out <- attr(sir_values, "interpretation_details")
-  out$site <- as.character(out$site)
+  } else {
-  if (isTRUE(clean)) {
+    out <- AMR_env$sir_interpretation_history
-    AMR_env$sir_interpretation_history <- AMR_env$sir_interpretation_history[0, , drop = FALSE]
+    out <- out[which(!is.na(out$datetime)), , drop = FALSE]
+    out$outcome <- as.sir(out$outcome)
+    out$site <- as.character(out$site)
+    if (isTRUE(clean)) {
+      AMR_env$sir_interpretation_history <- AMR_env$sir_interpretation_history[0, , drop = FALSE]
+    }
   }
   if (pkg_is_available("tibble")) {
     out <- import_fn("as_tibble", "tibble")(out)
@@ -2008,21 +2013,60 @@ get_skimmers.sir <- function(column) {
 #' @export
 #' @noRd
 print.sir <- function(x, ...) {
-  x_name <- deparse(substitute(x))
   cat("Class 'sir'\n")
-  # TODO for #170
-  # if (!is.null(attributes(x)$guideline) && !all(is.na(attributes(x)$guideline))) {
-  #   cat(font_blue(word_wrap("These values were interpreted using ",
-  #                           font_bold(vector_and(attributes(x)$guideline, quotes = FALSE)),
-  #                           " based on ",
-  #                           vector_and(attributes(x)$method, quotes = FALSE),
-  #                           " values. ",
-  #                           "Use `sir_interpretation_history(", x_name, ")` to return a full logbook.")))
-  #   cat("\n")
-  # }
   print(as.character(x), quote = FALSE)
 }
 
+#' @method print interpreted_sir
+#' @export
+#' @noRd
+print.interpreted_sir <- function(x, ...) {
+  cat("Class 'sir'\n")
+  print(as.character(x), quote = FALSE)
+
+  if (length(x) == 0) {
+    return(invisible())
+  }
+
+  int <- attr(x, "interpretation_details")
+  if (NROW(int) == 0) {
+    if (length(x) == 1) {
+      cat(font_blue(word_wrap("Source data were lost for this interpreted value.")))
+    } else {
+      cat(font_blue(word_wrap("Source data were lost for these interpreted values.")))
+    }
+  } else {
+    relevant_cols <- int[, c("guideline", "method", "ab", "mo"), drop = FALSE]
+    relevant_cols <- unique(relevant_cols)
+    vals1_plural <- ifelse(length(x) == 1, "This value was", "These values were")
+    vals2_plural <- ifelse(length(x) == 1, "value", "values")
+    method_fn <- ifelse(relevant_cols$method == "MIC", "MIC", "disk diffusion")
+    if (NROW(relevant_cols) == 1) {
+      in_host <- ifelse(relevant_cols$host == "human", "", paste0(" in ", relevant_cols$host))
+      cat(font_blue(word_wrap(
+        vals1_plural, " interpreted using ",
+        relevant_cols$guideline,
+        " based on the ",
+        method_fn,
+        " ", vals2_plural, " for ",
+        ab_name(relevant_cols$ab, language = NULL, info = FALSE, tolower = TRUE), " in ",
+        italicise_taxonomy(mo_name(relevant_cols$mo, language = NULL, info = FALSE), type = "ansi"),
+        in_host,
+        "."
+      )))
+    } else {
+      cat(font_blue(word_wrap(
+        vals1_plural, " interpreted using ",
+        vector_and(relevant_cols$guideline, quotes = FALSE),
+        " based on ",
+        vector_and(method_fn, quotes = FALSE),
+        " ", vals2_plural, "."
+      )))
+    }
+    cat(font_blue(word_wrap("\nUse `sir_interpretation_history()` on this object to return a full logbook.\n")))
+  }
+}
+
 
 #' @method as.double sir
 #' @export
@@ -2078,51 +2122,132 @@ summary.sir <- function(object, ...) {
   value
 }
 
+#' @method [ sir
+#' @export
+#' @noRd
+"[.sir" <- function(x, ...) {
+  y <- NextMethod()
+  det <- attr(x, "interpretation_details")
+  if (!is.null(det)) {
+    subset_idx <- seq_along(x)[...]
+    # safer than relying on implicit eval inside NextMethod()
+    attr(y, "interpretation_details") <- det[subset_idx, , drop = FALSE]
+  }
+  y
+}
+#' @method [[ sir
+#' @export
+#' @noRd
+"[[.sir" <- function(x, i, ...) {
+  if (length(i) != 1L) {
+    stop("attempt to select more than one element with [[.", call. = FALSE)
+  }
+  x[i] # calls `[.sir`, ensures attr alignment
+}
+
 #' @method [<- sir
 #' @export
 #' @noRd
 "[<-.sir" <- function(i, j, ..., value) {
   value <- as.sir(value)
   y <- NextMethod()
-  attributes(y) <- attributes(i)
+
+  old_det <- attr(i, "interpretation_details")
+  new_det <- attr(value, "interpretation_details")
+
+  len_y <- length(y)
+
+  # Neither i nor value have details -> do nothing
+  if (is.null(old_det) && is.null(new_det)) {
+    return(y)
+  }
+
+  # Start building full_det as copy of old_det or empty
+  full_det <- if (!is.null(old_det)) old_det else data.frame(row = seq_along(i))
+
+  # Ensure full_det has correct row count and order
+  if (nrow(full_det) != length(i)) {
+    attr(y, "interpretation_details") <- NULL
+    return(y)
+  }
+
+  # Which rows are being assigned?
+  assign_idx <- if (missing(j)) seq_along(i) else j
+  assign_idx <- as.integer(assign_idx)
+
+  # If new_det is missing or too short, fill it
+  if (is.null(new_det)) {
+    new_det <- data.frame(row = assign_idx)
+  } else if (nrow(new_det) != length(value)) {
+    new_det <- data.frame(row = assign_idx)
+  }
+
+  # Add temporary .row to track positions
+  full_det$.row <- seq_len(nrow(full_det))
+  new_det$.row <- assign_idx
+
+  # Replace old rows with new rows
+  full_det <- rbind(
+    subset(full_det, !.row %in% assign_idx),
+    new_det
+  )
+  full_det <- full_det[order(full_det$.row), , drop = FALSE]
+  full_det$.row <- NULL
+
+  # Clean up: ensure right number of rows
+  if (nrow(full_det) == len_y) {
+    attr(y, "interpretation_details") <- full_det
+  } else {
+    attr(y, "interpretation_details") <- NULL
+  }
+
   y
 }
 #' @method [[<- sir
 #' @export
 #' @noRd
 "[[<-.sir" <- function(i, j, ..., value) {
-  value <- as.sir(value)
+  if (!is.null(det) && length(i) == 1 && nrow(det) >= i) {
-  y <- NextMethod()
+    i[j] <- value
-  attributes(y) <- attributes(i)
+    i
-  y
+  } else {
+    NextMethod()
+  }
 }
 #' @method c sir
 #' @export
 #' @noRd
-c.sir <- function(...) {
+c.sir <- function(..., recursive = FALSE) {
-  lst <- list(...)
+  lst <- lapply(
+    list(...),
+    function(x) {
+      list(
+        values = as.character(x),
+        interpretation_details = attr(x, "interpretation_details")
+      )
+    }
+  )
+  x <- unlist(lapply(lst, `[[`, "values"), use.names = FALSE)
+  details <- lapply(lst, `[[`, "interpretation_details")
+  has_details <- vapply(details, is.data.frame, logical(1))
+  if (!any(has_details)) {
+    return(as_sir_structure(x))
+  }
 
-  # TODO for #170
+  # Pre-allocate details (no Map, no matrix allocation)
-  # guideline <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$guideline %or% NA_character_)
+  combined_details <- do.call(rbind, lapply(seq_along(details), function(i) {
-  # mo <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$mo %or% NA_character_)
+    d <- details[[i]]
-  # ab <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ab %or% NA_character_)
+    if (is.null(d)) {
-  # method <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$method %or% NA_character_)
+      # generate NA rows of correct length, but fast
-  # ref_tbl <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ref_tbl %or% NA_character_)
+      n <- length(details[[i]])
-  # ref_breakpoints <- vapply(FUN.VALUE = character(1), lst, function(x) attributes(x)$ref_breakpoints %or% NA_character_)
+      as.data.frame(matrix(NA, nrow = n, ncol = 0))
+    } else {
+      d
+    }
+  }))
 
-  out <- as.sir(unlist(lapply(list(...), as.character)))
+  attr(x, "interpretation_details") <- combined_details
-
+  as_sir_structure(x)
-  # TODO for #170
-  # if (!all(is.na(guideline))) {
-  #   attributes(out)$guideline <- guideline
-  #   attributes(out)$mo <- mo
-  #   attributes(out)$ab <- ab
-  #   attributes(out)$method <- method
-  #   attributes(out)$ref_tbl <- ref_tbl
-  #   attributes(out)$ref_breakpoints <- ref_breakpoints
-  # }
-
-  out
 }
 
 #' @method unique sir

index.Rmd

@@ -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

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_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
 #>   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

man/as.sir.Rd

@@ -70,7 +70,7 @@ is_sir_eligible(x, threshold = 0.05)
   language = get_AMR_locale(), verbose = FALSE, info = interactive(),
   parallel = FALSE, max_cores = -1, conserve_capped_values = NULL)
 
-sir_interpretation_history(clean = FALSE)
+sir_interpretation_history(sir_values = NULL, clean = FALSE)
 }
 \arguments{
 \item{x}{Vector of values (for class \code{\link{mic}}: MIC values in mg/L, for class \code{\link{disk}}: a disk diffusion radius in millimetres).}
@@ -147,6 +147,8 @@ The default \code{"standard"} setting ensures cautious handling of uncertain val
 
 \item{max_cores}{Maximum number of cores to use if \code{parallel = TRUE}. Use a negative value to subtract that number from the available number of cores, e.g. a value of \code{-2} on an 8-core machine means that at most 6 cores will be used. Defaults to \code{-1}. There will never be used more cores than variables to analyse. The available number of cores are detected using \code{\link[parallelly:availableCores]{parallelly::availableCores()}} if that package is installed, and base \R's \code{\link[parallel:detectCores]{parallel::detectCores()}} otherwise.}
 
+\item{sir_values}{SIR values that were interpreted from MIC or disk diffusion values using \code{\link[=as.sir]{as.sir()}}.}
+
 \item{clean}{A \link{logical} to indicate whether previously stored results should be forgotten after returning the 'logbook' with results.}
 }
 \value{

man/ggplot_sir.Rd

@@ -9,7 +9,7 @@ ggplot_sir(data, position = NULL, x = "antibiotic",
   fill = "interpretation", facet = NULL, breaks = seq(0, 1, 0.1),
   limits = NULL, translate_ab = "name", combine_SI = TRUE,
   minimum = 30, language = get_AMR_locale(), nrow = NULL, colours = c(S
-  = "#3CAEA3", SI = "#3CAEA3", SDD = "#8FD6C4", I = "#F6D55C", IR = "#ED553B",
+  = "#3CAEA3", SDD = "#8FD6C4", SI = "#3CAEA3", I = "#F6D55C", IR = "#ED553B",
   R = "#ED553B"), datalabels = TRUE, datalabels.size = 2.5,
   datalabels.colour = "grey15", title = NULL, subtitle = NULL,
   caption = NULL, x.title = "Antimicrobial", y.title = "Proportion", ...)

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

pkgdown/extra.css

@@ -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;