send message to user when no incorrect subject id was found

epiverse-trace · Feb 7, 2025 · fd7efb3 · fd7efb3
1 parent 4f1c1df
commit fd7efb3
Show file tree

Hide file tree

Showing 2 changed files with 33 additions and 16 deletions.
diff --git a/R/standardize_subject_ids.R b/R/standardize_subject_ids.R
@@ -80,24 +80,32 @@ check_subject_ids <- function(data,
     bad_rows <- c(bad_rows, which(!nchar(data[[target_columns]]) == nchar))
   }
 
-  # remove the incorrect rows
-  if (length(bad_rows) > 0) {
-    bad_rows <- sort(unique(bad_rows))
-    tmp_report <- data.frame(
-      idx = bad_rows,
-      ids = data[[target_columns]][bad_rows]
-    )
-    cli::cli_inform(c(
-      "!" = tr_("Detected invalid subject {cli::qty(length(bad_rows))} id{?s} at line{?s}: {.val {toString(bad_rows)}}."), # nolint: line_length_linter
-      i = tr_("You can use the {.fn correct_subject_ids} function to correct {cli::qty(length(bad_rows))} {?it/them}.") # nolint: line_length_linter
-    ))
-    data <- add_to_report(
-      x = data,
-      key = "incorrect_subject_id",
-      value = tmp_report
+  # when all subject ids comply with the expected format,
+  # send a message that no incorrect subject ids was found
+  if (length(bad_rows) == 0) {
+    cli::cli_alert_info(
+      tr_("No incorrect subject id was detected.")
     )
+    return(data)
   }
 
+  # determine row indices with incorrect subject ids, and
+  # report them
+  bad_rows <- sort(unique(bad_rows))
+  tmp_report <- data.frame(
+    idx = bad_rows,
+    ids = data[[target_columns]][bad_rows]
+  )
+  cli::cli_inform(c(
+    "!" = tr_("Detected {.val {length(bad_rows)}} invalid subject id{?s} at line{?s}: {.val {toString(bad_rows)}}."), # nolint: line_length_linter
+    i = tr_("You can use the {.fn correct_subject_ids} function to correct {cli::qty(length(bad_rows))} {?it/them}.") # nolint: line_length_linter
+  ))
+  data <- add_to_report(
+    x = data,
+    key = "incorrect_subject_id",
+    value = tmp_report
+  )
+
   return(data)
 }
 

diff --git a/tests/testthat/test-standardize_subject_ids.R b/tests/testthat/test-standardize_subject_ids.R
@@ -116,7 +116,7 @@ test_that("check_subject_ids sends a message when duplicated IDs are found", {
   )
 })
 
-test_that("check_subject_ids when the id column is numeric", {
+test_that("check_subject_ids works when the id column is numeric", {
   data <- readRDS(system.file("extdata", "test_df.RDS", package = "cleanepi"))
   data[["case_id"]] <- seq_len(nrow(data))
   dat <- check_subject_ids(data = data,
@@ -126,6 +126,15 @@ test_that("check_subject_ids when the id column is numeric", {
   expect_true(nrow(data) == nrow(dat))
 })
 
+test_that("check_subject_ids sends a message when no incorrect id was found", {
+  data <- readRDS(system.file("extdata", "test_df.RDS", package = "cleanepi"))
+  data[["case_id"]] <- seq_len(nrow(data))
+  expect_message(
+    check_subject_ids(data = data, target_columns = "case_id"),
+    regexp = cat("No incorrect subject id was detected.")
+  )
+})
+
 data <- readRDS(system.file("extdata", "test_df.RDS", package = "cleanepi"))
 test_that("check_subject_ids works when relying on the nchar argument", {
   dat <- check_subject_ids(