cleanup

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: AMR
-Version: 1.8.2.9040
+Version: 1.8.2.9041
 Date: 2022-10-31
 Title: Antimicrobial Resistance Data Analysis
 Description: Functions to simplify and standardise antimicrobial resistance (AMR)

NEWS.md

@@ -1,4 +1,4 @@
-# AMR 1.8.2.9040
+# AMR 1.8.2.9041
 
 This version will eventually become v2.0! We're happy to reach a new major milestone soon!
 

R/aa_helper_functions.R

@@ -1130,7 +1130,7 @@ font_grey <- function(..., collapse = " ") {
   try_colour(..., before = "\033[38;5;249m", after = "\033[39m", collapse = collapse)
 }
 font_grey_bg <- function(..., collapse = " ") {
-  if (tryCatch(import_fn("getThemeInfo", "rstudioapi", error_on_fail = FALSE)()$dark, error = function(e) FALSE)) {
+  if (is_dark()) {
     # similar to HTML #444444
     try_colour(..., before = "\033[48;5;238m", after = "\033[49m", collapse = collapse)
   } else {
@@ -1360,20 +1360,11 @@ percentage <- function(x, digits = NULL, ...) {
   )
 }
 
-time_start_tracking <- function() {
-  AMR_env$time_start <- round(as.double(Sys.time()) * 1000)
-}
-
-time_track <- function(name = NULL) {
-  paste("(until now:", trimws(round(as.double(Sys.time()) * 1000) - AMR_env$time_start), "ms)")
-}
-
 trimws2 <- function(..., whitespace = "[\u0009\u000A\u000B\u000C\u000D\u0020\u0085\u00A0\u1680\u180E\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200A\u200B\u200C\u200D\u2028\u2029\u202F\u205F\u2060\u3000\uFEFF]") {
   # this is even faster than trimws() itself which sets " \t\n\r".
   trimws(..., whitespace = whitespace)
 }
 
-
 # Faster data.table implementations ----
 
 match <- function(x, table, ...) {

R/ab.R

@@ -498,6 +498,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
       data.frame(
         x = x,
         ab = x_new,
+        x_bak = x_bak[match(x, x_bak_clean)],
         stringsAsFactors = FALSE
       ),
       stringsAsFactors = FALSE
@@ -513,7 +514,7 @@ as.ab <- function(x, flag_multiple_results = TRUE, info = interactive(), ...) {
   }
   x_unknown <- x_unknown[!x_unknown %in% x_unknown_ATCs]
   x_unknown <- c(x_unknown,
-                 AMR_env$ab_previously_coerced$x[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))])
+                 AMR_env$ab_previously_coerced$x_bak[which(AMR_env$ab_previously_coerced$x %in% x & is.na(AMR_env$ab_previously_coerced$ab))])
   if (length(x_unknown) > 0 && fast_mode == FALSE) {
     warning_(
       "in `as.ab()`: these values could not be coerced to a valid antimicrobial ID: ",

R/rsi.R

@@ -629,7 +629,7 @@ as.rsi.data.frame <- function(x,
       }
       x[, ab_cols[i]] <- as.rsi.default(x = as.character(x[, ab_cols[i], drop = TRUE]))
       if (show_message == TRUE) {
-        message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
+        message_(" OK.", add_fn = list(font_green), as_note = FALSE)
       }
     }
   }
@@ -790,6 +790,7 @@ as_rsi_method <- function(method_short,
   }
 
   rise_warning <- FALSE
+  rise_note <- FALSE
   method_param <- toupper(method)
 
   genera <- mo_genus(mo, language = NULL)
@@ -828,7 +829,7 @@ as_rsi_method <- function(method_short,
   }
 
   if (nrow(trans) == 0) {
-    message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
+    message_(" OK.", add_fn = list(font_green), as_note = FALSE)
     load_mo_uncertainties(metadata_mo)
     return(set_clean_class(factor(new_rsi, levels = c("S", "I", "R"), ordered = TRUE),
       new_class = c("rsi", "ordered", "factor")
@@ -875,14 +876,18 @@ as_rsi_method <- function(method_short,
       ))
 
     if (NROW(get_record) == 0) {
-      warning_(
+      if (mo_rank(mo[i]) %in% c("kingdom", "phylum", "class", "order")) {
-        "No ", method_param, " breakpoints available for ",
+        mo_formatted <- suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))
-        font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))),
+      } else {
-        paste0(" / "),
+        mo_formatted <- font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE))))
+      }
+      message_(font_green(font_bold(" NOTE.\n")),
+        font_black("No ", method_param, " breakpoints available for ", mo_formatted,
+        " / ",
         suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
-        " (", ab_param, ")"
+        " (", ab_param, ")", collapse = NULL)
       )
-      rise_warning <- TRUE
+      rise_note <- TRUE
       next
     }
 
@@ -905,13 +910,19 @@ as_rsi_method <- function(method_short,
       rise_warning <- TRUE
     } else if (nrow(records_same_mo) > 1 && length(unique(records_same_mo$site)) > 1 && is.na(uti[i]) && all(c(TRUE, FALSE) %in% records_same_mo$uti, na.rm = TRUE) && message_not_thrown_before("as.rsi", "siteUTI", records_same_mo$mo[1], ab_param)) {
       # uti not set and both UTI and non-UTI breakpoints available, so throw warning
-      warning_("in `as.rsi()`: breakpoints for UTI ", font_underline("and"), " non-UTI available for ",
+      if (mo_rank(mo[i]) %in% c("kingdom", "phylum", "class", "order")) {
-        font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))),
+        mo_formatted <- suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))
+      } else {
+        mo_formatted <- font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE))))
+      }
+      message_(font_green(font_bold(" NOTE.\n")),
+        font_black("Breakpoints for UTI ", font_underline("and"), " non-UTI available for ", mo_formatted,
         " / ",
         suppressMessages(suppressWarnings(ab_name(ab_param, language = NULL, tolower = TRUE))),
-        " (", ab_param, ") - assuming non-UTI. Use argument `uti` to set which isolates are from urine. See ?as.rsi.",
+        " (", ab_param, ") - assuming non-UTI. Use argument `uti` to set which isolates are from urine. See ?as.rsi.", collapse = NULL),
-        call = FALSE
+        as_note = FALSE
       )
+      rise_note <- TRUE
       get_record <- get_record %pm>%
         pm_filter(uti == FALSE)
       rise_warning <- TRUE
@@ -923,14 +934,19 @@ as_rsi_method <- function(method_short,
       } else {
         site <- paste0("body site '", get_record[1L, "site", drop = FALSE], "'")
       }
-      warning_("in `as.rsi()`: breakpoints available for ",
+      if (mo_rank(mo[i]) %in% c("kingdom", "phylum", "class", "order")) {
-        font_italic(suppressMessages(suppressWarnings(mo_shortname(records_same_mo$mo[1], language = NULL, keep_synonyms = FALSE)))),
+        mo_formatted <- suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE)))
-        paste0(" / "),
+      } else {
+        mo_formatted <- font_italic(suppressMessages(suppressWarnings(mo_shortname(mo[i], language = NULL, keep_synonyms = FALSE))))
+      }
+      message_(font_green(font_bold(" NOTE.\n")),
+        font_black("Breakpoints available for ", mo_formatted,
+        " / ",
         suppressMessages(suppressWarnings(ab_name(records_same_mo$ab[1], language = NULL, tolower = TRUE))),
-        paste0(" - assuming ", site),
+        paste0(" - assuming ", site), collapse = NULL),
-        call = FALSE
+        as_note = FALSE
       )
-      rise_warning <- TRUE
+      rise_note <- TRUE
     }
 
     if (NROW(get_record) > 0) {
@@ -1003,10 +1019,13 @@ as_rsi_method <- function(method_short,
     ) %pm>%
     pm_pull(new_rsi)
   
-  if (isTRUE(rise_warning)) {
+  if (!isTRUE(rise_note)) {
-    message_("WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
+    # notes already a have green "NOTE" text by this point
-  } else {
+    if (isTRUE(rise_warning)) {
-    message_(" OK.", add_fn = list(font_green, font_bold), as_note = FALSE)
+      message_(" WARNING.", add_fn = list(font_yellow, font_bold), as_note = FALSE)
+    } else {
+      message_(" OK.", add_fn = list(font_green), as_note = FALSE)
+    }
   }
   
   load_mo_uncertainties(metadata_mo)

inst/tinytest/test-vctrs.R

@@ -28,7 +28,7 @@
 # ==================================================================== #
 
 # extra tests for {vctrs} pkg support
-if (pkg_is_available("dplyr", also_load = FALSE)) {
+if (AMR:::pkg_is_available("dplyr", also_load = FALSE)) {
   test <- dplyr::tibble(ab = as.ab("CIP"),
                         mo = as.mo("Escherichia coli"),
                         mic = as.mic(2),

tests/tinytest.R

@@ -30,10 +30,11 @@
 # we use {tinytest} instead of {testthat} because it does not rely on recent R versions - we want to test on R >= 3.0.
 
 # Run them in RStudio using:
-# rstudioapi::jobRunScript("tests/tinytest.R", name = "Tinytest Unit Tests", workingDir = getwd(), exportEnv = "tinytest_results")
+# rstudioapi::jobRunScript("tests/tinytest.R", name = "AMR Unit Tests", workingDir = getwd(), exportEnv = "tinytest_results")
 
-# test only on GitHub Actions and at home - not on CRAN as tests are lengthy
+# test only on GitHub Actions and at using RStudio jobs - not on CRAN as tests are lengthy
-if (identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
+if (tryCatch(isTRUE(AMR:::import_fn("isJob", "rstudioapi")()), error = function(e) FALSE) ||
+    identical(Sys.getenv("R_RUN_TINYTEST"), "true")) {
   # env var 'R_LIBS_USER' got overwritten during 'R CMD check' in GitHub Actions, so:
   .libPaths(c(Sys.getenv("R_LIBS_USER_GH_ACTIONS"), .libPaths()))
   if (AMR:::pkg_is_available("tinytest", also_load = TRUE)) {