(v3.0.0.9010) in as.sir(), add note when higher taxonomic levels are used

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: AMR
-Version: 3.0.0.9009
+Version: 3.0.0.9010
 Date: 2025-07-17
 Title: Antimicrobial Resistance Data Analysis
 Description: Functions to simplify and standardise antimicrobial resistance (AMR)

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 3.0.0.9009
+# AMR 3.0.0.9010
 
 This is primarily a bugfix release, though we added one nice feature too.
 
@@ -15,8 +15,9 @@ This is primarily a bugfix release, though we added one nice feature too.
 * Fixed a bug in `as.sir()` to allow any tidyselect language (#220)
 * Fixed a bug in `as.sir()` to pick right breakpoint when `uti = FALSE` (#216)
 * Fixed a bug in `ggplot_sir()` when using `combine_SI = FALSE` (#213)
-* Fixed all plotting to contain a separate colour for SDD (susceptible dose-dependent)
+* Fixed all plotting to contain a separate colour for SDD (susceptible dose-dependent) (#223)
 * Fixed some specific Dutch translations for antimicrobials
+* Added note to `as.sir()` to make it explicit when higher-level taxonomic breakpoints are used (#218)
 * Updated `random_mic()` and `random_disk()` to set skewedness of the distribution and allow multiple microorganisms
 
 

R/sir.R

@@ -1140,7 +1140,6 @@ as_sir_method <- function(method_short,
   current_sir_interpretation_history <- NROW(AMR_env$sir_interpretation_history)
 
   if (isTRUE(info) && message_not_thrown_before("as.sir", "sir_interpretation_history")) {
-    message()
     message_("Run `sir_interpretation_history()` afterwards to retrieve a logbook with all details of the breakpoint interpretations.\n\n", add_fn = font_green)
   }
 
@@ -1558,7 +1557,7 @@ as_sir_method <- function(method_short,
       ))
 
     if (breakpoint_type == "animal") {
-      # 2025-03-13 for now, only strictly follow guideline for current host, no extrapolation
+      # 2025-03-13/ for now, only strictly follow guideline for current host, no extrapolation
       breakpoints_current <- breakpoints_current[which(breakpoints_current$host == host_current), , drop = FALSE]
     }
 
@@ -1684,7 +1683,7 @@ as_sir_method <- function(method_short,
       # only UTI breakpoints available
       notes_current <- paste0(
         notes_current, "\n",
-        paste0("Breakpoints for ", font_bold(ab_formatted), " in ", mo_formatted, " are only available for (uncomplicated) urinary tract infections (UTI); assuming `uti = TRUE`.")
+        paste0("Breakpoints for ", font_bold(ab_formatted), " in ", mo_formatted, " are only available for (uncomplicated) urinary tract infections (UTI) - assuming `uti = TRUE`.")
       )
     } else if (nrow(breakpoints_current) > 1 && length(unique(breakpoints_current$site)) > 1 && any(is.na(uti_current)) && all(c(TRUE, FALSE) %in% breakpoints_current$uti, na.rm = TRUE) && message_not_thrown_before("as.sir", "siteUTI", mo_current, ab_current)) {
       # both UTI and Non-UTI breakpoints available
@@ -1707,7 +1706,7 @@ as_sir_method <- function(method_short,
       new_sir <- rep(as.sir("R"), length(rows))
       notes_current <- paste0(
         notes_current, "\n",
-        paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, "")
+        paste0("Intrinsic resistance applied for ", ab_formatted, " in ", mo_formatted, ".")
       )
     } else if (nrow(breakpoints_current) == 0) {
       # no rules available
@@ -1715,41 +1714,48 @@ as_sir_method <- function(method_short,
     } else {
       # then run the rules
       breakpoints_current <- breakpoints_current[1L, , drop = FALSE]
+      if (breakpoints_current$rank_index > 3) {
+        # we resort to a high-level taxonomic record since there are no breakpoint on genus (rank_index = 3) or lower, so note this
+        notes_current <- paste0(
+          "No genus- or species-level breakpoint available - applying higher taxonomic level instead.\n",
+          notes_current
+        )
+      }
 
       notes_current <- paste0(
         notes_current, "\n",
         ifelse(breakpoints_current$mo == "UNKNOWN" | breakpoints_current$ref_tbl %like% "PK.*PD",
-          "Some PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this",
+          "Some PK/PD breakpoints were applied - use `include_PKPD = FALSE` to prevent this.",
           ""
         ),
         "\n",
         ifelse(breakpoints_current$site %like% "screen" | breakpoints_current$ref_tbl %like% "screen",
-          "Some screening breakpoints were applied - use `include_screening = FALSE` to prevent this",
+          "Some screening breakpoints were applied - use `include_screening = FALSE` to prevent this.",
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[<][0-9]",
-          paste0("MIC values with the operator '<' are all considered 'S' since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values with the operator '<' are all considered 'S' since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "inverse") & as.character(values_bak) %like% "^[>][0-9]",
-          paste0("MIC values with the operator '>' are all considered 'R' since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values with the operator '>' are all considered 'R' since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^[><]=[0-9]" & as.double(values) > breakpoints_current$breakpoint_S & as.double(values) < breakpoints_current$breakpoint_R,
-          paste0("MIC values within the breakpoint guideline range with the operator '<=' or '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values within the breakpoint guideline range with the operator '<=' or '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^<=[0-9]" & as.double(values) == breakpoints_current$breakpoint_R,
-          paste0("MIC values at the R breakpoint with the operator '<=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values at the R breakpoint with the operator '<=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         ),
         "\n",
         ifelse(method == "mic" & capped_mic_handling %in% c("conservative", "standard") & as.character(values_bak) %like% "^>=[0-9]" & as.double(values) == breakpoints_current$breakpoint_S,
-          paste0("MIC values at the S breakpoint with the operator '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\""),
+          paste0("MIC values at the S breakpoint with the operator '>=' are considered 'NI' (non-interpretable) since capped_mic_handling = \"", capped_mic_handling, "\"."),
           ""
         )
       )
@@ -1759,7 +1765,7 @@ as_sir_method <- function(method_short,
         notes_current <- paste0(
           notes_current, "\n",
           ifelse(!is.na(breakpoints_current$breakpoint_S) & is.na(breakpoints_current$breakpoint_R),
-            "NAs because of missing R breakpoints were substituted with R since substitute_missing_r_breakpoint = TRUE",
+            "NAs because of missing R breakpoints were substituted with R since substitute_missing_r_breakpoint = TRUE.",
             ""
           )
         )
@@ -1798,7 +1804,7 @@ as_sir_method <- function(method_short,
       }
 
       # write to verbose output
-      notes_current <- trimws2(notes_current)
+      notes_current <- gsub("\n\n", "\n", trimws2(notes_current), fixed = TRUE)
       notes_current[notes_current == ""] <- NA_character_
       out <- data.frame(
         # recycling 1 to 2 rows does not always seem to work, which is why vectorise_log_entry() was added

R/sir_calc.R

@@ -257,12 +257,15 @@ sir_calc_df <- function(type, # "proportion", "count" or "both"
   data <- as.data.frame(data, stringsAsFactors = FALSE)
 
   for (i in seq_len(ncol(data))) {
-    data[, i] <- as.character(as.sir(data[, i, drop = TRUE]))
+    # transform SIR columns
-    if (isTRUE(combine_SI)) {
+    if (is.sir(data[, i, drop = TRUE])) {
-      if ("SDD" %in% data[, i, drop = TRUE] && message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) {
+      data[, i] <- as.character(data[, i, drop = TRUE])
-        message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE)
+      if (isTRUE(combine_SI)) {
+        if ("SDD" %in% data[, i, drop = TRUE] && message_not_thrown_before("sir_calc_df", combine_SI, entire_session = TRUE)) {
+          message_("Note that `sir_calc_df()` will also count dose-dependent susceptibility, 'SDD', as 'SI' when `combine_SI = TRUE`. This note will be shown once for this session.", as_note = FALSE)
+        }
+        data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE])
       }
-      data[, i] <- gsub("(I|S|SDD)", "SI", data[, i, drop = TRUE])
     }
   }