Merge branch 'main' into em-patch-5-15-24

R/check_pop_data.R

@@ -6,31 +6,36 @@
 #' @export
 #' @examples
 #' library(dplyr)
+#' xs_data <- readr::read_rds("https://osf.io/download//n6cp3/") %>%
+#'             as_pop_data()
+#'   check_pop_data(xs_data, verbose = TRUE)
 #'
-#' xs_data <- load_pop_data("https://osf.io/download//n6cp3/") %>%
-#'   check_pop_data()
-#'
-check_pop_data <- function(pop_data,
-                           verbose = FALSE) {
+check_pop_data <- function(pop_data, verbose = FALSE) {
   if (!is.data.frame(pop_data)) {
-    cli::cli_abort(message = .pasteN(
-      "Argument `pop_data` is not a `data.frame()`.",
-      "Provide a `data.frame()` with cross-sectional serology data per antigen isotype."
-    ))
+    cli::cli_abort(
+      class = "not a data.frame",
+      message = c(
+        "Argument `pop_data` is not a `data.frame()`.",
+        "Provide a `data.frame()` with cross-sectional serology data per antigen isotype."
+      )
+    )
   }
 
   missing_age <- is.element(attributes(pop_data)$age_var, names(pop_data))
 
   if (!missing_age) {
-    cli::cli_abort(message = paste("Argument `pop_data` is missing column", attributes(pop_data)$age_var,  "(age, in years)"))
+    "Argument {.arg pop_data} is missing column {.var {attributes(pop_data)$age_var}} (age, in years)" %>%
+      cli::cli_abort(class = "missing-var")
   }
 
   missing_value <- is.element(attributes(pop_data)$value_var, names(pop_data))
 
   if (!missing_value) {
-    cli::cli_abort(message = paste("Argument `pop_data` is missing column", attributes(pop_data)$value_var, "(antibody measurement)"))
+    "Argument {.arg pop_data} is missing column {.var {pop_data %>% get_value_var()}} (antibody measurement)" %>%
+      cli::cli_abort(class = "missing-var")
   }
 
-  if(verbose) message("data format is as expected.")
+  if (verbose)
+    cli::cli_inform("data format is as expected.")
   invisible(NULL)
 }

R/df_to_array.R

@@ -33,8 +33,9 @@ df.to.array <- function(
 #'     cols = c("Sepal.Length", "Sepal.Width", "Petal.Width", "Petal.Length")
 #'   ) %>%
 #'   mutate(parameter = factor(parameter, levels = unique(parameter)))
-#' df %>% serocalculator:::df.to.array(dim_var_names = c("parameter", "Species"))
-#'
+#' arr <- df %>% serocalculator:::df.to.array(dim_var_names = c("parameter", "Species"))
+#' ftable(arr[,,1:5])
+#' @noRd
 df_to_array <- function(
     df,
     dim_var_names,

tests/testthat/test-check_pop_data.R

@@ -0,0 +1,22 @@
+test_that("`check_pop_data()` works", {
+  library(dplyr)
+  xs_data <- readr::read_rds("https://osf.io/download//n6cp3/") %>%
+    as_pop_data()
+
+  xs_data %>% check_pop_data() |>
+    expect_no_condition()
+
+  xs_data %>% check_pop_data(verbose = TRUE) |>
+    expect_message("data format is as expected.")
+
+  xs_data_no_age = xs_data %>% select(-age)
+  xs_data_no_age %>% check_pop_data() |>
+    expect_error(class = "missing-var")
+
+  xs_data_no_value = xs_data %>% select(-value)
+  xs_data_no_value %>% check_pop_data() |>
+    expect_error(class = "missing-var")
+
+  "string" %>% check_pop_data() |>
+    expect_error(class = "not a data.frame")
+})