From 8ef81a530c2a9f666f8896a0b48369fd3e13f6d6 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Fri, 24 Jan 2025 13:37:08 -0500 Subject: [PATCH 1/8] classed briefs in resolve_brief() --- R/utils.R | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index e47881f74..c07203892 100644 --- a/R/utils.R +++ b/R/utils.R @@ -248,7 +248,9 @@ resolve_brief <- function(brief, agent, n_combinations <- n_columns * n_segments # If missing, apply auto-brief - if (is.null(brief)) { + brief_cls <- class(brief) + use_autobrief <- is.null(brief) + if (use_autobrief) { brief <- generate_autobriefs( agent = agent, columns = columns, preconditions = preconditions, values = values, @@ -270,7 +272,15 @@ resolve_brief <- function(brief, agent, # Recycle the string brief <- rep_len(brief, n_combinations) # Return packed vector/matrix for iteration over steps - pack_by_col_seg(brief, n_columns, n_segments, c(columns, segments)) + brief <- pack_by_col_seg(brief, n_columns, n_segments, c(columns, segments)) + + if (use_autobrief) { + class(brief) <- "autobrief" + } else { + class(brief) <- brief_cls + } + + brief } From 92cd3b852eaad17021feb8e635b25a3ebb8ac2a4 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Fri, 24 Jan 2025 13:40:21 -0500 Subject: [PATCH 2/8] preserve class when iterating over briefs --- R/col_exists.R | 2 +- R/col_is_character.R | 2 +- R/col_is_date.R | 2 +- R/col_is_factor.R | 2 +- R/col_is_integer.R | 2 +- R/col_is_logical.R | 2 +- R/col_is_numeric.R | 2 +- R/col_is_posix.R | 2 +- R/col_vals_between.R | 2 +- R/col_vals_decreasing.R | 2 +- R/col_vals_equal.R | 2 +- R/col_vals_expr.R | 2 +- R/col_vals_gt.R | 2 +- R/col_vals_gte.R | 2 +- R/col_vals_in_set.R | 2 +- R/col_vals_increasing.R | 2 +- R/col_vals_lt.R | 2 +- R/col_vals_lte.R | 2 +- R/col_vals_make_set.R | 2 +- R/col_vals_make_subset.R | 2 +- R/col_vals_not_between.R | 2 +- R/col_vals_not_equal.R | 2 +- R/col_vals_not_in_set.R | 2 +- R/col_vals_not_null.R | 2 +- R/col_vals_null.R | 2 +- R/col_vals_regex.R | 2 +- R/col_vals_within_spec.R | 2 +- R/conjointly.R | 2 +- R/row_count_match.R | 2 +- R/rows_complete.R | 2 +- R/rows_distinct.R | 2 +- R/serially.R | 2 +- R/specially.R | 2 +- R/tbl_match.R | 2 +- 34 files changed, 34 insertions(+), 34 deletions(-) diff --git a/R/col_exists.R b/R/col_exists.R index 986c9e0e3..39e58556f 100644 --- a/R/col_exists.R +++ b/R/col_exists.R @@ -311,7 +311,7 @@ col_exists <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/col_is_character.R b/R/col_is_character.R index 6d34e92a8..d5f26e219 100644 --- a/R/col_is_character.R +++ b/R/col_is_character.R @@ -302,7 +302,7 @@ col_is_character <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/col_is_date.R b/R/col_is_date.R index 351e70da6..652b485da 100644 --- a/R/col_is_date.R +++ b/R/col_is_date.R @@ -294,7 +294,7 @@ col_is_date <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/col_is_factor.R b/R/col_is_factor.R index 0e8a3350c..b0f4f6148 100644 --- a/R/col_is_factor.R +++ b/R/col_is_factor.R @@ -300,7 +300,7 @@ col_is_factor <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/col_is_integer.R b/R/col_is_integer.R index 0796f8900..f8f76cade 100644 --- a/R/col_is_integer.R +++ b/R/col_is_integer.R @@ -298,7 +298,7 @@ col_is_integer <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/col_is_logical.R b/R/col_is_logical.R index c6832e161..b83121d7e 100644 --- a/R/col_is_logical.R +++ b/R/col_is_logical.R @@ -295,7 +295,7 @@ col_is_logical <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/col_is_numeric.R b/R/col_is_numeric.R index 459b4ee1e..55f33c189 100644 --- a/R/col_is_numeric.R +++ b/R/col_is_numeric.R @@ -295,7 +295,7 @@ col_is_numeric <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/col_is_posix.R b/R/col_is_posix.R index 229d8c873..e469d9dfb 100644 --- a/R/col_is_posix.R +++ b/R/col_is_posix.R @@ -295,7 +295,7 @@ col_is_posix <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/col_vals_between.R b/R/col_vals_between.R index d0715a8f7..f614ba4b2 100644 --- a/R/col_vals_between.R +++ b/R/col_vals_between.R @@ -475,7 +475,7 @@ col_vals_between <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_decreasing.R b/R/col_vals_decreasing.R index d8545fd97..7276770ec 100644 --- a/R/col_vals_decreasing.R +++ b/R/col_vals_decreasing.R @@ -455,7 +455,7 @@ col_vals_decreasing <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_equal.R b/R/col_vals_equal.R index fa81a154b..bd4a659f5 100644 --- a/R/col_vals_equal.R +++ b/R/col_vals_equal.R @@ -407,7 +407,7 @@ col_vals_equal <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_expr.R b/R/col_vals_expr.R index ab8f930fb..ded8e60b9 100644 --- a/R/col_vals_expr.R +++ b/R/col_vals_expr.R @@ -407,7 +407,7 @@ col_vals_expr <- function( actions = covert_actions(actions, agent), step_id = step_id, label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/col_vals_gt.R b/R/col_vals_gt.R index 07b64c80e..430e71605 100644 --- a/R/col_vals_gt.R +++ b/R/col_vals_gt.R @@ -529,7 +529,7 @@ col_vals_gt <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_gte.R b/R/col_vals_gte.R index 2588a08b2..8dcfd6f8f 100644 --- a/R/col_vals_gte.R +++ b/R/col_vals_gte.R @@ -406,7 +406,7 @@ col_vals_gte <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_in_set.R b/R/col_vals_in_set.R index 37cbdde20..13aa06595 100644 --- a/R/col_vals_in_set.R +++ b/R/col_vals_in_set.R @@ -398,7 +398,7 @@ col_vals_in_set <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_increasing.R b/R/col_vals_increasing.R index 1b55db9c8..8dc0de4ec 100644 --- a/R/col_vals_increasing.R +++ b/R/col_vals_increasing.R @@ -443,7 +443,7 @@ col_vals_increasing <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_lt.R b/R/col_vals_lt.R index 179c64ef6..dd206711e 100644 --- a/R/col_vals_lt.R +++ b/R/col_vals_lt.R @@ -408,7 +408,7 @@ col_vals_lt <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_lte.R b/R/col_vals_lte.R index 7d21a5a65..74ac42d4a 100644 --- a/R/col_vals_lte.R +++ b/R/col_vals_lte.R @@ -409,7 +409,7 @@ col_vals_lte <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_make_set.R b/R/col_vals_make_set.R index caab56fd2..1277acd5b 100644 --- a/R/col_vals_make_set.R +++ b/R/col_vals_make_set.R @@ -400,7 +400,7 @@ col_vals_make_set <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_make_subset.R b/R/col_vals_make_subset.R index 23106f1cf..8b8491735 100644 --- a/R/col_vals_make_subset.R +++ b/R/col_vals_make_subset.R @@ -397,7 +397,7 @@ col_vals_make_subset <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_not_between.R b/R/col_vals_not_between.R index d23982593..a653f36a3 100644 --- a/R/col_vals_not_between.R +++ b/R/col_vals_not_between.R @@ -478,7 +478,7 @@ col_vals_not_between <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_not_equal.R b/R/col_vals_not_equal.R index 052fe586f..56b5be348 100644 --- a/R/col_vals_not_equal.R +++ b/R/col_vals_not_equal.R @@ -406,7 +406,7 @@ col_vals_not_equal <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_not_in_set.R b/R/col_vals_not_in_set.R index 3f8fc1348..40eda2802 100644 --- a/R/col_vals_not_in_set.R +++ b/R/col_vals_not_in_set.R @@ -394,7 +394,7 @@ col_vals_not_in_set <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_not_null.R b/R/col_vals_not_null.R index 44129a0b4..6c04adaa5 100644 --- a/R/col_vals_not_null.R +++ b/R/col_vals_not_null.R @@ -383,7 +383,7 @@ col_vals_not_null <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_null.R b/R/col_vals_null.R index ee1814340..69172e3b6 100644 --- a/R/col_vals_null.R +++ b/R/col_vals_null.R @@ -382,7 +382,7 @@ col_vals_null <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_regex.R b/R/col_vals_regex.R index f961a16f7..105111464 100644 --- a/R/col_vals_regex.R +++ b/R/col_vals_regex.R @@ -400,7 +400,7 @@ col_vals_regex <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/col_vals_within_spec.R b/R/col_vals_within_spec.R index 1557481f4..d9817fb8b 100644 --- a/R/col_vals_within_spec.R +++ b/R/col_vals_within_spec.R @@ -465,7 +465,7 @@ col_vals_within_spec <- function( actions = covert_actions(actions, agent), step_id = step_id[i], label = label[[i, j]], - brief = brief[[i, j]], + brief = brief[i, j], active = active ) } diff --git a/R/conjointly.R b/R/conjointly.R index 5f203832c..8d9620cea 100644 --- a/R/conjointly.R +++ b/R/conjointly.R @@ -442,7 +442,7 @@ conjointly <- function( actions = covert_actions(actions, agent), step_id = step_id, label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/row_count_match.R b/R/row_count_match.R index c382688d4..bb4846e06 100644 --- a/R/row_count_match.R +++ b/R/row_count_match.R @@ -402,7 +402,7 @@ row_count_match <- function( actions = covert_actions(actions, agent), step_id = step_id, label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/rows_complete.R b/R/rows_complete.R index 9dce015df..3ffcf551f 100644 --- a/R/rows_complete.R +++ b/R/rows_complete.R @@ -373,7 +373,7 @@ rows_complete <- function( actions = covert_actions(actions, agent), step_id = step_id, label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/rows_distinct.R b/R/rows_distinct.R index c7096f5ee..6819b3add 100644 --- a/R/rows_distinct.R +++ b/R/rows_distinct.R @@ -374,7 +374,7 @@ rows_distinct <- function( actions = covert_actions(actions, agent), step_id = step_id, label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/serially.R b/R/serially.R index bda525014..e8f8121b3 100644 --- a/R/serially.R +++ b/R/serially.R @@ -682,7 +682,7 @@ serially <- function( actions = covert_actions(actions, agent), step_id = step_id, label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/specially.R b/R/specially.R index 548f7f161..dfdf0ce69 100644 --- a/R/specially.R +++ b/R/specially.R @@ -397,7 +397,7 @@ specially <- function( actions = covert_actions(actions, agent), step_id = step_id, label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } diff --git a/R/tbl_match.R b/R/tbl_match.R index a270c5dba..b77c8905f 100644 --- a/R/tbl_match.R +++ b/R/tbl_match.R @@ -373,7 +373,7 @@ tbl_match <- function( actions = covert_actions(actions, agent), step_id = step_id, label = label[[i]], - brief = brief[[i]], + brief = brief[i], active = active ) } From 0c31e26bfc2cb77422235134730e9a79f021336c Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Fri, 24 Jan 2025 13:48:16 -0500 Subject: [PATCH 3/8] fix typo --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index c07203892..b948c6902 100644 --- a/R/utils.R +++ b/R/utils.R @@ -272,7 +272,7 @@ resolve_brief <- function(brief, agent, # Recycle the string brief <- rep_len(brief, n_combinations) # Return packed vector/matrix for iteration over steps - brief <- pack_by_col_seg(brief, n_columns, n_segments, c(columns, segments)) + brief <- pack_by_col_seg(brief, n_columns, n_segments, c(columns, segments_list)) if (use_autobrief) { class(brief) <- "autobrief" From f5baa1da53093bd0135fb2be135f81a53a15e159 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Fri, 24 Jan 2025 13:48:27 -0500 Subject: [PATCH 4/8] track brief class --- R/steps_and_briefs.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/steps_and_briefs.R b/R/steps_and_briefs.R index a98e30e2f..ab12bea91 100644 --- a/R/steps_and_briefs.R +++ b/R/steps_and_briefs.R @@ -82,6 +82,7 @@ create_validation_step <- function( actions = ifelse(is.null(actions), list(NULL), list(actions)), label = ifelse(is.null(label), NA_character_, as.character(label)), brief = ifelse(is.null(brief), NA_character_, as.character(brief)), + brief_cls = as.character(class(.env$brief)[1]), active = ifelse(is.null(active), list(NULL), list(active)), eval_active = NA, eval_error = NA, From 3c5b1d208df4a563098258aaafcd5c63248b4a8f Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Fri, 24 Jan 2025 13:51:12 -0500 Subject: [PATCH 5/8] update test to account for brief_cls column in validation set --- tests/testthat/test-x_list.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-x_list.R b/tests/testthat/test-x_list.R index a56101163..a6c1a24e6 100644 --- a/tests/testthat/test-x_list.R +++ b/tests/testthat/test-x_list.R @@ -276,7 +276,7 @@ test_that("A complete x-list is structurally correct", { expect_equal(x_list_before$notify, rep(NA, 3)) expect_s3_class(x_list_before$validation_set, c("tbl_df", "tbl", "data.frame")) expect_equal(nrow(x_list_before$validation_set), 3) - expect_equal(ncol(x_list_before$validation_set), 35) + expect_equal(ncol(x_list_before$validation_set), 36) expect_type(x_list_before$lang, "character") expect_equal(x_list_before$lang, "en") expect_s3_class(x_list_before$report_object, "gt_tbl") @@ -380,7 +380,7 @@ test_that("A complete x-list is structurally correct", { expect_equal(x_list_after$notify, rep(NA, 3)) expect_s3_class(x_list_after$validation_set, c("tbl_df", "tbl", "data.frame"), exact = TRUE) expect_equal(nrow(x_list_after$validation_set), 3) - expect_equal(ncol(x_list_after$validation_set), 35) + expect_equal(ncol(x_list_after$validation_set), 36) expect_type(x_list_after$lang, "character") expect_equal(x_list_after$lang, "en") expect_s3_class(x_list_after$report_object, "gt_tbl") From 57841d336d555f38441bdf64ba13d23e9101757d Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Fri, 24 Jan 2025 14:09:44 -0500 Subject: [PATCH 6/8] add test infra --- tests/testthat/test-brief.R | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) diff --git a/tests/testthat/test-brief.R b/tests/testthat/test-brief.R index f422b9bcf..190e1dbe4 100644 --- a/tests/testthat/test-brief.R +++ b/tests/testthat/test-brief.R @@ -227,3 +227,31 @@ test_that("Briefs batch tests: special validations", { ) }) + +test_that("brief_cls hosts information about class", { + + chr <- "chr" + + autobrief <- NULL + + foobar <- structure("foobar", class = "foobar") + + verbatim_yaml <- structure( + yaml::as.yaml(list(author = "June", id = 123)), + class = "verbatim" + ) + + get_brief_cls <- function(brief1, brief2) { + create_agent(~ small_table) %>% + col_vals_gt(c(a, c), 5, brief = brief1) %>% + col_vals_gt(c(a, c), 5, brief = brief2) %>% + el("validation_set") %>% + el("brief_cls") + } + + get_brief_cls(chr, chr) + get_brief_cls(chr, autobrief) + get_brief_cls(chr, foobar) + + +}) From 45a0d76ebbfaa2e564dec6c813876b9ba83804c2 Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Fri, 24 Jan 2025 14:24:23 -0500 Subject: [PATCH 7/8] support 3 types of briefs - character, autobrief, asis --- R/utils.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index b948c6902..1112fece7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -274,16 +274,21 @@ resolve_brief <- function(brief, agent, # Return packed vector/matrix for iteration over steps brief <- pack_by_col_seg(brief, n_columns, n_segments, c(columns, segments_list)) + # Track brief type: one of autobrief, AsIs/verbatim, character if (use_autobrief) { class(brief) <- "autobrief" + } else if (any(c("AsIs", "verbatim") %in% brief_cls)) { + brief <- I(brief) } else { - class(brief) <- brief_cls + brief <- unclass(brief) } brief } +`[.autobrief` <- function(x, i, ...) structure(NextMethod("["), class = "autobrief") + resolve_label <- function(label, columns = list(NULL), segments = list(NULL)) { n_columns <- length(columns) n_segments <- length(segments) From 9357d912b22901463501ac2d3577f1dc898872ae Mon Sep 17 00:00:00 2001 From: yjunechoe Date: Fri, 24 Jan 2025 14:25:32 -0500 Subject: [PATCH 8/8] update tests --- tests/testthat/test-brief.R | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/tests/testthat/test-brief.R b/tests/testthat/test-brief.R index 190e1dbe4..5f5be5970 100644 --- a/tests/testthat/test-brief.R +++ b/tests/testthat/test-brief.R @@ -230,28 +230,31 @@ test_that("Briefs batch tests: special validations", { test_that("brief_cls hosts information about class", { - chr <- "chr" - - autobrief <- NULL - - foobar <- structure("foobar", class = "foobar") - - verbatim_yaml <- structure( - yaml::as.yaml(list(author = "June", id = 123)), - class = "verbatim" - ) - - get_brief_cls <- function(brief1, brief2) { + get_brief_cls <- function(brief) { create_agent(~ small_table) %>% - col_vals_gt(c(a, c), 5, brief = brief1) %>% - col_vals_gt(c(a, c), 5, brief = brief2) %>% + col_vals_gt(c(a, c), 5, brief = brief) %>% el("validation_set") %>% el("brief_cls") } - get_brief_cls(chr, chr) - get_brief_cls(chr, autobrief) - get_brief_cls(chr, foobar) + expect_identical( + get_brief_cls("chr"), + rep("character", 2) + ) + + expect_identical( + get_brief_cls(NULL), + rep("autobrief", 2) + ) + yml <- yaml::as.yaml(list(author = "June", id = 123)) + expect_identical( + get_brief_cls(I(yml)), + rep("AsIs", 2) + ) + expect_identical( + get_brief_cls(structure(yml, class = "verbatim")), + rep("AsIs", 2) + ) })