(v1.6.0.9065) unit tests

R/aa_helper_functions.R

@@ -864,8 +864,13 @@ unique_call_id <- function(entire_session = FALSE) {
   } else {
     # combination of environment ID (like "0x7fed4ee8c848")
     # and highest system call
+    call <- paste0(deparse(sys.calls()[[1]]), collapse = "")
+    if (call %like% "run_test_dir|test_all|tinytest|test_package|testthat") {
+      # unit tests will keep the same call and environment - give them a unique ID
+      call <- paste0(sample(c(c(0:9), letters[1:6]), size = 64, replace = TRUE), collapse = "")
+    }
     c(envir = gsub("<environment: (.*)>", "\\1", utils::capture.output(sys.frames()[[1]])),
-      call = paste0(deparse(sys.calls()[[1]]), collapse = ""))
+      call = call)
   }
 }
 
@@ -881,14 +886,6 @@ message_not_thrown_before <- function(fn, entire_session = FALSE) {
   is.null(pkg_env[[paste0("thrown_msg.", fn)]]) || !identical(pkg_env[[paste0("thrown_msg.", fn)]], unique_call_id(entire_session))
 }
 
-reset_all_thrown_messages <- function() {
-  # for unit tests, where the environment and highest system call do not change
-  # can be found in tests/testthat/*.R
-  pkg_env_contents <- ls(envir = pkg_env)
-  rm(list = pkg_env_contents[pkg_env_contents %like% "^thrown_msg."],
-     envir = pkg_env)
-}
-
 has_colour <- function() {
   # this is a base R version of crayon::has_color, but disables colours on emacs
   

R/ggplot_rsi.R

@@ -115,35 +115,35 @@
 #'     ggplot() +
 #'     geom_col(aes(x = x, y = y, fill = z)) +
 #'     scale_rsi_colours(Value4 = "S", Value5 = "I", Value6 = "R")
+#'   
+#'   # resistance of ciprofloxacine per age group
+#'   example_isolates %>%
+#'     mutate(first_isolate = first_isolate()) %>%
+#'     filter(first_isolate == TRUE,
+#'            mo == as.mo("E. coli")) %>%
+#'     # age_groups() is also a function in this AMR package:
+#'     group_by(age_group = age_groups(age)) %>%
+#'     select(age_group,
+#'            CIP) %>%
+#'     ggplot_rsi(x = "age_group")
+#'   
+#'   # a shorter version which also adjusts data label colours:
+#'   example_isolates %>%
+#'     select(AMX, NIT, FOS, TMP, CIP) %>%
+#'     ggplot_rsi(colours = FALSE)
+#'
+#'
+#'   # it also supports groups (don't forget to use the group var on `x` or `facet`):
+#'   example_isolates %>%
+#'     select(hospital_id, AMX, NIT, FOS, TMP, CIP) %>%
+#'     group_by(hospital_id) %>%
+#'     ggplot_rsi(x = "hospital_id",
+#'                facet = "antibiotic",
+#'                nrow = 1,
+#'                title = "AMR of Anti-UTI Drugs Per Hospital",
+#'                x.title = "Hospital",
+#'                datalabels = FALSE)
 #' }
-#'   
-#' # resistance of ciprofloxacine per age group
-#' example_isolates %>%
-#'   mutate(first_isolate = first_isolate(.)) %>%
-#'   filter(first_isolate == TRUE,
-#'          mo == as.mo("E. coli")) %>%
-#'   # age_groups() is also a function in this AMR package:
-#'   group_by(age_group = age_groups(age)) %>%
-#'   select(age_group,
-#'          CIP) %>%
-#'   ggplot_rsi(x = "age_group")
-#'   
-#' # a shorter version which also adjusts data label colours:
-#' example_isolates %>%
-#'   select(AMX, NIT, FOS, TMP, CIP) %>%
-#'   ggplot_rsi(colours = FALSE)
-#'
-#'
-#' # it also supports groups (don't forget to use the group var on `x` or `facet`):
-#' example_isolates %>%
-#'   select(hospital_id, AMX, NIT, FOS, TMP, CIP) %>%
-#'   group_by(hospital_id) %>%
-#'   ggplot_rsi(x = "hospital_id",
-#'              facet = "antibiotic",
-#'              nrow = 1,
-#'              title = "AMR of Anti-UTI Drugs Per Hospital",
-#'              x.title = "Hospital",
-#'              datalabels = FALSE)
 #' }
 ggplot_rsi <- function(data,
                        position = NULL,