(v2.1.1.9227) unit test fixes

R/aa_helper_functions.R

@@ -1299,7 +1299,13 @@ font_purple_bg <- function(..., collapse = " ") {
   try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;89m", after = "\033[49m", collapse = collapse)
 }
 font_rose_bg <- function(..., collapse = " ") {
-  try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;217m", after = "\033[49m", collapse = collapse)
+  if (is_dark()) {
+    # this is #ed553b (picked to be colourblind-safe with other SIR colours)
+    try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;203m", after = "\033[49m", collapse = collapse)
+  } else {
+    # also colourblind-safe but softer
+    try_colour(font_black(..., collapse = collapse, adapt = FALSE), before = "\033[48;5;217m", after = "\033[49m", collapse = collapse)
+  }
 }
 font_na <- function(..., collapse = " ") {
   font_red(..., collapse = collapse)

R/custom_eucast_rules.R

@@ -253,7 +253,7 @@ print.custom_eucast_rules <- function(x, ...) {
     if (is.na(rule$result_value)) {
       val <- font_red("<NA>")
     } else if (rule$result_value == "R") {
-      val <- font_red_bg(" R ")
+      val <- font_rose_bg(" R ")
     } else if (rule$result_value == "S") {
       val <- font_green_bg(" S ")
     } else {
@@ -297,7 +297,7 @@ format_custom_query_rule <- function(query, colours = has_colour()) {
   query <- gsub(" %in% ", sub("{text}", " is one of ", txt, fixed = TRUE), query, fixed = TRUE)
   query <- gsub(" %like% ", sub("{text}", " resembles ", txt, fixed = TRUE), query, fixed = TRUE)
   if (colours == TRUE) {
-    query <- gsub('"R"', font_red_bg(" R "), query, fixed = TRUE)
+    query <- gsub('"R"', font_rose_bg(" R "), query, fixed = TRUE)
     query <- gsub('"S"', font_green_bg(" S "), query, fixed = TRUE)
     query <- gsub('"I"', font_orange_bg(" I "), query, fixed = TRUE)
   }

R/eucast_rules.R

@@ -656,7 +656,9 @@ eucast_rules <- function(x,
     if (isTRUE(ampc_cephalosporin_resistance)) {
       ampc_cephalosporin_resistance <- "R"
     }
-    eucast_rules_df[which(eucast_rules_df$reference.rule %like% "ampc"), "to_value"] <- as.character(ampc_cephalosporin_resistance)
+    if (!is.null(eucast_rules_df$reference.rule)) {
+      eucast_rules_df[which(eucast_rules_df$reference.rule %like% "ampc"), "to_value"] <- as.character(ampc_cephalosporin_resistance)
+    }
   }
 
   # sometimes, the screenings are missing but the names are actually available

R/sir.R

@@ -1715,11 +1715,7 @@ pillar_shaft.sir <- function(x, ...) {
     out[x == "S"] <- font_green_bg("  S  ")
     out[x == "I"] <- font_orange_bg("  I  ")
     out[x == "SDD"] <- font_orange_bg(" SDD ")
-    if (is_dark()) {
-      out[x == "R"] <- font_red_bg("  R  ")
-    } else {
-      out[x == "R"] <- font_rose_bg("  R  ")
-    }
+    out[x == "R"] <- font_rose_bg("  R  ")
   }
   create_pillar_column(out, align = "left", width = 5)
 }