commit to unstale branch

DESCRIPTION

@@ -43,7 +43,7 @@ Imports:
     rlang (>= 1.0.3),
     magrittr,
     scales (>= 1.2.1),
-    testthat (>= 3.1.6),
+    testthat (>= 3.2.0),
     tibble (>= 3.1.8),
     tidyr (>= 1.3.0),
     tidyselect (>= 1.2.0),
@@ -69,3 +69,4 @@ Suggests:
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
 Config/testthat/parallel: true
+Config/testthat/start-first: expectation_fns, scan_data,tidyselect_fails_safely_batch,test_fns

R/col_vals_between.R

@@ -428,6 +428,11 @@ col_vals_between <- function(
 
   agent <- x
 
+  # Avoid rlang (>= 0.3.0) soft deprecation warning
+  # Quosure lists can't be concatenated with objects other than quosures.
+  left <- as.list(left)
+  right <- as.list(right)
+
   if (is.null(brief)) {
 
     brief <- 

R/col_vals_not_between.R

@@ -431,6 +431,12 @@ col_vals_not_between <- function(
 
   agent <- x
 
+  # Avoid rlang (>= 0.3.0) soft deprecation warning
+  # Quosure lists can't be concatenated with objects other than quosures
+
+  left <- as.list(left)
+  right <- as.list(right)
+
   if (is.null(brief)) {
 
     brief <- 

R/get_agent_report.R

@@ -1682,8 +1682,8 @@ get_agent_report <- function(
         "eval_sym", "W", "S", "N", "extract"
       )
     ) %>%
-    gt_missing(columns = c("columns", "values", "units", "extract")) %>%
-    gt_missing(columns = "status_color", missing_text = "") %>%
+    gt::sub_missing(columns = c("columns", "values", "units", "extract")) %>%
+    gt::sub_missing(columns = "status_color", missing_text = "") %>%
     gt::cols_hide(columns = c("W_val", "S_val", "N_val", "active", "eval")) %>%
     gt::text_transform(
       locations = gt::cells_body(columns = "units"),

R/get_multiagent_report.R

@@ -809,7 +809,7 @@ get_multiagent_report <- function(
     ) %>%
     gt::fmt_markdown(columns = 2:n_columns) %>%
     gt::fmt_markdown(columns = "sha1") %>%
-    gt_missing(
+    gt::sub_missing(
       columns = columns_used_tbl,
       missing_text = gt::html(
         as.character(
@@ -824,7 +824,7 @@ get_multiagent_report <- function(
         )
       )
     ) %>%
-    gt_missing(
+    gt::sub_missing(
       columns = columns_not_used,
       missing_text = ""
     ) %>%

R/get_sundered_data.R

@@ -382,13 +382,13 @@ get_sundered_data <- function(
       tbl_check_join <- 
         tbl_check_join %>%
         dplyr::select(
-          dplyr::one_of(by_cols), dplyr::starts_with("pb_is_good_")
+          dplyr::all_of(by_cols), dplyr::starts_with("pb_is_good_")
         ) %>%
         dplyr::left_join(
           tbl_check_join_r %>%
             dplyr::rename(!!new_col_ii := pb_is_good_) %>%
             dplyr::select(
-              dplyr::one_of(by_cols), dplyr::starts_with("pb_is_good_")
+              dplyr::all_of(by_cols), dplyr::starts_with("pb_is_good_")
             ),
           by = by_cols
         ) %>%
@@ -425,7 +425,7 @@ get_sundered_data <- function(
   tbl_check_join <- 
     tbl_check_join %>%
     dplyr::mutate(pb_is_good_ = !!rlang::parse_expr(columns_str_add)) %>%
-    dplyr::select(-dplyr::one_of(columns_str_vec)) %>%
+    dplyr::select(-dplyr::all_of(columns_str_vec)) %>%
     dplyr::mutate(pb_is_good_ = dplyr::case_when(
       pb_is_good_ == validation_n ~ TRUE,
       TRUE ~ FALSE

R/incorporate.R

@@ -166,7 +166,12 @@ incorporate <- function(informant) {
 
   # Get the target table for this informant object
   # TODO: extend the materialize table function to use an agent or informant
-  tbl <- informant$tbl
+  if (rlang::has_name(informant, "tbl")) {
+    # Avoid partial matching
+    tbl <- informant$tbl
+  } else {
+    tbl <- informant$tbl_name
+  }
   tbl_name <- informant$tbl_name
   read_fn <- informant$read_fn
 

R/interrogate.R

@@ -426,7 +426,7 @@ interrogate <- function(
 
         tbl_checked %>%
           dplyr::mutate(pb_is_good_ = !!rlang::parse_expr(columns_str_add)) %>%
-          dplyr::select(-dplyr::one_of(columns_str_vec)) %>%
+          dplyr::select(-dplyr::all_of(columns_str_vec)) %>%
           dplyr::mutate(pb_is_good_ = dplyr::case_when(
             pb_is_good_ == validation_n ~ TRUE,
             TRUE ~ FALSE
@@ -3331,9 +3331,9 @@ add_table_extract <- function(
   ) {
 
     problem_rows <-
-      dplyr::sample_n(
-        tbl = problem_rows,
-        size = sample_n,
+      dplyr::slice_sample(
+        problem_rows,
+        n = sample_n,
         replace = FALSE) %>%
       dplyr::as_tibble()
 
@@ -3345,9 +3345,9 @@ add_table_extract <- function(
   ) {
 
     problem_rows <-
-      dplyr::sample_frac(
-        tbl = problem_rows,
-        size = sample_frac,
+      dplyr::slice_sample(
+        problem_rows,
+        prop = sample_frac,
         replace = FALSE) %>%
       dplyr::as_tibble() %>%
       utils::head(sample_limit)

R/scan_data.R

@@ -809,7 +809,7 @@ get_common_values_gt <- function(
         n = get_lsv("table_scan/tbl_lab_count")[[lang]],
         frequency = get_lsv("table_scan/tbl_lab_frequency")[[lang]],
       ) %>%
-      gt_missing(columns = "value", missing_text = "**NA**") %>%
+      gt::sub_missing(columns = "value", missing_text = "**NA**") %>%
       gt::text_transform(
         locations = gt::cells_body(columns = "value"),
         fn = function(x) {
@@ -847,7 +847,7 @@ get_common_values_gt <- function(
         n = get_lsv("table_scan/tbl_lab_count")[[lang]],
         frequency = get_lsv("table_scan/tbl_lab_frequency")[[lang]],
       ) %>%
-      gt_missing(columns = "value", missing_text = "**NA**") %>%
+      gt::sub_missing(columns = "value", missing_text = "**NA**") %>%
       gt::text_transform(
         locations = gt::cells_body(columns = "value"),
         fn = function(x) ifelse(x == "**NA**", "<code>NA</code>", x)
@@ -1301,7 +1301,7 @@ probe_interactions <- function(data) {
       columns_char, FUN.VALUE = integer(1), USE.NAMES = FALSE,
       FUN = function(x) {
         data %>%
-          dplyr::select(dplyr::one_of(x)) %>%
+          dplyr::select(dplyr::all_of(x)) %>%
           dplyr::distinct() %>%
           dplyr::count() %>%
           dplyr::pull(n)
@@ -1317,7 +1317,7 @@ probe_interactions <- function(data) {
   # Create a ggplot2 plot matrix with the data
   plot_matrix <-
     data %>%
-    dplyr::select(dplyr::one_of(col_names)) %>%
+    dplyr::select(dplyr::all_of(col_names)) %>%
     ggplot2::ggplot(ggplot2::aes(x = .panel_x, y = .panel_y)) + 
     ggplot2::geom_point(alpha = 0.50, shape = 16, size = 1) + 
     ggforce::geom_autodensity() +
@@ -1388,7 +1388,7 @@ probe_correlations <- function(data) {
     )
   }
 
-  data_corr <- dplyr::select(data, dplyr::one_of(columns_numeric))
+  data_corr <- dplyr::select(data, dplyr::all_of(columns_numeric))
 
   corr_pearson <- 
     stats::cor(data_corr, method = "pearson", use = "pairwise.complete.obs")
@@ -1539,7 +1539,7 @@ probe_sample <- function(data) {
   probe_sample <-
     data %>%
     gt::gt_preview(top_n = 5, bottom_n = 5) %>%
-    gt_missing(columns = gt::everything(), missing_text = "**NA**") %>%
+    gt::sub_missing(columns = gt::everything(), missing_text = "**NA**") %>%
     gt::text_transform(
       locations = gt::cells_body(columns = gt::everything()),
       fn = function(x) ifelse(x == "**NA**", "<code>NA</code>", x)

R/utils-profiling.R

@@ -384,7 +384,7 @@ get_tbl_dbi_missing_tbl <- function(data) {
 
               missing_n_span <- 
                 data %>% 
-                dplyr::select(1, dplyr::one_of(x__))
+                dplyr::select(1, dplyr::all_of(x__))
 
               if (ncol(missing_n_span) == 1) {
 
@@ -460,7 +460,7 @@ get_tbl_df_missing_tbl <- function(data) {
       col_names,
       FUN = function(x__) {
 
-        data <- dplyr::select(data, dplyr::one_of(x__))
+        data <- dplyr::select(data, dplyr::all_of(x__))
         data <- tibble::rowid_to_column(data)
         data <- 
           dplyr::mutate(data, `::cut_group::` = dplyr::case_when(
@@ -524,7 +524,7 @@ get_missing_by_column_tbl <- function(data) {
       col_names,
       FUN = function(x__) {
 
-        data <- dplyr::select(data, dplyr::one_of(x__))
+        data <- dplyr::select(data, dplyr::all_of(x__))
         data <- dplyr::group_by(data)
         data <- 
           dplyr::summarize_all(
@@ -617,7 +617,7 @@ get_table_slice_gt <- function(data_column,
   data_column %>%
     gt::gt() %>%
     gt::fmt_percent(columns = 3, locale = locale) %>%
-    gt_missing(columns = 1, missing_text = "**NA**") %>%
+    gt::sub_missing(columns = 1, missing_text = "**NA**") %>%
     gt::text_transform(
       locations = gt::cells_body(columns = 1),
       fn = function(x) ifelse(x == "**NA**", "<code>NA</code>", x)

R/utils.R

@@ -1643,13 +1643,6 @@ print_time <- function(time_diff_s) {
   )
 }
 
-gt_missing <- 
-  if (utils::packageVersion("gt") >= "0.6.0") {
-    gt::sub_missing 
-  } else {
-    gt::fmt_missing
-  }
-
 pb_get_image_tag <- function(file, dir = "images") {
 
   repo_url <- "https://raw.githubusercontent.com/rstudio/pointblank/main"
@@ -1691,6 +1684,10 @@ pb_get_image_tag <- function(file, dir = "images") {
 deparse_expr <- function(expr, collapse = " ", ...) {
   if (rlang::is_scalar_atomic(expr)) {
     as.character(expr)
+  } else if (rlang::is_quosure(expr)) {
+    expr <- rlang::quo_get_expr(expr)
+    deparsed <- paste(deparse(expr, ...), collapse = collapse)
+    paste("<expr>", deparsed)
   } else {
     deparsed <- paste(deparse(expr, ...), collapse = collapse)
     paste("<expr>", deparsed)

tests/testthat/_snaps/interrogate_with_agent.md

@@ -1,7 +1,7 @@
 # Select validation steps can be `active` or not
 
     Code
-      small_table %>% col_is_character(columns = vars(b), actions = al) %>%
+      obj <- small_table %>% col_is_character(columns = vars(b), actions = al) %>%
         col_is_numeric(columns = vars(a), actions = al) %>% col_is_posix(columns = vars(
         date_time), actions = al) %>% col_is_date(columns = vars(date), actions = al) %>%
         col_is_integer(columns = vars(a), actions = al) %>% col_is_logical(columns = vars(
@@ -71,21 +71,4 @@
       Exceedance of failed test units where there should have been conjoint 'pass' units across the following expressions: `~col_vals_gt(., columns = vars(a), value = 1)`, `~col_vals_lt(., columns = vars(c), value = 10, na_pass = TRUE)`, `~col_vals_not_null(., columns = vars(d))`.
       The `conjointly()` validation failed beyond the absolute threshold level (1).
       * failure level (1) >= failure threshold (1)
-    Output
-      # A tibble: 13 x 8
-         date_time           date           a b             c      d e     f    
-         <dttm>              <date>     <int> <chr>     <dbl>  <dbl> <lgl> <chr>
-       1 2016-01-04 11:00:00 2016-01-04     2 1-bcd-345     3  3423. TRUE  high 
-       2 2016-01-04 00:32:00 2016-01-04     3 5-egh-163     8 10000. TRUE  low  
-       3 2016-01-05 13:32:00 2016-01-05     6 8-kdg-938     3  2343. TRUE  high 
-       4 2016-01-06 17:23:00 2016-01-06     2 5-jdo-903    NA  3892. FALSE mid  
-       5 2016-01-09 12:36:00 2016-01-09     8 3-ldm-038     7   284. TRUE  low  
-       6 2016-01-11 06:15:00 2016-01-11     4 2-dhe-923     4  3291. TRUE  mid  
-       7 2016-01-15 18:46:00 2016-01-15     7 1-knw-093     3   843. TRUE  high 
-       8 2016-01-17 11:27:00 2016-01-17     4 5-boe-639     2  1036. FALSE low  
-       9 2016-01-20 04:30:00 2016-01-20     3 5-bce-642     9   838. FALSE high 
-      10 2016-01-20 04:30:00 2016-01-20     3 5-bce-642     9   838. FALSE high 
-      11 2016-01-26 20:07:00 2016-01-26     4 2-dmx-010     7   834. TRUE  low  
-      12 2016-01-28 02:51:00 2016-01-28     2 7-dmx-010     8   108. FALSE low  
-      13 2016-01-30 11:23:00 2016-01-30     1 3-dka-303    NA  2230. TRUE  high 
 

tests/testthat/test-get_informant_report.R

@@ -5,7 +5,7 @@ test_that("Getting an information report is possible", {
   # `incorporate()` the snippets into the info text
   informant <- 
     create_informant(
-      tbl = ~ readr::read_csv(file = "test_table.csv", col_types = "TDdcddlc"),
+      tbl = ~ readr::read_csv(file = test_path("test_table.csv"), col_types = "TDdcddlc"),
       tbl_name = "test_table",
       label = "An example."
     ) %>%
@@ -54,7 +54,7 @@ test_that("Getting a more advanced information report is possible", {
 
   informant <- 
     create_informant(
-      tbl = ~ readr::read_csv(file = "penguins.csv", col_types = "ccddddcd"),
+      tbl = ~ readr::read_csv(file = test_path("penguins.csv"), col_types = "ccddddcd"),
       tbl_name = "penguins",
       label = "The `penguins` dataset from the **palmerpenguins** 📦."
     ) %>% 

tests/testthat/test-incorporate_with_informant.R

@@ -5,7 +5,7 @@ test_that("Incorporating an informant yields the correct results", {
   # `incorporate()` the snippets into the info text
   informant <- 
     create_informant(
-      tbl = ~ readr::read_csv(file = "test_table.csv", col_types = "TDdcddlc"),
+      tbl = ~ readr::read_csv(file = testthat::test_path("test_table.csv"), col_types = "TDdcddlc"),
       tbl_name = "test_table",
       label = "An example."
     ) %>%
@@ -41,14 +41,11 @@ test_that("Incorporating an informant yields the correct results", {
 
   # Expect that names in an informant after using
   # `incorporate()` match a prescribed set of names
-  expect_true(
-    all(
-      names(informant_inc) ==
-        c(
-          "tbl", "read_fn", "tbl_name", "info_label",
-          "meta_snippets",  "lang", "locale",
-          "metadata", "metadata_rev"
-        )
+  expect_named(
+    informant_inc,
+    c(
+      "tbl", "read_fn", "tbl_name", "info_label", "meta_snippets", "lang",
+      "locale", "metadata", "metadata_rev"
     )
   )
 
@@ -74,7 +71,7 @@ test_that("Incorporating an informant yields the correct results", {
   expect_no_error(
     informant %>% 
       set_tbl(
-        tbl = function() readr::read_csv(file = "test_table.csv", col_types = "TDdcddlc")
+        tbl = function() readr::read_csv(file = testthat::test_path("test_table.csv"), col_types = "TDdcddlc")
       ) %>% 
       incorporate()
   )
@@ -87,7 +84,7 @@ test_that("Incorporating an informant yields the correct results", {
   informant_inc_2 <- 
     informant_inc %>%
     set_tbl(
-      tbl = ~ readr::read_csv(file = "test_table_2.csv", col_types = "TDdcddlcd")
+      tbl = ~ readr::read_csv(file = test_path("test_table_2.csv"), col_types = "TDdcddlcd")
     ) %>%
     incorporate()
 
@@ -109,7 +106,7 @@ test_that("Incorporating an informant from YAML yields the correct results", {
   # add information with some other `info_*()` functions
   informant <- 
     create_informant(
-      tbl = ~ readr::read_csv(file = "test_table.csv", col_types = "TDdcddlc"),
+      tbl = ~ readr::read_csv(file = test_path("test_table.csv"), col_types = "TDdcddlc"),
       tbl_name = "test_table",
       label = "An example."
     ) %>%
@@ -182,7 +179,7 @@ test_that("Incorporating an informant from YAML yields the correct results", {
   expect_no_error(
     informant_inc_yaml %>% 
       set_tbl(
-        tbl = function() readr::read_csv(file = "test_table.csv", col_types = "TDdcddlc")
+        tbl = function() readr::read_csv(file = test_path("test_table.csv"), col_types = "TDdcddlc")
       ) %>% 
       incorporate()
   )

tests/testthat/test-util_functions.R

@@ -32,9 +32,9 @@ test_that("Utility functions won't fail us", {
   agent %>% get_assertion_type_at_idx(idx = 1) %>% expect_equal("col_vals_gt")
   agent %>% get_assertion_type_at_idx(idx = 2) %>% expect_equal("col_vals_lt")
 
-  agent %>% get_column_as_sym_at_idx(idx = 1) %>% expect_s3_class("name")
+  agent %>% get_column_as_sym_at_idx(idx = 1) %>% class() %>% expect_equal("name")
   agent %>% get_column_as_sym_at_idx(idx = 1) %>% as.character() %>% expect_equal("c")
-  agent %>% get_column_as_sym_at_idx(idx = 2) %>% expect_s3_class("name")
+  agent %>% get_column_as_sym_at_idx(idx = 2) %>% class() %>% expect_equal("name")
   agent %>% get_column_as_sym_at_idx(idx = 2) %>% as.character() %>% expect_equal("d")
 
   agent %>% get_values_at_idx(idx = 1) %>% expect_type("double")
@@ -101,7 +101,8 @@ test_that("Utility functions won't fail us", {
   expect_type(cs, "list")
   expect_equal(names(cs), col_names)
   expect_equal(unname(cs), col_types)
-  expect_equal(length(cs), length(col_names), length(col_types))
+  expect_equal(length(cs), length(col_names))
+  expect_equal(length(cs), length(col_types))
 
   #
   # normalize_step_id