From b8c901898a24c255458c5a03d9107d16cd093d35 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 7 Nov 2023 14:44:11 +0000 Subject: [PATCH 01/83] Replace ellipsis unpacking with list to rlang::list2 --- NAMESPACE | 2 +- R/apply_formats.R | 4 ++-- R/count_bindings.R | 4 ++-- R/desc.R | 2 +- R/format.R | 2 +- R/layering.R | 4 ++-- R/meta-builders.R | 6 +++--- R/pop_data.R | 4 ++-- R/riskdiff.R | 8 ++++---- R/set_format_strings.R | 4 ++-- R/sort.R | 2 +- R/table_bindings.R | 8 ++++---- R/zzz.R | 2 +- 13 files changed, 26 insertions(+), 26 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 5411b68d..3aa583c0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -194,7 +194,6 @@ importFrom(rlang,as_name) importFrom(rlang,call_args) importFrom(rlang,call_modify) importFrom(rlang,call_name) -importFrom(rlang,call_standardise) importFrom(rlang,caller_env) importFrom(rlang,current_env) importFrom(rlang,enexpr) @@ -220,6 +219,7 @@ importFrom(rlang,is_logical) importFrom(rlang,is_named) importFrom(rlang,is_quosure) importFrom(rlang,is_quosures) +importFrom(rlang,list2) importFrom(rlang,quo) importFrom(rlang,quo_get_expr) importFrom(rlang,quo_is_call) diff --git a/R/apply_formats.R b/R/apply_formats.R index 38f9b5eb..179d23e3 100644 --- a/R/apply_formats.R +++ b/R/apply_formats.R @@ -38,7 +38,7 @@ apply_formats <- function(format_string, ..., empty = c(.overall = "")) { call.=FALSE) } - pmap_chr(list(...), function(...) apply_fmts(...), fmt=format) + pmap_chr(list2(...), function(...) apply_fmts(...), fmt=format) } #' Application of individual format string @@ -53,7 +53,7 @@ apply_formats <- function(format_string, ..., empty = c(.overall = "")) { #' @return An individually formatted string #' @noRd apply_fmts <- function(..., fmt) { - nums <- list(...) + nums <- list2(...) repl <- vector('list', length(fmt$settings)) for (i in seq_along(fmt$settings)) { repl[[i]] <- num_fmt(nums[[i]], i, fmt=fmt) diff --git a/R/count_bindings.R b/R/count_bindings.R index 98cecd75..5601cd90 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -457,7 +457,7 @@ set_result_order_var <- function(e, result_order_var) { #' build() set_missing_count <- function(e, fmt = NULL, sort_value = NULL, denom_ignore = FALSE, ...) { - missings <- list(...) + missings <- list2(...) assert_that(length(missings) > 0, msg = "No missing values were specified.") if(!is.null(fmt)) assert_inherits_class(fmt, "f_str") @@ -644,7 +644,7 @@ set_denoms_by.count_layer <- function(e, ...) { #' build() #' keep_levels <- function(e, ...) { - dots <- list(...) + dots <- list2(...) assert_that(all(map_lgl(dots, is.character)), msg = "must pass character values to `keep_levels`") diff --git a/R/desc.R b/R/desc.R index c6ad4b6c..efb01320 100644 --- a/R/desc.R +++ b/R/desc.R @@ -225,7 +225,7 @@ get_summaries <- function(e = caller_env()) { #' @noRd construct_desc_string <- function(..., .fmt_str=NULL) { # Unpack names into current namespace for ease - list2env(list(...), envir=environment()) + list2env(list2(...), envir=environment()) # Get the current format to be applied fmt <- .fmt_str[[row_label]] diff --git a/R/format.R b/R/format.R index e30100a4..c80abe4c 100644 --- a/R/format.R +++ b/R/format.R @@ -360,7 +360,7 @@ count_f_str_check <- function(...) { } # Grab the named parameters - params <- list(...) + params <- list2(...) # Currently supported format names valid_names <- c("n_counts", "riskdiff") diff --git a/R/layering.R b/R/layering.R index 6a9e47c5..b2d05f38 100644 --- a/R/layering.R +++ b/R/layering.R @@ -100,10 +100,10 @@ add_layers <- function(parent, ...) { # Parent exists assert_that(!missing(parent), msg = "`parent` parameter must be provided") # all objects are Tplyr layers - map(list(...), assert_is_layer) + map(list2(...), assert_is_layer) # Insert the layer into the parent object - parent$layers <- append(parent$layers, list(...)) + parent$layers <- append(parent$layers, list2(...)) parent } diff --git a/R/meta-builders.R b/R/meta-builders.R index 941b679e..601ba14e 100644 --- a/R/meta-builders.R +++ b/R/meta-builders.R @@ -47,7 +47,7 @@ build_desc_meta <- function(target, table_where, layer_where, treat_grps, ...) { # Don't want any of the named parameters here variables <- variables[which(names(variables)=='')] - values <- list(...) + values <- list2(...) # Get rid of text provided by variables inds <- which(map_lgl(unname(variables), ~ quo_class(.) == "name")) @@ -85,7 +85,7 @@ build_count_meta <- function(layer, table_where, layer_where, treat_grps, summar # Don't want any of the named parameters here variables <- variables[which(names(variables)=='')] - values <- list(...) + values <- list2(...) # Get rid of text provided by variables inds <- which(map_lgl(unname(variables), ~ quo_class(.) == "name")) @@ -220,7 +220,7 @@ build_shift_meta <- function(layer, table_where, layer_where, treat_grps, summar # Don't want any of the named parameters here variables <- variables[which(names(variables)=='')] - values <- list(...) + values <- list2(...) # Get rid of text provided by variables inds <- which(map_lgl(unname(variables), ~ quo_class(.) == "name")) diff --git a/R/pop_data.R b/R/pop_data.R index d8af419d..ee98174e 100644 --- a/R/pop_data.R +++ b/R/pop_data.R @@ -81,13 +81,13 @@ build_header_n <- function(table) { add_treat_grps <- function(table, ...) { - assert_that(is_named(list(...)), msg="Treatment group arguments must have names") + assert_that(is_named(list2(...)), msg="Treatment group arguments must have names") assert_that(inherits(table, "tplyr_table"), msg = "Treatment groups can only be added to `tplyr_table` objects") # Check parameters - fargs <- list(...) + fargs <- list2(...) # Bind the specified treatment groups to the table env_bind(table, treat_grps = append(treat_grps(table), fargs)) diff --git a/R/riskdiff.R b/R/riskdiff.R index 9cbd53f2..be17c0b8 100644 --- a/R/riskdiff.R +++ b/R/riskdiff.R @@ -115,7 +115,7 @@ add_risk_diff <- function(layer, ..., args=list(), distinct=TRUE) { # grab the ellipsis args into a list - comps <- list(...) + comps <- list2(...) # Must be character, must have 2 elements assert_that(all(map_lgl(comps, is.character)), all(map_lgl(comps, ~ length(.x) == 2)), @@ -242,7 +242,7 @@ riskdiff <- function(diff_group, n_comp, n_ref, total_comp, total_ref, args=list high = NA ) - out <- append(list(...), out) + out <- append(list2(...), out) # Rename # Totals in the 2 way must be positive @@ -265,10 +265,10 @@ riskdiff <- function(diff_group, n_comp, n_ref, total_comp, total_ref, args=list construct_riskdiff_string <- function(..., .fmt_str=NULL) { # Unpack names into current namespace for ease - list2env(list(...), envir=environment()) + list2env(list2(...), envir=environment()) # Return empty when necessary - if (any(is.na(list(...)))) { + if (any(is.na(list2(...)))) { return(.fmt_str$empty) } diff --git a/R/set_format_strings.R b/R/set_format_strings.R index 651dd4d2..e81d7d6b 100644 --- a/R/set_format_strings.R +++ b/R/set_format_strings.R @@ -130,7 +130,7 @@ set_format_strings.desc_layer <- function(e, ..., cap=getOption('tplyr.precision # Pick off the ellipsis - format_strings <- list(...) + format_strings <- list2(...) # Get the list of variable names that need to be transposed @@ -187,7 +187,7 @@ set_format_strings.count_layer <- function(e, ...) { set_format_strings.shift_layer <- function(e, ...) { - dots <- list(...) + dots <- list2(...) assert_that(all(dots$vars %in% c("n", "pct")), msg = "formats in shift layers can only be n") diff --git a/R/sort.R b/R/sort.R index d4168df3..d4638fde 100644 --- a/R/sort.R +++ b/R/sort.R @@ -686,7 +686,7 @@ get_data_order_byvarn <- function(formatted_data, by_varn_df, by_var, by_column_ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { # Pull out dots - list2env(list(...), envir = environment()) + list2env(list2(...), envir = environment()) # Here are the names of the formatted data row labels. We usually only work with the last row_label_vec <- vars_select(names(group_data), starts_with("row_label")) diff --git a/R/table_bindings.R b/R/table_bindings.R index 96bc2ea6..a8be1614 100644 --- a/R/table_bindings.R +++ b/R/table_bindings.R @@ -319,7 +319,7 @@ get_desc_layer_formats <- function(obj) { #' @rdname table_format_defaults set_desc_layer_formats <- function(obj, ...) { # Bind the formats into the table - env_bind(obj, desc_layer_formats = list(...)) + env_bind(obj, desc_layer_formats = list2(...)) obj } @@ -337,8 +337,8 @@ get_count_layer_formats <- function(obj) { set_count_layer_formats <- function(obj, ...) { # Bind the formats into the table - if (length(list(...)) > 0) params <- count_f_str_check(...) - else params <- list(...) + if (length(list2(...)) > 0) params <- count_f_str_check(...) + else params <- list2(...) env_bind(obj, count_layer_formats = params) obj @@ -355,6 +355,6 @@ get_shift_layer_formats <- function(obj) { #' @rdname table_format_defaults set_shift_layer_formats <- function(obj, ...) { # Bind the formats into the table - env_bind(obj, shift_layer_formats = list(...)) + env_bind(obj, shift_layer_formats = list2(...)) obj } diff --git a/R/zzz.R b/R/zzz.R index 53944b32..0c8ec46a 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,5 +1,5 @@ #' @importFrom rlang env enquo enquos caller_env abort inform is_quosure quo_get_expr quo_is_null env_get env_bind env_has quo_is_missing quos enexprs -#' @importFrom rlang call_modify call_standardise call_name call_args is_call current_env quo_name trace_back is_function +#' @importFrom rlang call_modify call_name call_args is_call current_env quo_name trace_back is_function list2 #' @importFrom rlang expr exprs enexprs enexpr is_named env_parent env_label is_logical is_empty is_quosures quo_is_symbol sym syms := as_name #' @importFrom rlang quos quo env_names env_bind_active as_label eval_tidy warn quo_is_call #' @importFrom stringr str_split str_extract_all regex str_detect str_replace_all str_replace str_locate_all fixed str_count str_trim str_wrap From e9148a3d110368a7da76b8a0bfa23e8b9aaebe0e Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 7 Nov 2023 14:52:41 +0000 Subject: [PATCH 02/83] Add test referenced in #111 --- tests/testthat/test-format.R | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/tests/testthat/test-format.R b/tests/testthat/test-format.R index b618ba08..98a37879 100644 --- a/tests/testthat/test-format.R +++ b/tests/testthat/test-format.R @@ -256,3 +256,26 @@ test_that("Format string setting and autoprecision are detected appropriately", expect_equal(fmt26$settings, s26) }) + +test_that("Ellipsis unpacking of external variables functions effectively - (#111)", { + + # Define a list of f_str's + num_formats <- list( + "N" = f_str("xx", n), + "Mean (SD)" = f_str("xx.x (xx.xx)", mean, sd), + "Median" = f_str("xx.x", median), + "Q1" = f_str("xx", q1), + "Q3" = f_str("xx", q3), + "Min" = f_str("xx", min), + "Max" = f_str("xx", max) + ) + + # `add_layers()` example, create the tplyr_table + t <- tplyr_table(iris, Species) + + # This won't work - Error in !num_formats : invalid argument type + l <- group_desc(t, Petal.Length) %>% + set_format_strings(!!!num_formats) + + expect_identical(num_formats, l$format_strings) +}) From 19143da31ac6dd80aafa68b9cb26c24f01eca581 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 14 Dec 2023 16:57:23 +0000 Subject: [PATCH 03/83] remove unnecessary comment. --- tests/testthat/test-format.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-format.R b/tests/testthat/test-format.R index 98a37879..33e8bc14 100644 --- a/tests/testthat/test-format.R +++ b/tests/testthat/test-format.R @@ -273,7 +273,6 @@ test_that("Ellipsis unpacking of external variables functions effectively - (#11 # `add_layers()` example, create the tplyr_table t <- tplyr_table(iris, Species) - # This won't work - Error in !num_formats : invalid argument type l <- group_desc(t, Petal.Length) %>% set_format_strings(!!!num_formats) From 3d463fabae08feb8c45eff5764ec8a9daeb0cf58 Mon Sep 17 00:00:00 2001 From: Andrew Bates Date: Thu, 14 Dec 2023 09:05:28 -0800 Subject: [PATCH 04/83] Have R CMD check run on PRs & pushed to devel --- .github/workflows/R-CMD-check.yaml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 99c7c3d5..14448e2e 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -5,10 +5,12 @@ on: branches: - main - master + - devel pull_request: branches: - main - master + - devel name: R-CMD-check From 33df5cc2a87bc411d6d5f1fa07b23d777dcb5181 Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Thu, 14 Dec 2023 17:20:48 +0000 Subject: [PATCH 05/83] Documentation updates and typo corrections --- R/apply_conditional_format.R | 8 ++++---- vignettes/table.Rmd | 2 ++ 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/R/apply_conditional_format.R b/R/apply_conditional_format.R index 16198fa1..54583b07 100644 --- a/R/apply_conditional_format.R +++ b/R/apply_conditional_format.R @@ -11,15 +11,15 @@ #' @noRd validate_conditional_format_params <- function(string, format_group, condition, replacement, full_string) { if (!inherits(string, "character")) { - stop("Paramter `string` must be a character vector", call.=FALSE) + stop("Parameter `string` must be a character vector", call.=FALSE) } if (!inherits(format_group, "numeric") || (inherits(format_group, "numeric") && format_group %% 1 != 0)) { - stop("Paramter `format_group` must be an integer", call.=FALSE) + stop("Parameter `format_group` must be an integer", call.=FALSE) } if (!inherits(replacement, "character")) { - stop("Paramter `replacement` must be a string", call.=FALSE) + stop("Parameter `replacement` must be a string", call.=FALSE) } # Condition statement must use the variable name 'x' @@ -28,7 +28,7 @@ validate_conditional_format_params <- function(string, format_group, condition, } if (!inherits(full_string, "logical")) { - stop("Paramter `full_string` must be bool", call.=FALSE) + stop("Parameter `full_string` must be bool", call.=FALSE) } } diff --git a/vignettes/table.Rmd b/vignettes/table.Rmd index 0d4ab526..c0f888f6 100644 --- a/vignettes/table.Rmd +++ b/vignettes/table.Rmd @@ -115,6 +115,8 @@ header_n(t) %>% kable() ``` +Note: it’s expected the set_distinct_by() function is used with population data. This is because it does not make sense to use population data denominators unless you have distinct counts. The entire point of population data is to use subject counts, so non-distinct counts would potentially count multiple records per subject and then the percentage doesn’t make any sense. + With the table level settings under control, now you're ready to learn more about what **Tplyr** has to offer in each layer. - Learn more about descriptive statistics layers in `vignette("desc")` From ae5b9cf3c7a366755156ec7d3c28b7004cd13390 Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Thu, 14 Dec 2023 18:07:30 +0000 Subject: [PATCH 06/83] Function in ticks --- vignettes/table.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/table.Rmd b/vignettes/table.Rmd index c0f888f6..1f268b3d 100644 --- a/vignettes/table.Rmd +++ b/vignettes/table.Rmd @@ -115,7 +115,7 @@ header_n(t) %>% kable() ``` -Note: it’s expected the set_distinct_by() function is used with population data. This is because it does not make sense to use population data denominators unless you have distinct counts. The entire point of population data is to use subject counts, so non-distinct counts would potentially count multiple records per subject and then the percentage doesn’t make any sense. +Note: it’s expected the `set_distinct_by()` function is used with population data. This is because it does not make sense to use population data denominators unless you have distinct counts. The entire point of population data is to use subject counts, so non-distinct counts would potentially count multiple records per subject and then the percentage doesn’t make any sense. With the table level settings under control, now you're ready to learn more about what **Tplyr** has to offer in each layer. From dcfaab073780c7c3750945bde6150d33a2d82bdc Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Thu, 14 Dec 2023 18:10:56 +0000 Subject: [PATCH 07/83] Typo corrections in test --- tests/testthat/test-apply_conditional_format.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-apply_conditional_format.R b/tests/testthat/test-apply_conditional_format.R index a2b2f928..6740d04d 100644 --- a/tests/testthat/test-apply_conditional_format.R +++ b/tests/testthat/test-apply_conditional_format.R @@ -4,17 +4,17 @@ test_string2 <- c(" 0 ( 0.0%)", " 8 ( 9.3%)", "78 (90.7%) [ 5]", "12", "Howdy ya test_that("Test input validation and warning generation", { expect_error( apply_conditional_format(c(1), 2, x == 0, "(<1%)", full_string=TRUE), - "Paramter `string`" + "Parameter `string`" ) expect_error( apply_conditional_format(test_string1, "bad", x == 0, "(<1%)", full_string=TRUE), - "Paramter `format_group`" + "Parameter `format_group`" ) expect_error( apply_conditional_format(test_string1, 1.1, x == 0, "(<1%)", full_string=TRUE), - "Paramter `format_group`" + "Parameter `format_group`" ) expect_error( @@ -24,12 +24,12 @@ test_that("Test input validation and warning generation", { expect_error( apply_conditional_format(test_string1, 2, x == 0, 1, full_string=TRUE), - "Paramter `replacement" + "Parameter `replacement" ) expect_error( apply_conditional_format(test_string1, 2, x == 0, "(<1%)", full_string="TRUE"), - "Paramter `full_string`" + "Parameter `full_string`" ) expect_warning( From 44f15bc5a13ebe91e0c615c5c8ee5cada96e064e Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 14 Dec 2023 18:48:24 +0000 Subject: [PATCH 08/83] Add fix to convert infs to NAs for more expected result --- R/desc.R | 8 ++++++-- tests/testthat/test-desc.R | 21 +++++++++++++++++++++ 2 files changed, 27 insertions(+), 2 deletions(-) diff --git a/R/desc.R b/R/desc.R index efb01320..c1af9746 100644 --- a/R/desc.R +++ b/R/desc.R @@ -60,6 +60,7 @@ process_summaries.desc_layer <- function(x, ...) { # Fill in any missing treat/col combinations complete(!!treat_var, !!!by, !!!cols) + # Create the transposed summary data to prepare for formatting trans_sums[[i]] <- num_sums_raw[[i]] %>% # Transpose the summaries that make up the first number in a display string @@ -188,6 +189,9 @@ process_formatting.desc_layer <- function(x, ...) { env_get(x, "formatted_data") } +# Small helper function to help with builtins +inf_to_na <- function(x) if_else(is.infinite(x), NA, x) + #' Get the summaries to be passed forward into \code{dplyr::summarize()} #' #' @param e the environment summaries are stored in. @@ -203,8 +207,8 @@ get_summaries <- function(e = caller_env()) { sd = sd(.var, na.rm=TRUE), median = median(.var, na.rm=TRUE), var = var(.var, na.rm=TRUE), - min = min(.var, na.rm=TRUE), - max = max(.var, na.rm=TRUE), + min = inf_to_na(min(.var, na.rm=TRUE)), + max = inf_to_na(max(.var, na.rm=TRUE)), iqr = IQR(.var, na.rm=TRUE, type=getOption('tplyr.quantile_type')), q1 = quantile(.var, na.rm=TRUE, type=getOption('tplyr.quantile_type'))[[2]], q3 = quantile(.var, na.rm=TRUE, type=getOption('tplyr.quantile_type'))[[4]], diff --git a/tests/testthat/test-desc.R b/tests/testthat/test-desc.R index 3105340a..6a528360 100644 --- a/tests/testthat/test-desc.R +++ b/tests/testthat/test-desc.R @@ -141,3 +141,24 @@ test_that("Stats as columns properly transposes the built data", { expect_snapshot(as.data.frame(d2)) }) + +test_that("Infinites aren't produced from min/max", { + dat <- tibble::tribble( + ~x1, ~x2, + 'a', 1, + 'a', 2, + 'b', NA, + ) + + t <- tplyr_table(dat, x1) %>% + add_layer( + group_desc(x2) %>% + set_format_strings( + "Min, Max" = f_str("xx, xx", min, max) + ) + ) + + x <- suppressWarnings(build(t)) + + expect_equal(x$var1_b, "") +}) From 08a61957cf39ef6f55dc75787a30416a11607179 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 14 Dec 2023 19:46:05 +0000 Subject: [PATCH 09/83] Update documentation to explain the change. --- vignettes/desc.Rmd | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/vignettes/desc.Rmd b/vignettes/desc.Rmd index 3e7b0a52..112d7105 100644 --- a/vignettes/desc.Rmd +++ b/vignettes/desc.Rmd @@ -77,7 +77,9 @@ x %>% ### Notes About Built-in's -Note that the only non-default option being used in any of the function calls above is `na.rm=TRUE`. For most of the functions, this is likely fine - but with IQR, Q1, and Q3 note that there are several different quantile algorithms available in R. The default we chose to use is the R default of Type 7: +Note that the only non-default option being used in any of the function calls above is `na.rm=TRUE`. It's important to note that for `min` and `max`, when `na.rm=TRUE` is used with a vector that is all `NA`, these functions return `Inf` and `-Inf` respectively. When formatting the numbers, this is unexpected and also inconsistent with how other descriptive statistic functions, which return `NA`. Therefore, just for `min` and `max`, `Inf`'s are converted to `NA` so that they'll align with the behavior of the `empty` parameter in `f_str()`. + +Using default settings of most descriptive statistic functions is typically fine, but with IQR, Q1, and Q3 note that there are several different quantile algorithms available in R. The default we chose to use is the R default of Type 7: $$ m = 1-p. p[k] = (k - 1) / (n - 1). \textrm{In this case, } p[k] = mode[F(x[k])]. \textrm{This is used by S.} From 8a9546de10b463613e0c08f4de903cc7632f26c9 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 14 Dec 2023 19:50:29 +0000 Subject: [PATCH 10/83] remove extra line --- R/desc.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/desc.R b/R/desc.R index c1af9746..00922c6a 100644 --- a/R/desc.R +++ b/R/desc.R @@ -60,7 +60,6 @@ process_summaries.desc_layer <- function(x, ...) { # Fill in any missing treat/col combinations complete(!!treat_var, !!!by, !!!cols) - # Create the transposed summary data to prepare for formatting trans_sums[[i]] <- num_sums_raw[[i]] %>% # Transpose the summaries that make up the first number in a display string From ecf617f4b2cc86bd59ae2ada20a6a21c758b9e5b Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Thu, 14 Dec 2023 20:11:42 +0000 Subject: [PATCH 11/83] Add example --- R/table_bindings.R | 3 +++ man/pop_data.Rd | 2 ++ 2 files changed, 5 insertions(+) diff --git a/R/table_bindings.R b/R/table_bindings.R index a8be1614..91f817fb 100644 --- a/R/table_bindings.R +++ b/R/table_bindings.R @@ -89,6 +89,8 @@ set_header_n <- function(table, value) { #' #' pop_data(tab) <- mtcars #' +#' tab <- tplyr_table(iris, Species) %>% +#' set_pop_data(mtcars) #' @export #' @rdname pop_data pop_data <- function(table) { @@ -108,6 +110,7 @@ pop_data <- function(table) { #' #' @export #' @rdname pop_data +#' set_pop_data <- function(table, pop_data) { pop_data_name <- enexpr(pop_data) # table should be a data.frame diff --git a/man/pop_data.Rd b/man/pop_data.Rd index 349a2d73..305553f3 100644 --- a/man/pop_data.Rd +++ b/man/pop_data.Rd @@ -39,4 +39,6 @@ tab <- tplyr_table(iris, Species) pop_data(tab) <- mtcars +tab <- tplyr_table(iris, Species) \%>\% + set_pop_data(mtcars) } From 2055a8d3d9e6e1a7a86ded1feabebc1329f5892c Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 15 Dec 2023 15:43:38 +0000 Subject: [PATCH 12/83] Fix for #154 --- R/layering.R | 4 ++-- tests/testthat/test-layering.R | 18 ++++++++++++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/R/layering.R b/R/layering.R index b2d05f38..a6fd67aa 100644 --- a/R/layering.R +++ b/R/layering.R @@ -74,10 +74,10 @@ add_layer <- function(parent, layer, name=NULL) { # Insert the `parent` argument into the topmost call of the layer code # (i.e. if any pipes %>% then pull out the left most call and modify it) - l <- modify_nested_call(layer, parent=parent) + l <- quo_get_expr(modify_nested_call(layer, parent=parent)) # Evaluate the layer and grab `tplyr_layer` or `tplyr_subgroup_layer` object - executed_layer <- list(eval(quo_get_expr(l))) + executed_layer <- list(eval(l, envir=caller_env())) # Attach the name names(executed_layer) <- name diff --git a/tests/testthat/test-layering.R b/tests/testthat/test-layering.R index 9b76f6ad..62fcc244 100644 --- a/tests/testthat/test-layering.R +++ b/tests/testthat/test-layering.R @@ -123,4 +123,22 @@ test_that("Layers accept names when specified", { }) +test_that("add_layer can see calling environment objects", { + tfunc <- function(){ + + prec <- tibble::tribble( + ~vs, ~max_int, ~max_dec, + 0, 1, 1, + 1, 2, 2 + ) + + tplyr_table(mtcars, gear) %>% + add_layer( + group_desc(wt, by = vs) %>% + set_precision_data(prec) + ) + } + + expect_silent(tfunc()) +}) From 1daabaec41e02ee611c93c36ef13c2031ac5c89d Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 15 Dec 2023 16:04:20 +0000 Subject: [PATCH 13/83] Need to export set_format_strings.shift_layer --- NAMESPACE | 1 + R/set_format_strings.R | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 3aa583c0..961a7dc6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -32,6 +32,7 @@ S3method(set_denoms_by,count_layer) S3method(set_denoms_by,shift_layer) S3method(set_format_strings,count_layer) S3method(set_format_strings,desc_layer) +S3method(set_format_strings,shift_layer) S3method(set_where,tplyr_layer) S3method(set_where,tplyr_table) S3method(str,f_str) diff --git a/R/set_format_strings.R b/R/set_format_strings.R index e81d7d6b..49b488a6 100644 --- a/R/set_format_strings.R +++ b/R/set_format_strings.R @@ -185,6 +185,7 @@ set_format_strings.count_layer <- function(e, ...) { e } +#' @export set_format_strings.shift_layer <- function(e, ...) { dots <- list2(...) From 1ee583999a35449955ccb85c9db3521e0422803a Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Fri, 15 Dec 2023 19:25:29 +0000 Subject: [PATCH 14/83] Add object type asserssion --- R/count_bindings.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/count_bindings.R b/R/count_bindings.R index 5601cd90..660ebbdd 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -576,6 +576,10 @@ set_outer_sort_position <- function(e, outer_sort_position) { set_denom_where <- function(e, denom_where) { denom_where <- enquo(denom_where) + if (!(inherits(e, 'tplyr_layer') | inherits(e, 'tplyr_table'))) { + stop('Object type should be ', call.=FALSE) + } + assert_that(is_logical_or_call(denom_where), msg = "The `where` parameter must contain subsetting logic (enter without quotes)") From 4601d34ccce8cab3e28ee12878faefefb6018cd6 Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Fri, 15 Dec 2023 19:49:24 +0000 Subject: [PATCH 15/83] error message update --- R/count_bindings.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/count_bindings.R b/R/count_bindings.R index 660ebbdd..291779e3 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -577,7 +577,7 @@ set_denom_where <- function(e, denom_where) { denom_where <- enquo(denom_where) if (!(inherits(e, 'tplyr_layer') | inherits(e, 'tplyr_table'))) { - stop('Object type should be ', call.=FALSE) + stop('Object type should be either "tplyr_layer" or "tplyr_table"', call.=FALSE) } assert_that(is_logical_or_call(denom_where), From 0f01ebc9f3b9f7487176732779f2331b47c1cce7 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 15 Dec 2023 21:02:30 +0000 Subject: [PATCH 16/83] Function and tests for #129 --- R/collapse_row_labels.R | 120 ++++++++++++++++++++++ man/add_indentation.Rd | 19 ++++ man/collapse_row_labels.Rd | 50 +++++++++ tests/testthat/test-collapse_row_labels.R | 70 +++++++++++++ 4 files changed, 259 insertions(+) create mode 100644 R/collapse_row_labels.R create mode 100644 man/add_indentation.Rd create mode 100644 man/collapse_row_labels.Rd create mode 100644 tests/testthat/test-collapse_row_labels.R diff --git a/R/collapse_row_labels.R b/R/collapse_row_labels.R new file mode 100644 index 00000000..cc6b5dd0 --- /dev/null +++ b/R/collapse_row_labels.R @@ -0,0 +1,120 @@ +#' Add indentation level based +#' +#' @param .x The number of levels to indent +#' @param .y Input variable for which indentation will be done +#' +#' @return Character string with indentation applied +add_indentation <- function(.x, .y, indent = " ") { + paste(c(rep("",.x-1), .y), collapse=indent) +} + + +#' Collapse row labels into a single column +#' +#' This is a generalized post processing function that allows you to take groups +#' of by variables and collapse them into a single column. Repeating values are +#' split into separate rows, and for each level of nesting, a specified +#' indentation level can be applied. +#' +#' @param x Input data frame +#' @param ... Row labels to be collapsed +#' @param indent Indentation string to be used, which is multiplied at each indentation level +#' @param target_col The desired name of the output column containing collapsed row labels +#' +#' @return data.frame with row labels collapsed into a single column +#' @export +#' +#' @examples +#' x <- tibble::tribble( +#' ~row_label1, ~row_label2, ~row_label3, ~row_label4, ~var1, +#' "A", "C", "G", "M", 1L, +#' "A", "C", "G", "N", 2L, +#' "A", "C", "H", "O", 3L, +#' "A", "D", "H", "P", 4L, +#' "A", "D", "I", "Q", 5L, +#' "A", "D", "I", "R", 6L, +#' "B", "E", "J", "S", 7L, +#' "B", "E", "J", "T", 8L, +#' "B", "E", "K", "U", 9L, +#' "B", "F", "K", "V", 10L, +#' "B", "F", "L", "W", 11L +#' ) +#' +#' +#' collapse_row_labels(x, row_label1, row_label2, row_label3, row_label4) +#' +#' collapse_row_labels(x, row_label1, row_label2, row_label3) +#' +#' collapse_row_labels(x, row_label1, row_label2, indent = " ", target_col = rl) +#' +collapse_row_labels <- function(x, ..., indent = " ", target_col=row_label) { + + target_col = enquo(target_col) + dots <- enquos(...) + + # browser() + dot_names <- map_chr(dots, as_label) + + if (!inherits(x, 'data.frame')) { + stop('x must be a data frame', call.=FALSE) + } + + if (!inherits(indent, 'character')) { + stop("indent must be a character string", call.=FALSE) + } + + if (!all(map_lgl(dots, quo_is_symbol))) { + stop("Columns provided to dots must be provided as unquoted symbols.", call.=FALSE) + } + + if (!all(dot_names %in% names(x))) { + stop("Columns provided to dots are missing from x.", call.=FALSE) + } + + if (!quo_is_symbol(target_col)) { + stop("target_col must be provided as an unquoted symbol.", call.=FALSE) + } + + if (length(dots) < 2) { + stop("Must have two or more columns to collapse", call.=FALSE) + } + + all_but_last <- dots[1:length(dots)-1] + + # Add the original row identifier + x['og_row'] <- as.numeric(rownames(x)) + + # Grab the desired rowlabels, except for the last one specified in the dots + rowlabs <- select(x, !!!all_but_last, og_row) + + # Get the distinct list of stubs from the data and grab the nesting level + stubs <- rowlabs %>% + group_by(!!!all_but_last) %>% + slice_head() %>% + pivot_longer( + map_chr(all_but_last, as_label), + names_to = NULL, + values_to = as_label(target_col) + ) %>% + group_by(og_row) %>% + mutate( + stub_sort = row_number() + ) + + # Join back to the original data + x %>% + bind_rows(stubs, .id="id") %>% + # Put everything into the right spot + arrange(og_row, desc(id)) %>% + fill(stub_sort) %>% + mutate( + # Figure out the indentation level + stub_sort = if_else(id == 1, stub_sort + 1, stub_sort), + # Build and indent the new row label column + !!target_col := if_else(is.na(!!target_col), !!!tail(dots, 1), !!target_col), + !!target_col := map2_chr(stub_sort, !!target_col, add_indentation, indent = indent), + # Fill in the empty character fields + across(where(is.character), ~ replace_na(., '')) + ) %>% + select(!!target_col, !c(id, og_row, stub_sort, !!!dots)) +} diff --git a/man/add_indentation.Rd b/man/add_indentation.Rd new file mode 100644 index 00000000..1c9b9813 --- /dev/null +++ b/man/add_indentation.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/collapse_row_labels.R +\name{add_indentation} +\alias{add_indentation} +\title{Add indentation level based} +\usage{ +add_indentation(.x, .y, indent = " ") +} +\arguments{ +\item{.x}{The number of levels to indent} + +\item{.y}{Input variable for which indentation will be done} +} +\value{ +Character string with indentation applied +} +\description{ +Add indentation level based +} diff --git a/man/collapse_row_labels.Rd b/man/collapse_row_labels.Rd new file mode 100644 index 00000000..aafba3a4 --- /dev/null +++ b/man/collapse_row_labels.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/collapse_row_labels.R +\name{collapse_row_labels} +\alias{collapse_row_labels} +\title{Collapse row labels into a single column} +\usage{ +collapse_row_labels(x, ..., indent = " ", target_col = row_label) +} +\arguments{ +\item{x}{Input data frame} + +\item{...}{Row labels to be collapsed} + +\item{indent}{Indentation string to be used, which is multiplied at each indentation level} + +\item{target_col}{The desired name of the output column containing collapsed row labels} +} +\value{ +data.frame with row labels collapsed into a single column +} +\description{ +This is a generalized post processing function that allows you to take groups +of by variables and collapse them into a single column. Repeating values are +split into separate rows, and for each level of nesting, a specified +indentation level can be applied. +} +\examples{ +x <- tibble::tribble( +~row_label1, ~row_label2, ~row_label3, ~row_label4, ~var1, + "A", "C", "G", "M", 1L, + "A", "C", "G", "N", 2L, + "A", "C", "H", "O", 3L, + "A", "D", "H", "P", 4L, + "A", "D", "I", "Q", 5L, + "A", "D", "I", "R", 6L, + "B", "E", "J", "S", 7L, + "B", "E", "J", "T", 8L, + "B", "E", "K", "U", 9L, + "B", "F", "K", "V", 10L, + "B", "F", "L", "W", 11L +) + + +collapse_row_labels(x, row_label1, row_label2, row_label3, row_label4) + +collapse_row_labels(x, row_label1, row_label2, row_label3) + +collapse_row_labels(x, row_label1, row_label2, indent = " ", target_col = rl) + +} diff --git a/tests/testthat/test-collapse_row_labels.R b/tests/testthat/test-collapse_row_labels.R new file mode 100644 index 00000000..e6242eb9 --- /dev/null +++ b/tests/testthat/test-collapse_row_labels.R @@ -0,0 +1,70 @@ +dat <- tibble::tribble( + ~row_label1, ~row_label2, ~row_label3, ~row_label4, ~var1, + "A", "C", "G", "M", 1L, + "A", "C", "G", "N", 2L, + "A", "C", "H", "O", 3L, + "A", "D", "H", "P", 4L, + "A", "D", "I", "Q", 5L, + "A", "D", "I", "R", 6L, + "B", "E", "J", "S", 7L, + "B", "E", "J", "T", 8L, + "B", "E", "K", "U", 9L, + "B", "F", "K", "V", 10L, + "B", "F", "L", "W", 11L +) + + +test_that("Errors generate as expected", { + expect_error(collapse_row_labels(1, blah, blah), "x must be a data frame") + expect_error( + collapse_row_labels(dat, row_label1, row_label2, indent = 1), + "indent must be a character string" + ) + expect_error( + collapse_row_labels(dat, row_label1, missing_col), + "Columns provided to dots are missing from x." + ) + expect_error( + collapse_row_labels(dat, row_label1, "row_label2"), + "Columns provided to dots must be provided as unquoted symbols." + ) + + expect_error( + collapse_row_labels(dat, row_label1, row_label2, target_col = "RL"), + "target_col must be provided as an unquoted symbol." + ) + expect_error( + collapse_row_labels(dat, row_label1), + "Must have two or more columns to collapse" + ) +}) + +test_that("Row labels collapse appropriately", { + + x <- collapse_row_labels(dat, row_label1, row_label2, row_label3, row_label4) + + expect_equal( + x$row_label[1:6], + c("A", " C", " G", " M", " N", "A") + ) + + x <- collapse_row_labels(dat, row_label1, row_label2, row_label3, row_label4, indent = " ") + expect_equal( + x$row_label[1:6], + c("A", " C", " G", " M", " N", "A") + ) + + x <- collapse_row_labels(dat, row_label1, row_label2, row_label3) + expect_equal(names(x), c("row_label", "row_label4", "var1")) + expect_equal( + x$row_label[1:6], + c("A", " C", " G", " G", " H", "A") + ) + expect_equal( + x$row_label4[1:6], + c("", "", "M", "N", "O", "") + ) + + x <- collapse_row_labels(dat, row_label1, row_label2, row_label3, target_col = rl) + expect_equal(names(x), c("rl", "row_label4", "var1")) +}) From 1f26ff6caf416d1ee7863f9bb301dc7364c297e5 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 15 Dec 2023 21:39:21 +0000 Subject: [PATCH 17/83] vignette updates and clean up R CMD check notes --- NAMESPACE | 5 +++++ R/collapse_row_labels.R | 2 ++ R/zzz.R | 9 +++++++-- man/add_indentation.Rd | 19 ------------------- vignettes/post_processing.Rmd | 32 ++++++++++++++++++++++++++++++++ 5 files changed, 46 insertions(+), 21 deletions(-) delete mode 100644 man/add_indentation.Rd diff --git a/NAMESPACE b/NAMESPACE index 961a7dc6..52a9cc81 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -55,6 +55,7 @@ export(apply_conditional_format) export(apply_formats) export(apply_row_masks) export(build) +export(collapse_row_labels) export(f_str) export(get_by) export(get_count_layer_formats) @@ -138,6 +139,7 @@ importFrom(dplyr,bind_rows) importFrom(dplyr,case_when) importFrom(dplyr,cur_column) importFrom(dplyr,cur_group) +importFrom(dplyr,desc) importFrom(dplyr,distinct) importFrom(dplyr,do) importFrom(dplyr,everything) @@ -160,10 +162,12 @@ importFrom(dplyr,rename) importFrom(dplyr,row_number) importFrom(dplyr,rowwise) importFrom(dplyr,select) +importFrom(dplyr,slice_head) importFrom(dplyr,summarize) importFrom(dplyr,tally) importFrom(dplyr,ungroup) importFrom(dplyr,vars) +importFrom(dplyr,where) importFrom(forcats,fct_collapse) importFrom(forcats,fct_drop) importFrom(forcats,fct_expand) @@ -177,6 +181,7 @@ importFrom(purrr,flatten) importFrom(purrr,imap) importFrom(purrr,map) importFrom(purrr,map2) +importFrom(purrr,map2_chr) importFrom(purrr,map2_dfr) importFrom(purrr,map_chr) importFrom(purrr,map_dbl) diff --git a/R/collapse_row_labels.R b/R/collapse_row_labels.R index cc6b5dd0..23c1f376 100644 --- a/R/collapse_row_labels.R +++ b/R/collapse_row_labels.R @@ -2,8 +2,10 @@ #' #' @param .x The number of levels to indent #' @param .y Input variable for which indentation will be done +#' @param indent Indentation string to be used, which is multiplied at each indentation level #' #' @return Character string with indentation applied +#' @noRd add_indentation <- function(.x, .y, indent = " ") { paste(c(rep("",.x-1), .y), collapse=indent) } diff --git a/R/zzz.R b/R/zzz.R index 0c8ec46a..c111ad2a 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -3,7 +3,7 @@ #' @importFrom rlang expr exprs enexprs enexpr is_named env_parent env_label is_logical is_empty is_quosures quo_is_symbol sym syms := as_name #' @importFrom rlang quos quo env_names env_bind_active as_label eval_tidy warn quo_is_call #' @importFrom stringr str_split str_extract_all regex str_detect str_replace_all str_replace str_locate_all fixed str_count str_trim str_wrap -#' @importFrom purrr flatten map map_lgl pmap_chr imap reduce map_chr map_int map_dbl map_dfr pmap_dfr walk2 map2 map2_dfr walk +#' @importFrom purrr flatten map map_lgl pmap_chr imap reduce map_chr map_int map_dbl map_dfr pmap_dfr walk2 map2 map2_dfr map2_chr walk #' @importFrom stringr str_sub str_sub<- str_extract str_pad str_starts str_remove_all str_match_all #' @importFrom tidyr pivot_longer pivot_wider replace_na #' @importFrom magrittr %>% extract extract2 @@ -11,7 +11,7 @@ #' @importFrom stats IQR median sd quantile var #' @importFrom dplyr n summarize filter vars tally ungroup group_by mutate lag select bind_rows full_join add_tally distinct rowwise #' @importFrom dplyr everything rename mutate_at mutate_all as_tibble bind_cols do case_when arrange left_join row_number between mutate_if -#' @importFrom dplyr across anti_join n_distinct if_else group_keys cur_group cur_column pull matches +#' @importFrom dplyr across anti_join n_distinct if_else group_keys cur_group cur_column pull matches slice_head where desc #' @importFrom tidyr complete nesting pivot_wider pivot_longer replace_na starts_with fill #' @importFrom utils str head tail #' @importFrom tidyselect all_of vars_select any_of @@ -303,3 +303,8 @@ l <- NULL w <- NULL s <- NULL out <- NULL +og_row <- NULL +desc <- NULL +id <- NULL +stub_sort <- NULL + diff --git a/man/add_indentation.Rd b/man/add_indentation.Rd deleted file mode 100644 index 1c9b9813..00000000 --- a/man/add_indentation.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/collapse_row_labels.R -\name{add_indentation} -\alias{add_indentation} -\title{Add indentation level based} -\usage{ -add_indentation(.x, .y, indent = " ") -} -\arguments{ -\item{.x}{The number of levels to indent} - -\item{.y}{Input variable for which indentation will be done} -} -\value{ -Character string with indentation applied -} -\description{ -Add indentation level based -} diff --git a/vignettes/post_processing.Rmd b/vignettes/post_processing.Rmd index 0578797c..b2fdab3f 100644 --- a/vignettes/post_processing.Rmd +++ b/vignettes/post_processing.Rmd @@ -100,6 +100,38 @@ There are a few considerations when using `apply_row_masks()`: - This function is order dependent, so make sure your data are sorted before submitting to `apply_row_masks()` - When inserting row breaks, by default the Tpylr variable `ord_layer_index` is used. You can submit other variables via the ellipsis parameter (`...`) if you'd like to use a different variable grouping to insert rows +## Collapsing Row Labels + +Different table formats call for different handling of row labels, depending on the preferences of an individual organization and the specifics of the table at hand. **Tplyr** inherently creates row labels as separate columns, but similar to the way that count layers nest the inner and the outer layer, we also offer the `collapse_row_labels()` function to pull multiple row labels into a single column. + +```{r collapse_row_labels} +dat <- tplyr_table(adsl, TRT01P) %>% + add_layer( + group_count(RACE, by = vars("Race n (%)", SEX)) + ) %>% + add_layer( + group_desc(AGE, by = vars("Age (years)", SEX)) + ) %>% + build() + +collapse_row_labels(dat, row_label1, row_label2, row_label3) %>% + select(row_label, var1_Placebo) +``` +By default, indentation is set to 2 spaces, but by using the `indent` parameter you can change this to any string you desire. + +```{r collapse_row_labels2} +collapse_row_labels(dat, row_label1, row_label2, row_label3, indent = "  ") %>% + select(row_label, var1_Placebo) %>% + kable(escape=FALSE) +``` +You also have control over which columns you collapse, allowing you to keep separate row labels if you don't want all collapsed together + +```{r collapse_row_labels3} +collapse_row_labels(dat, row_label1, row_label2, indent = "  ") %>% + select(row_label, row_label3, var1_Placebo) %>% + kable(escape=FALSE) +``` + ## Conditional Formatting In some circumstances, like `add_total_row()`, **Tplyr** lets you specify special formats separate from those in `set_format_strings()`. But within the table body there's no other way to set specific, conditional formats based on the table data itself. To address this, we've added the post-processing function `apply_conditional_format()` to allow you to set conditional formats on result cells. From 2ba66194d372fbd3ec7f890f4266f0321e72e6f5 Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Fri, 15 Dec 2023 22:44:22 +0000 Subject: [PATCH 18/83] Added a test for object check --- tests/testthat/test-count.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index c61f0d29..a8d2d62a 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -440,6 +440,17 @@ test_that("set_denom_where works as expected", { expect_snapshot_output(dput(t13)) }) +test_that("set_denom_where errors for incompatible object type", { + t1 <- tplyr_table(mtcars, gear) + + # Modify the object type to make it incompatible + class(t) <- "environment" + + # Function errors + t1 <- set_denom_where(t1, mpg != 21) %>% + expect_error("Object type should be") +}) + test_that("missing counts can be set without a format and it inherits the layer format", { t1 <- tplyr_table(mtcars, gear) %>% add_layer( From 49ebf7a9c5cba5d4b0d2d29e27ce46e9b96adc0d Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Fri, 15 Dec 2023 22:45:29 +0000 Subject: [PATCH 19/83] object name update --- tests/testthat/test-count.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index a8d2d62a..3a248a2e 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -444,7 +444,7 @@ test_that("set_denom_where errors for incompatible object type", { t1 <- tplyr_table(mtcars, gear) # Modify the object type to make it incompatible - class(t) <- "environment" + class(t1) <- "environment" # Function errors t1 <- set_denom_where(t1, mpg != 21) %>% From 7b3e995fba8a00dd99613cc74837de335f69ed3f Mon Sep 17 00:00:00 2001 From: Andrew Bates Date: Fri, 15 Dec 2023 22:49:59 +0000 Subject: [PATCH 20/83] move data sets from vignettes directory to included in the package --- .Rbuildignore | 1 + DESCRIPTION | 1 + NAMESPACE | 1 + R/data.R | 67 ++++++++++++++++++++ README.Rmd | 2 - data-raw/DATASET.R | 3 + data-raw/adae.R | 6 ++ {vignettes => data-raw}/adae.Rdata | Bin data-raw/adas.R | 6 ++ {vignettes => data-raw}/adas.Rdata | Bin data-raw/adlb.R | 6 ++ {vignettes => data-raw}/adlb.Rdata | Bin data-raw/adsl.R | 6 ++ {vignettes => data-raw}/adsl.Rdata | Bin data/adae.rda | Bin 0 -> 7372 bytes data/adas.rda | Bin 0 -> 15031 bytes data/adlb.rda | Bin 0 -> 15730 bytes data/adsl.rda | Bin 0 -> 11970 bytes man/adae.Rd | 22 +++++++ man/adas.Rd | 22 +++++++ man/adlb.Rd | 22 +++++++ man/adsl.Rd | 22 +++++++ man/get_data_labels.Rd | 17 +++++ tests/testthat/_snaps/data.md | 80 ++++++++++++++++++++++++ tests/testthat/test-count.R | 1 + tests/testthat/test-data.R | 6 ++ vignettes/Tplyr.Rmd | 3 - vignettes/count.Rmd | 3 - vignettes/custom-metadata.Rmd | 2 - vignettes/denom.Rmd | 3 - vignettes/desc.Rmd | 2 - vignettes/desc_layer_formatting.Rmd | 3 - vignettes/general_string_formatting.Rmd | 3 - vignettes/layer_templates.Rmd | 1 - vignettes/metadata.Rmd | 1 - vignettes/options.Rmd | 3 - vignettes/post_processing.Rmd | 2 - vignettes/riskdiff.Rmd | 2 - vignettes/shift.Rmd | 3 - vignettes/sort.Rmd | 3 - vignettes/styled-table.Rmd | 1 - vignettes/table.Rmd | 2 - 42 files changed, 289 insertions(+), 39 deletions(-) create mode 100644 R/data.R create mode 100644 data-raw/DATASET.R create mode 100644 data-raw/adae.R rename {vignettes => data-raw}/adae.Rdata (100%) create mode 100644 data-raw/adas.R rename {vignettes => data-raw}/adas.Rdata (100%) create mode 100644 data-raw/adlb.R rename {vignettes => data-raw}/adlb.Rdata (100%) create mode 100644 data-raw/adsl.R rename {vignettes => data-raw}/adsl.Rdata (100%) create mode 100644 data/adae.rda create mode 100644 data/adas.rda create mode 100644 data/adlb.rda create mode 100644 data/adsl.rda create mode 100644 man/adae.Rd create mode 100644 man/adas.Rd create mode 100644 man/adlb.Rd create mode 100644 man/adsl.Rd create mode 100644 man/get_data_labels.Rd create mode 100644 tests/testthat/_snaps/data.md create mode 100644 tests/testthat/test-data.R diff --git a/.Rbuildignore b/.Rbuildignore index 9da721c8..dbb90f3a 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -22,3 +22,4 @@ ^Makefile$ ^Jenkinsfile$ ^rsconnect$ +^data-raw$ diff --git a/DESCRIPTION b/DESCRIPTION index 0e7ccb87..77a85792 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -62,3 +62,4 @@ VignetteBuilder: knitr RoxygenNote: 7.2.3 RdMacros: lifecycle Config/testthat/edition: 3 +LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 961a7dc6..252d7ef5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -58,6 +58,7 @@ export(build) export(f_str) export(get_by) export(get_count_layer_formats) +export(get_data_labels) export(get_desc_layer_formats) export(get_layer_template) export(get_layer_templates) diff --git a/R/data.R b/R/data.R new file mode 100644 index 00000000..bfe03a1e --- /dev/null +++ b/R/data.R @@ -0,0 +1,67 @@ +#' ADSL Data +#' +#' A subset of the PHUSE Test Data Factory ADSL data set. +#' +#' @format A data.frame with 254 rows and 49 columns. +#' +#' @seealso [get_data_labels()] +#' +#' @source https://github.com/phuse-org/TestDataFactory +#' +"adsl" + + +#' ADAE Data +#' +#' A subset of the PHUSE Test Data Factory ADAE data set. +#' +#' @format A data.frame with 276 rows and 55 columns. +#' +#' @seealso [get_data_labels()] +#' +#' @source https://github.com/phuse-org/TestDataFactory +#' +"adae" + +#' ADAS Data +#' +#' A subset of the PHUSE Test Data Factory ADAS data set. +#' +#' @format A data.frame with 1,040 rows and 40 columns. +#' +#' @seealso [get_data_labels()] +#' +#' @source https://github.com/phuse-org/TestDataFactory +#' +"adas" + +#' ADLB Data +#' +#' A subset of the PHUSE Test Data Factory ADLB data set. +#' +#' @format A data.frame with 311 rows and 46 columns. +#' +#' @seealso [get_data_labels()] +#' +#' @source https://github.com/phuse-org/TestDataFactory +#' +"adlb" + + +#' Get Data Labels +#' +#' Get labels for data sets included in Tplyr. +#' +#' @param data A Tplyr data set. +#' +#' @return A data.frame with columns `name` and `label` containing the names and labels of each column. +#' +#' @export +get_data_labels <- function(data) { + map_dfr( + names(data), + function(name) { + list(name = name, label = attr(data[[name]], "label")) + } + ) +} diff --git a/README.Rmd b/README.Rmd index 5f1c058c..d4c29c51 100644 --- a/README.Rmd +++ b/README.Rmd @@ -17,8 +17,6 @@ library(tidyverse) library(magrittr) library(Tplyr) library(knitr) -load("vignettes/adae.Rdata") -load("vignettes/adsl.Rdata") ``` # *Tplyr* diff --git a/data-raw/DATASET.R b/data-raw/DATASET.R new file mode 100644 index 00000000..6514a944 --- /dev/null +++ b/data-raw/DATASET.R @@ -0,0 +1,3 @@ +## code to prepare `DATASET` dataset goes here + +usethis::use_data(DATASET, overwrite = TRUE) diff --git a/data-raw/adae.R b/data-raw/adae.R new file mode 100644 index 00000000..6513c2d8 --- /dev/null +++ b/data-raw/adae.R @@ -0,0 +1,6 @@ +# note: adae.Rdata was copied over from vignettes/adsl.Rdata +# this is a copy of the PHUSE Test Data Factory data, trimmed down for size + +load("data-raw/adae.Rdata") + +usethis::use_data(adae, overwrite = TRUE) diff --git a/vignettes/adae.Rdata b/data-raw/adae.Rdata similarity index 100% rename from vignettes/adae.Rdata rename to data-raw/adae.Rdata diff --git a/data-raw/adas.R b/data-raw/adas.R new file mode 100644 index 00000000..f078817b --- /dev/null +++ b/data-raw/adas.R @@ -0,0 +1,6 @@ +# note: adlb.Rdata was copied over from vignettes/adsl.Rdata +# this is a copy of the PHUSE Test Data Factory data, trimmed down for size + +load("data-raw/adas.Rdata") + +usethis::use_data(adas, overwrite = TRUE) diff --git a/vignettes/adas.Rdata b/data-raw/adas.Rdata similarity index 100% rename from vignettes/adas.Rdata rename to data-raw/adas.Rdata diff --git a/data-raw/adlb.R b/data-raw/adlb.R new file mode 100644 index 00000000..53c62018 --- /dev/null +++ b/data-raw/adlb.R @@ -0,0 +1,6 @@ +# note: adlb.Rdata was copied over from vignettes/adsl.Rdata +# this is a copy of the PHUSE Test Data Factory data, trimmed down for size + +load("data-raw/adlb.Rdata") + +usethis::use_data(adlb, overwrite = TRUE) diff --git a/vignettes/adlb.Rdata b/data-raw/adlb.Rdata similarity index 100% rename from vignettes/adlb.Rdata rename to data-raw/adlb.Rdata diff --git a/data-raw/adsl.R b/data-raw/adsl.R new file mode 100644 index 00000000..2ddadf89 --- /dev/null +++ b/data-raw/adsl.R @@ -0,0 +1,6 @@ +# note: adsl.Rdata was copied over from vignettes/adsl.Rdata +# this is a copy of the PHUSE Test Data Factory data, trimmed down for size + +load("data-raw/adsl.Rdata") + +usethis::use_data(adsl, overwrite = TRUE) diff --git a/vignettes/adsl.Rdata b/data-raw/adsl.Rdata similarity index 100% rename from vignettes/adsl.Rdata rename to data-raw/adsl.Rdata diff --git a/data/adae.rda b/data/adae.rda new file mode 100644 index 0000000000000000000000000000000000000000..edfb559cb234c5a3da1fff2446615d0b8a341b84 GIT binary patch literal 7372 zcmX9=XE+;-_eJf}CRT~jh=@HKqehEHBnV=bpv0)H_H1i6gd!nE@Y;LtRV_lrsy%9T z7%kPI)mF#bf8XE#e7NU4&;4@lhkKr5;NW#tMc*D~W$!e3;>4((bpOv^{QKwIfAs(O z8GUyD*0+p*|NJ>nocZ(n;Dzk9j}Z*VC(Yr0THzf}y>lb{+Y(!c*Er?k7#P&~(|uSN z9VS4m>%1P*3`}th+D4A?1@Sp)d{E?E;T*mj)Z)T@Df>m_xsoGKZiq~r8r-`Az^a#C zP&wftRzqH*^7xy>Obb*WR8y@$81tp2Pv%zc^tzfl@{&IW6oqu3;3AurlpRJ()xA|A z!J|vEE0%Pn>Rv4Pa6$A^tLrjg^Qt4KKP$QruB&${2;--zVD+?c?pv5gI_<(Zz0 zrvBm;YSDQ4Ky&{r@sg3El2t?1-p10xBe5ucL~p?^o5v*Y&c|PLk;8M(4j@clqapW< z!$v=TK$`0|-+oXdXco^cUiQ5&38(%4vyk_DT1=#($mMll$6t6~WMyrhPcZ}!`+kK0?f{buIQ{m53 z5j3HP@)4}*c_c~CPm`votPpuJQOU33OsK$Q=;j+P<5*(btZmQBu1CjX(QhsdwBYW4 zQ+N!&E9iWb-%xwSY zb&*5FZ9rO}R_xfzPxXm5ACr)dR zHSlRw-%qc7V`G;jzTupI6>x&5A+^r`GfQN?EF`C4oyf~b=;0C+G6VmJEK`#c8{xW4 z>R^a+Bi*vl@?C$s27vDT1Oh&6&_Z(%^UWWReJEV_xO8!{Y>*|-m1zijdu%5WjYH)o`B~C8O{*j$5AeSx~Jp+ zX5zUiItQm9)ZpR+cR$j#Fl7={h=-Fg{w|4wL6GT*m_(t1@4T?mvmTwp42m~T%JqxJ z16xP2k|hrHDCc&;>78UFJti0hQd>Ltg+}NB0H=^~a)6Y?pNvp(CKWy(Zhq)ZD6JH! zz>i@DdP%oqE6e9$V;Np;k96lD8@Ai!23#2sd;9{zfvI(!SzEEN)i`w3s%?T&*{Gx%JC_a))UUk!-u#uXyE#vZbC(8wiEw5aLlzl#`tluA&+_v}UxP=Czor6>HA8q=5vm5DD@`D5QZ3mOE{jIsaFu2H_Dxu9wYY(mALz}Y zH=CMFy$mWYuD}4Cl+eVULNc}ia2w>zdzUVTrkRQ(AYKgm-~|0@$xgnB6i_l3%u>xH znagy(iVrER&}y4MeA8uh#EV|#>JfWOz3HI4clAD%^`=e& zTH10umM00uto*SrC8t+U+68KMMQ|ynJiVF*26*pMA>%ZNg8>fHnTTO6WS^{rdx#74 za~P*z0^}go+GKn945}ruSZOQBP3g*XnPAB&Qxz^wYF17eN1E*mjGzUxVH!XW3J6Yo zmLkI>lpWvO5%mnsF~FHXoj+5&rW4_}I|rllq>x(5ix_o)s6rmy3dU?6$>rJOtI4l|U-4dsH6l4sH2Bccj@8~Bb-QXmd6rmh?6r$B|{>Tkv8?3^Dio%xXgD_aA0qSOXyPvR| zw<%R7XTe5*jPy*EaGzGy@3chZPptESj7e~siVKaFk>)u;mmh(qQYGCCJ#kEu`qeUq z5GW8|#fr7GG|0iWmZl1*OQVIzP)iUVK4naY`6y$6%ryCYUUYS`eyRae8y{SVsMgd} zSKfv+knxnjHt|@dSB{U^bFyX&%p=uOe4z5G(@&(=K}diK89GOosa?u0_dp{o{fzPI z5?GMCd#8`Ayid16TDSD_%_e^=0$ZB_@HmGqA6MW(Aj`Sa9n@8AY-O98%E!xzh85Oc zYvUWjIDW$>qQkQD(j$dSRXy)O|MG0h2)#XU%8||+Q6Ugo@ugXixY{Q_`LdL=2&Q~I zC;{|)7jw^c(gaF&0+X_rUXUOcY~FE&u`-$0IE$kGgd>B5dDtdlD}5e>N84r~lxdd0 zcu7W?8~>KV2_vC$R?W}fp1fUq+M`ieF4k#Q1!Su~diqWD9@+Wv@bJA0XZK3a#1_|p z^`}GKU*%3N*L_tge2HdEbg5M%f-w4q!Z1!bUVcMX6?_J=-JcJil{YJ)A(zjMSc`m%}uDMUXQcDny3=>`;{duyOifyI?wqY7OWxRHsMDaLzh_UmdY zPJS7d1D19HQ^&_b@EUT0!@~#kSaLN zp8nLnX(O-`Z+~IKM@>!Ko}$BB9egu6CVwl+ZTQYpq}T<)ZB$||$-^C?1@6WnE^U;# zGNuAt1&}H(7IpTiq%sc@zp<596$RD0GT1QNfbJ|@^$+(Ce~T8td&|>u2(^{oS6$NS zR@s;^4!)Z}zE$OC_xE+a<$ovt43)c&x-HHDA<0NU6Hxx;U4CB14|6?}X5px|bx)2I zF++D*Spfv)Ea;-*UDfdXLap~VanN`9#gl8JQg+_8M`p;z2O(FdukcNd1=C3To2Y3? znDJ9PY!cEv%&$#>1pA6!rFv&CugLZx=Uv-r^(L;aQ(Rh$K-;u5+P;1I$Fn<0KF|ArT3%KweW{LH+Fl>KPZ-V9Dg;Q#`eR?MCp=jv;1@1odtK(zYl zN#4LIkESihzKNIcrI)!Z{Fl74Ju4!%c1?#KLnN@m>GWiXmJzX;=0@ALU!W5eBB{@>!TH9+;oqG_e^G7igSWsw>_2*kv1>g#GHUg<%1;YQvJy2Zx2u zCVA7VD-~`s1<-;@BZ!3gxiMjX0di)i8C9E&Z zuR86yW+-fEDDXEjc&+WZYbylnWlMUZ1MM5aSBewUkS@Jshqpq?BER874H70RXfY6dV4>`*}dbPNtn{OCz(^CK-guQNS{ao9c6O z!s1e0RT=mY367mNYOOY|&AF!KE`?+X=A%cRqe|nYOEG-jxrW$O?m8aztxdzUZ1tS? zZ}V%{8-NdkgMZ}}AE}4tir40=zzq?8R6||zz~Ux4gDI}>kv8?2^jH>Y&}p>-vMllWw4s8 zXl_6GG`K*9xu! z`4tuX^6R!JF5=RZnj*Cdal*ZPjX*0FjT1+$fyb5i}0s=W}6)~PLn(r zeBgUDZ_Wd+Z2W-?GjkX;eXY%+9#NldW6Rlo zS?}}RCrOO8MXj@3FWJz&B5pzFFe2_a;nk+C-lXiLB28t5-cSC#FAoA6-tIQ^y~s>> zYPWXEc5eaQmkkJ>BWP%a2EM23kj%VJv{QlP(cC3CWNnWB05d>Gag zBt6~SZmy(bu}YPhL7!M_DjE)B2CAChCzrF-ed2P}O-nqt*l@iSA$p7NTUqx4o9A%M z%SBpjHz6?t$U1nRzZn&S2XE|QPagB{N0n{8Mv(@$VwXc_{TF2*r4L*IctOZTuhUoJ z51Gy09u3yCKuP9a2+@n3(Zz(sEP|G(R4T)-4mXzInL!?Z!N!*R&t6GrhQAU0=eq^7 zlXv4CC$(4Q%yFu4*~$uW_9x_~^+u~2AY1J1nx$>==oYiWz9xYl>fG}lb)ub`VQul| z+D870`tl@)4Y!bqQXD}igk|d^>ovDMFM{UhSNT~)Nv6AebU>h)qjuqy7MncOx2){$ zxex0!awQ3^P1DZ{NzhP(zJtVkPC{wEOWaP(+0^^oz*GrdQvES!;tKt?rduPvV~h}e z>UDc;kc5_}NX&h?Y|6xHJS+TL{%4-+yDy;w*9eXeC9l9dX2BxuJmbUK%)2&ru`l@a z8WoI`%R2aTaQZ~Lw+HLM{gA8D*$T_&%$KtaI6iq+55FYuk(an43!n zLB-r~hV|B+IB1vE2;>5)9Q*{q$@v0%A!@Z=_cHUN_-s93q`h8sJl zm3P&2WwWKKrEcW3GpSYP)V=>9A5F2!G0%n$n^&QXdbq`*Cs6&w8Y%X5Xx#&jgKac4 zzc3;Ma^aqK6p}qL0en;T(S@I2A-9!;_y+zbx{d+tH*HEd1kgMc;2>0p9 zPowMCGqvgNVYV^7EC43*A)OVFNYUJ7svBwwjYc9)^BcDe_4L>31>X^|V z*+8FN77|z2GX=7Fg}>P?(L{*S^xwYAERL; zWHR~b^RaElynsRZ^D))o@>aJ^xwYdnhtriFpw`IjOTfL$953E7>MQ_*kqsv~znxp` z=ACz#Q{yvOiSiTBDd~Jt+W3Lv)k`ExuLjxrD%&@$u zT)Zl)fddPO{Oj=4aiAvXu4yFV1B8pl1_3{ZEohHUf;|fG)EF`OG1M1+BLX&1?NOTl zSeC1R3e;AB^JX#;N)&(^8>0xV=T|A&?f~U?1eqLvg&PBe=5depZO1_frMqZ!A2Zlg(y*S8Wtt6vrZX5zaHemC)w{6l? zDJK$@j4M*Q>JgS_C$@7&^stN4qmxX7oocb&jj$ zoQ+a~f+qK9kiOewE%zgZV~vu8gm(e>D<8_w`=2(-^u5+;0qj!3dVA7Z*N06tQ_VcH zG}6C>zX({iVdXpgZi9i~KVF!rQ6?n3*v_?+?z3nmHEY~}Y{jBl>)o%^D8&X9Ms4($gS+223RC?zEz%!cAtwWz zWz*yDgcu5BEu4%7KDbq*7IZ7D@k@%_p1aA!?Gc*`53H}=E_OfoECsSS$SjHdt#w}W z#7w1V_R}lM=9y&w$t*wK)(siYT3_VZ!lWm~zN>E^Im9f-x{K+edbY*AiVvE%&`1~& z2Z-Ogl#(Cl2RbT+Bm1Yi56m;`Dylj?hPGE`JFW~3h}ky&=y}=l^zG>fmE-pJLfXG) zuPM2WX)o^0xNSx0Z1>2T`1bRdYs=(`tZ7G8onAd%p6q`uFIA^0CS@gH5;*AFZP;?_ zgI&ueH#x!yc1~b_&#Iq)R>`>!)@D-N_P6O>x@zdS9J#hxzULej7TRp54(Tfi4`~{7 zvp+w*E#bK5Y%u5>x#tY&N!uy>{D@n0>kY6)##sq;65#8!x52>9#0%By3)Vf2D0aX<68YsFgGY;&7dR5g9!GsfP0TT;JlM@4$&M;8JFVnCv*Q zKVG0H{X_l@dK`7}OU_Tjw6j2>Z1bF=3YYUp(A=JXsNx>#);85+AS->m`Czq5xadK# zx>DtY&Q`Q4@1n+x@{N>AUcvr-*2H-qgyK(&w*J%iQe`fN3zO499}1pXRpK^+dtf4C z$(OIu0JlZOYo6@?Xraj-$>6SseO$5T@ z{1c74SN7;r!aC6Ac=BVXV^#L%b4A;zmGx|xs;-~&@ZkF$Ha``(+|+fjd*cv_QVUlfB z69(T?!yaZARQ28|fB0))-TzU}iY>*Tzg$4**e;~0%b&8#&*NuvHnr-68;SccDH}C$ u@m{H{+Sez95-kX7BDV>lr`;(abFwcXp$(IUH$NLv+)cYv1|G=W?f*YBZ)W!Z literal 0 HcmV?d00001 diff --git a/data/adas.rda b/data/adas.rda new file mode 100644 index 0000000000000000000000000000000000000000..59f8236e603123ac7b1efdbbe8508d8d5ee71577 GIT binary patch literal 15031 zcmaibcT^K!(01rG^xg@fgeD~*RVkqa2oQR&0Yk4M0xG=(f)IL@-jN;@L8W)4cTjp2 zL_k3O>Bswi=llDcvuDrlJ$q*Eotb@h?sNBQ*q{}q)vbk0tqFfo$PkY3z4-V4ldonx zr>`Dpi35vo0007&5T_en$w*@WfHgxx4$%2UC4ATHc>Ozos@~LWmGJv-073ssbbBNK zdq-m@yTUVn8U`^oH;@4YlDOPzL9|c5mpis zCQ4?FOx+TI@#D^zuK)l^wb_NnZ?bo$Z#S-4LPUa9x~OsR(uzw10|c~}+6ayXK+!WO z^mJ8Jrbh;S<^_VmyE;RN5imEhY&sfa>LD%5G#wwwQ5-wTI6_*^L2-l*gQC^rR6ISZ z5b9OYLTU&?G@(aT;;g2gs=-{i*$N*T4Va?68y*1tLoFM*x9++nLE>Ys+wvXszT}|v)cJk4ge8?R(HAt2n9f|WMt4D

S{2O7Wu z1l;-HPSX?sepJb1fGjCa8|XJxFMT$$qWJ-USIbB`b?m<`v1I4H_EhAKg;O)iv`P7kVmC3Gl9mWb;V#XOWSiQ|i1B61~KdEP6sr@EcQf`b=F7CFPg5 z#r4Ig$wA&1A6L1CR+b(hsR;c93-gKD)lDIqVr(McVRi;yN;Za?m{B{@&LSz5olb(D0(ozq%KalsyFmTzw|muO=E7Zu$a zu}LwLN%vqS<0#0qdmFg2IojA?xFWt1xHs#sIF4-`mXuQ*m9WDHC5SFF^5c5vCl|9z{Xitr3f4rc$;1NjZ(BuWOk;f!uEPEnm z&3Yv0Y-Z?q1UfmnLnUo#gm0Iti4?cSziACWx-lyx-JxA4o%~_fb0)Fd>-BOy_E(Ng zy|oBE>%+_I(?T^Cb$a?iSr|I-K1cnl-eJlI^tf!{?vg$R#?ij~|ys?T3p>rWbsf#_L}BOFKBUzeJL3l3ZW%PpTkh z-=OFid_O9cGLkC`8^@TsD?lQ@aXIK=|3=zSc{;2Tk59ROf{+k82E!EOzdo-5`7iL_ zSNt^lDs&Ok}q*q6t`UU-{Qx8|HnbY41NVjUd4 zWAtSbnoWKRy8V(M!O4b3d3Z?`{vj2#C32a2!Qm?DSq7K0v63`UqzDyAq_ z)*!ui-;kQmC4igP5=WaoZlvxRFLb6^SNLdC^oIer72N&eC8$UXzAnoR;zD){E&qjn zwKGQPl*;HZf2i{6TbtGP+I9Yspr>moMn2y9CQ1OFy_GLqpUX0ktVvqv8nNHmvB(QVd*&LmR(a6`Ds2jv zx9-v<&KT=?Ek1AOWW412#X$S{<--t$>SC_x6bPXYJAZn=yv^x+(y9lm;ixRb0h!6) z63I`N>ZV;v?UJK;!ApS@r3?|1z-dI#>($hB77;~WfpO~M?^72yTICUI;Nb4%?STo2 zR`Ikzv(9^Yd>j=~CwXFYFcJ@2I#?rR1iE_-Mc}+TEvx^RLM_Q`@*W8cR_84OFh2-J8aW__ z&z^nDl!{G>VylUldQfQe98>l|gQ2}0Uq4$X)Amq*c)S1ab6FqfX^#?>I*Pa7zEg^p zd~j%57vFiu@*&A?2*~yBvtvQR=Qg>q`hDowe?6?inU^o;j;33eeQ)WRuy28k1zFvE z5&msxf~5?>5wTf*C^4d(GUN3+W$i+ zhFdzkq=dMT(tO`-ibh__B(XJwwbw=^&(1$pGirNg-B5=Ct)=|qW4fE+x|W}*W{)UQ!&X%hBcGM_4I?2&+h z618(rfY{Z)SNJgbI_hV|`F>Kl8+;@dPJj-L*bRP0akvCru>AGoMYaTo!mzA*;YzD1 zM?>5G*`Z{g>|$05)4Ba{?|1!-!#I;Xlvk#1CCSegD!xe9iy#+zas$u0t7*>LN6M_w zns(2R-AuL~7mov-V=8a6a^#f04^Whg8E5D;RbrWPsY#Z8IkrAmX~)k*$C|}X`Q!J- z^q_TBeOYqsjpC~!Y2@_WZ^30huKhf&NWboU8ko|s$6(zULp*i+yTvqr>8lopwxR+94I!>y66SXbBHvQO~2qyBcjrge{fv6=A9i zU`@lAzNp8x-Dly(QOBX)xl?|VPm#!iXFY_q&h$k`Pk|aceF#8=kfVKpBcJsZ;$8<^ z8HiLwmpnF+fRCz4y%H=hFGiDqc(d*0%?|XO-7;SBYhC#0`{hIODRak@U-!ZQBE}5# zdenLzqmLK$X*wmc!qQlMG`k2Wdps;N-PZ)=(&g6XMHDfLh{fHaf?r`$B@4#X7=ndP ziJ%F8JfbzqAQ7Qsf4e5zV*0@T_(%7;>Y%>^h-kb;N5f}-cFtc?)L3veTwHw9L9^Rz zNr#@^n`sSrF*hQqf}#$e4TCm!aZ@a*nNYw^zOU+xMNk7;`p#Y2Ac>=PrG!@w%%v+^ zKZv*lC0LUSCMLu@zl2kQ)DZ&=;`b_z{YO#g$1>}cfhk>?0W+6<6V05Rg}S^2xV6M82cM)tvdD-ocoRFCa*qOWxAR zi&}}bvD4!6EfZi}f$Eht804Vgf4t)*J5O*$mk*?J9ZgoEN(=OJWC(@Tss~gX__ty5 z)+NNyGrsxi5PK(@eo-0|l1d``a-c>3vO;P--rvXzfzGbwc?F#BShyGM%5>4#hQ?H7~m*zutJ- z@rX*yrcUOl#miREJc?v{!&Tz@RJy_|Mg0_Fe~?}u0A=OuweUninJ=}VX!A6 zz}C+5>(SZimxIp@wKE#p)?C*HMp|bE^6%Wmt_vn@_>Mj1M)<0F60kpmgVtLmPwY$6 z6px?O-M?9o`TpqMCo=X4NXNhon8Ob3M&I#ohQPE=6Ff{YTMb!7FRxW0MZ8U;IExc`1pZtW|0;UB_x=r|M|!78tsCFv{dtu?!rv}`y^JUS@z++fxk5bD zSVfSraJmZY4r2EBIih?lESb9XvC%gOE3(0j@#im2VV+-FviYMT&(Qjwy9^?flOU!Q zU$19GbJUuK_x%?5F~Q-}AK84X6DGrD7>tCve4uAS1@603xUc#-K#$uCyWrlvT$dtW z!0Y84q7)RdnYuWRqG}$Rq+M&-`0e3sEoNUtEoG6h**YrO-L|x{?KJl1sO-17t{{yP zJHUll+TxKn6^TF=oM?oN&Ml;o9ModF!tHG;5 z0K%=mVYzkW-e2}t6ur-QGtX>pZd(mRo+6WygbnX=V70m+AFUH@-UZH}5b&-wxQI~K zD@3X27l(h!9Pc}u-tkIPJrW3s*w+ucjx3Y7aF(4#7}N~4X#ZpQ*RZJVs=~7S zg46z6Pui4N*MT`Ao%@gaJgT!)xwvs(E@X;e%c%rJ3{Tx}exzzOnrb&)_TJql&+N0_ zZSBhHf0MvviM@SCxwwpHM6NhII1)g{IU zYSW#&*WAJ{Gg^4o^o}>7+glVM-7U0vmyyZ1=qid61Sh`9Od`kd(at7f_!8FC)$WlV z)s(3llf=PZHMKgawQ401ipNDqlWQ?s@YT@Mfl2`;)+WZ0WmbHUUu(QDw`RwaUXG3# zYHbFQGF{3fCf%AydQ2@K4fN4O_*TYB-KIQl&#V3CVDE6NhO6X5XS??>nb2f*{To zg?^yS+=n00eRy*F=c5r3yE{CPDGqGBKSxd zoG0Zx1_$_PLhfQWmB~zZWWXtsUA?uG_tsI~ z=oJiR%8NyUjY6WOV#WqEYGMpG*It1LIl~MRQ474K6D!9h^Qcb(rZ!Gh4JRg(ri)adr~B z6P2-<8L`JQl6XJ9I)pF&z>Mdc8f~(0ox)Gu*h`!MAI*1%8TA!1ktpvvz%FtOBwzDd zS9Ft3DtomnIPwXrTt!tJh*3mCl){+6lTRv9Jem?cH+%YkbuD<176J72eTr9 ztysy>7WYEWY58u{)wdjR?6rd`teAMM(N4dS}?~-{$jW-GYb}p@8v``B0E^HCCQww zMw~lEpZ480m7DlYCD<`4WQr2ViWV4K7AI4twn!_`-1lto=kHzL|DvJLI%r4T>9;Jg z51V-WZbyp6oM%nF`@+)(a0g4Q%A4=_y^G?|{ea2wLC%sUx~$MVZRhb8I9YsJYp}CT z$N+!66~Y|qVmiPkKho&6o7qgH#D+=PEwQ2lda z+VV~3BNrEsY{me(Unh5ZM;?6|L9lerk?KmVARnT{#Z{oB01ZZN2w@9373H5OC_wZ= zAY}!qH2h0DRom{9T!q}94EItE_sN9fq)r1(%XOp<=Dbh6mp?AAeLa{SZF}U3E8?aM zboyFOjV*vWw-$17rw(CrgV_8{k^lQdJk1`KQ%Ny(KcM_=IZf)YtNW+aefp)-Cn;Di zEvQs=(Ay2l;1D*`7~CKPz5zjSX>%xZ6-_8}sHSZ(^469y~e|@;SFK z>h*t6)QptY=Bv3EMF4}+(bJuo(DOx{^*?hiA!E76J`?_>N++94l8aZlvzTJ#6F)tp zK0Vz$@y(=@V7D2FT|-llFAtTJiIW-8(6XkNDbq&Mcj;oS`BG|0Yc#CzRyc$^Uu9yQ z86b@rnZ(SXPE2J2gV%erP2k{J)cE*@h@!3z@Z-bD-Y&7SeM58YMP@+9VpPm$IA?`I zjavuXUJJE*n}(vQ0UVqzTx#s8YLF!5a603Y;sbMqb0oV#;%7yv6SeS~NKW)*rqz6m zpmC-ZJgKCym4n&6+@%bkyUMmAiol|y+tCZjHu7a64eBmSt=>Z|t#^zy%w-T=?}=@- z#>JP4q)54ukOJ|mqT}ASW*Xj^V=VYaH!p8bpGGuZqMp+Nv(n;)Zt3WVu9NS;bZ|`9 zt;jc`>%A>RYdX+nUAZM&m%T zGCr*}QM5sh($;NV3eCtyT9Gqc6Cg_xGD)hyJ9U4$df5@Cy$cz52($Idt*~le1+qrD9D){i_|fPC@E)Eb9MrxaMaX)@WqSmsEJM1M2@^aOlrTG4d_YGYa&X?)~q=2l6+qbAgNl`sVaZxt?| z2mG=L+X!8Jf4~op;=@@9(K*Ws%5@~pN|Q9os4YurdB_UDg%&F7Js8>9E3l+B3uPwL zb>JRbyORytp_$kb%A_hDT+2`_QYF`_u}{>6?Mr17S2vHa(jPvxr_Xray^3*sNb_I) zXH#}-htYS48-MZ$S8ob}p33A8QGXgC{>VOEI+GQ}*xAGQ2{;0Ob9VBIF(=G?e z=o%S}yfzRqV2b>3s=$Q)j zBCj6kT(n%+ubT{e`Q)q)_Ysp}o?QoJ{JEe`jAU2-<5<2GVwF3Z1~(BN(4(asiFy6! zM&VrhW*{XtY28lZh-i+?n@&Wr=7fN#O!aMBOw75kAQZh^o{@2fq+GmDn7(mJ^_S%a zakD_tJJYV3k6ee)cQ}|pCanEwXhK0o9=&%5#KFkkv|htIFy%}t&j50B$eU)kb7Kci zLgdl?&DFv#`3jg21qCH}Qy`F=W>{ED{_YOyz5J#yRlt2KU&{OI$n>Z-$=E_8$pqHB?x8USYaB9l$jR^rkVI1Z4#F2ziD^EGsAG|!?2VWCA zo77a)gn#z>7|i*WdXo8f>f_D@!t9yF%qo^v0C@fMI{pwqC`ydMW{D?*YZ+Jot>EZl z;wvoAottulI2GhLpy3BwO3?7b)?q1Hcfvv~@Xf=QJ87xIWI-88V4~RAXDB{7iqrNW zj#Mn0Mk&opNN<~e90{DF7Zp2#OOrRFW-8=RxD!F$a_Uqdb<}2J?DA+^MgT=*MdDou z+-E@P-@0y0XN1CZ#-4$J<#3SS=bfGjFsS!gFb;n1hw{F78KFu#hQ27mW?tUS!kkB^ z+oD=W`FMNz>3$l5%wTLhBcVvD^RY<;i~8 z=+RmjwYrl12L9Vom9>n!6Dn>~tSTXMr&1+Oj;VjlyPAF!!RGl8_$B5Hr^~M5rGh$A zfH0l0!Q0R=^# z8}FY9x&5E~1MjkRT9HTLpt|rhL`KCbgoV;1vy!P2q6gO!g&R_J-oq8Cn_!F z1EHT@@-O*6MQBez1B3lTQ-?koKB1p>8BBucR^A!226&gQEw^cpLERb~yW~gJVI)*Gg>)t`VApdpKP-m4uXjTF8z{f^g(7jk7pXV#KH6cwQ8>39w-uP_)m zyn{-M{{&?6M?HO1Y8msZ_-PaN6M4YM34BL|R=O2xO0mB zreZ|DR8c7ib-rQHP%YDd=*5cjn`l_`LkLSuOpsbI!9+b>OgbBSc}GD_A<{~mNh7T} zo1vrzLR=#VuE1QJUo#~~6k)7!S$l7V>3I~&kNoI@2AVjx)AxjM6K;(NR zOQ(;f(nB}rm(l6f$U|r7VkbQLEoyx%7^uK5h-d){X8Zse^Pw#R-gTPVc+7nWLe-Ri0vH8%u)GPmdwvm2W-SfBYil>12C9Z4UU8QTj zUhZ9Cg%Yhg{Z_sCbIMQ#fr+OtrH^@P5rsT0Z3|pQ9QV066cv@^L%CntD9QT=yTHP~ z)7({>6Ead&cR9g^E(h|EC45VEe_Da_TzN}sfXgh=d9QMhQi9O>V_G?}U^w}bJ|-T= zN1IdH?flq-q-irWx^De!>yO$z#zGBnJ+64S6i#fWO!UDZD_$4$RQ!4JW%BKl7h`=A zksTl#+N@TP0v20?FZXFj+M@6)@)8^v32#SwIXiB}kyTHTMKuiDwpFbF$h=upw3Z(^ z#?|OAn$KWqt{zCC=0l@9$G}{z#Yj{ts;l&iH0g0>T?tO2??jtHo6Z^L5Nl24eXwBV z?jPD|W0K%nZE0JdijZ71OdU^GbJfx^p~mTF57nI-P`79dq=U^&Rm>r3%J&szhREkA zSU{-=e>jUSUrHvDiODe4AQ>F;bEQ)Y|Lz&;+TyWc!6p}E+ri-DU0?fT`z)=pnuT7La+`8b2~Kqu`629m5Q}j|IfDjHKH^}0>-6hI zKPsr0#tV16NXQmk2jTXJpAz5U?qHREy*++?1L-6&fYvhC)S=Qm*rZVz{OlabB%bP# z+Okj%1Ra1kNYLz;&^6Zv3&Q|r$t2Zkj`})~?Rj$9KSl#u)R=BO~a}TYSENW?d)2m3a z&TMdX0FwCp0&|qBB|D4^j^6G3PJ71YdoM#&cQq$nPwztn%N!pl-tP^Iaz??@(qS_j$III1>6(;1xG8;e zN?nF4)k@0F=sfqcyot^4&nu?2J!Q(60kbbVKd@z!^pVnibtuYT=%BN6A>hODr!ZSI zcv{tzj5KPLqT{V&VG=AF>Sc~u4=5T<{+RYw+O-fRbu~70oAe3ijp_{5nVJM`*$9@~ zI#S6QzbX;giC9c-wrqsh0KgR$%hT%Cq+Dp+@h3B&}JHZ7@9njqQ?;#^zT zdZ*t)e@98ycjlZb%{cXy(NPeme+DXMWIDYWlyrq0A9XUxv1r|=X;;W1XDQV6i-;xg zKb@~?Y>$Jt2x}oZ5t%?!n6b}$LUl1$<}jACgxCf*&Gq?0N!J&TWY+Q^Bs66*A{8aLMkR--puWWHTm&ACq@8?HNhK5$6R{3!lyqxcL0cFpB0W7E4-`5p8 z#9fvuyPj+9RIOZRB+2;*wXysc19lU&kr1yHWS5W)-n3iJZZn>l8=8p5R6T5~M%dGH zBBZtJtSH3XO3LPU5O(?Qt6J@N1jtIaBhz?j9o-HW1yw866!EI^Pb1%`v@je)ri z^R^ak#szgMTDiG9PKTm!a%Pd}sd7O4$w7x)MQG8F0q#gguBoh_h?b z3rU5-*@DfZSDiUssVvYHLi2UD+TU$0q`i=J<+i?ot1we*3`yu~OYz0$yA#Xq>>@H2 zvCUKb9r%e7WAAK{0aq8Pd=G3Ul7d5@LMGig-NQV_v)pEAWoD%gB803$ui$Kb+K9!6 z;C!nTf~aU&c}7lBHEOw<(6hRq2#4Xu(A~C{#*S{R=SruGUmyZeDNiNO0fC|PtmWN> zpzSRjE-v6?78xpS-EoLax*LbAtF(*@YE0gJTq_ZsTUFW`EuIN7LuASdP1btoRSk+V z%I9KC87f4^-K5Ms+&#*SH6YF~90x;;x`ZY|N*v`5Lg-GQs@@^|=|#n%l|neP0=8T& zn4HE~qNzOeu688RmKCb1DiBFYHHuQ9i z5JDuq6{yD+SL!Y@=7C_K5``EqAu~94L4 zGy>s@GDUHU#4(cyeOz)zmdu<@%{_o|P`nPB%v zLj934Ad;7K?~S|qH(TQy{xBv*WuQmk`gcM=Kuks&0YG|r^v(E=MDH5<5p6?LEddh( z1x*8%{^c-J_?5r16|J(ASic)Wr}br?GA>hc;6?1wyW+wRz zi#KQ@>@=`lo&f|Z_@Q16X8brg*H9?lu@-#pst4tXu=LXP`yHVBYB3&-W45?~` z6rpFdMRRDWjW;b;J9iI|UHmg!RVYeHKREUhD!I4WtR0oedBgbheYD@#6yTC=xI*6S z%w-VTo@%ygtW1U31RxILxyOYA>2su!B?syXZ;0O7mb=v6g&qiSWEGa38ZL{m(h!py&q*LQ_P#6A)JpY+BJyLliPB`#)aM%Z1 zSm3kKq;&}B!MbYO-hWnn5Acy;O4t7$T@?O)s_?4hH830+&QE}9vfUSMKY!S}`y>e@ z#rH7mFhjPG_QrHOp?}KHMO5gzVMacZj?htwy)3;YDf<=e=h$AEz>jo9uMU)G#mqy1 z1|Jjtc~GjUZHI)1es?$d`#WsAtqTvTn~F|y*CoTKZ~a{V)uRD(gC%ZU42Jq2rfCSl z%nTu4zZX_}mPB4D&l8i)@5reEc{-NgY-MQ2Md8D$c=K zamjEyvNJOVrtJjUA!g?T#1qQ~gRtu<`q{=vd7@}*iPJzj8lze;PAao@@qU^C;aYG+ z{I;oN95ZXACj51}R#|jX9K90#4B0R360;R8*t^$%&%|;+5(8G`xvQ_DtrG7@Mz9an0Sui@TIa|rJK%UCvw_=@B9RNY3Uqkv~G+UO3(H2El{Dv zW^VSdKy%%>34d?5?%#yJhEjibl?=oyMni?^&bqcATGx=I(GlT7g#V-}?_+bEmZ@ii zzHAp{H$CnV5+O_ze{K(C5E^FMr&9)P|DplSMRkmS`D|4?ysX2to*r)H&dbD65d}#6 z4afptnhAy$DqPQhu^mY0$#=-P{jv72GXYuLAi4D&xB2^6y0Ut>_Au>R@{7;e^T#rc zk3R~e|Kjv`hx+*qp{jg~ut)(}Y~^Ym8W__KM5iS4i85`aihELh|LNPayB2Na<(&F6 zAWuTEVaZ=1So}dP&*{7DqT>GsoMvh!k&R%sgq8@Fy<=jWiP+HUKb2B24D+h0Q|Rc) z5phyc1Z#U$6aS02IYC71dV;`p-rnp|_Ym-Pi)YzRE%q507WU6PKp>t;|LBZI_J_xh zXG6>1i^Z>c@Y}K4OSd(a0;qQ(Z6k{&>jsi-D}pclXu4-7ul5Q8_noLkM%wC{-mw_L zOr9r25YmMzSM@61N-uveI_WaHqBpEHdv%n)WBbIko&VQg9c!Q1 zV_!$^m5nyCEM0+QwkM?0$>*I`xr5`g;(xDwLVej+(qHRfm-6A$Y?-{-+D?*_HBPJF zOQ)rGKlfH`^LSN|3QHGtKK<-(UL~3xORT=m1zTSzrtq!)mZ|o8Z8qw<YPvYUO$5FUb4_*B($H>Wq`=cbEW6ZU9Z1)KiUWKZP12i;&5c zOVJsh$48^T2MH+14mq_Pm-*;1)>-F<_rr}*5WmPL|44vlizl|%K52b|)3n*dA@J8j zBAU;(7nL6FIP@Nsa1wKEf^Y@@hPVjOc?HJGHDEVhyRJa&SX=RozwaFxFZ;zf{6(f$vy4)4H^236T7e)`Aze_WlVSwEt&`-aC@8u9L>F=le7$m-(%0oS>a`k zGTdywzsJs)uG#xJO~!ZwC-VE*i!s~xPZ!YJkRKBUXmK0;!B>)XPs~CXKGCF9^WN`c z<`|{0_IOJ1-E&6M>no4hrBEVpiwt^^XRXaU@|kFlX23>AB>ux#{JkxEQ|^on_G)0u zb!9@+JE?OD$v?MIzbC}JG)0DC?rF4}Bq3=W$6*OuA1v@cTJ}71CULITT^lhs_dB99 zUi_MQk;WnTHr(YwFn%Ie0@YL{*ZX5{YP7UJT~of4H)KFU#rccRXP)dFYUyLBy|%!* zfc+!qiof?(dEBQ0aAE4T@1Ax3J%G7NUIv}bsK8nzO|-M4t)k>3_l!HLrii}z9DFEG zems-hm1*QmmZ-B2`ISsAA|v(d-=~@ba%wu#q8ca1Aj<-p_fjW+KRUd77wzDhb3s|3 zcgSw)-)3&JHIN8nN6bRlQa-vm>~Vs5@5*$qEeE_={NLz`6lF%-&-RqU7ByKT z&A;Apx6Ce2=Cso8v*mk;HK2B!iC$T3ZW5)@N{1!Bqy-H94x~|%@~RDZZN~Z4ugCEC ziKONMX+Y`=6t(f^wQb#EM3y5}a~L6FgEW#gk(m_V+OzV{g@)TRJmL07F3DB3>t@Agg3%*a{m%>M zm9h~T3<(`$&yQLa;=0O(8Dd?7*8#F!b~@B^FNS=rwVxT1)oke(3V~)t-DKLQ?{y;2 ziX4j-n;-N}TpIsr`)+aZ%+ba)`{cO_#k1%bJ_X+{<07xeancnlxyKQ%9rVu346`a! z!V=TlmPNGGQM$T&ZM#R1%7xFeaeL5nVGw zm(XQ5Uw~O81wo}vY8#kK;n-$bd2XH2_V}5-(!MM`>#H2^>Z~c_Vi|cPNzi4vUVB9ui-}?T1 zh=>@KCsFp#_^APWet+@bqC-TL^Fu89LDJ9jryl2M-ySwzau>39{HJNpz4SF`KRh@1 zH?F18CS&ft@u;V`VcJtQo2}j2)7&bdKZXA1LTiL5VJRSqY?y|Nw0m%Bj5`QmgK;Q% zwr2F-axHP}_hE@-+B35U_8E(Wr(YWX#1VTk3o<)|FjMJ8NjBk!Wz_#dE6Tq)g_12i z%oV(68??1USZ)3Xn6rHEx8@a4r9N-uNU^)(S4vT0+MJK;Hudd!ZBhqw73YfA9{$i$ ztxfMk(Wi@E3b;x@uX2!N|b-8Fk-fbg={=D#O9)wRE@ zRawn-29ZoIYQzeToAgs8BYiJos!Cf(DfDL;zt~CQJ{DoPsFCzihBj=KFA7dJu31ln zpa0P#yr!(E#%jzl2+tG4%?O2;pBwA`tq>j-WT{y}DwH28(Q^I`0ecmt*oBDV`nbjD z86-4(dOCJ~tX!5Svy6JwENEM}Sa!dXoOLk2Y9zDo?zIhD5mC7!o28wKpfCB>`ckFqN9Y-8!1v;MAq{NSSx*8Y$lTgjPl(08`;zpE9|yT z`moAqj8ePe1-RlD!-gD`!@2XtTT8K?_X$7U!s{M&DF(1z{k&x(wA9ehWeyG>30VE& z_4gQm`+DuVNjh3G%6bi?OfZyh$=GIRu`U1+6&W148o^;O_5GnDeI?uMq0KU7XQ?c! zIK;9rXF%2KbHIC{xr<|I#*4dsXiVqbPP;Ehau{~|846ZA=i!vFw6xe)jZ`)z#&cPv z<1=e44~Mrb+upx_jipbKo7HU$mL??6-+NejmgP>J<-^Z+sIwWz$~rA$j>^qqFHcs! z)@9_0idd3Wa#f#7_WL8=#Q?Fue_Ua-eYAf&AHkC?s+S|w#Rl}b526qV{QSk?z0SVv zOhj`2@Uh>){J-aRCIPz4%jSroq9^YkhS(0~-ERu=+U42!*4a&o=I*$Bn6I)4W+*St){m)~1#vyUB0kSJ zF532_S&xi@)o%5WrI;Gwk1zP6;DnTsacxin4bO|LQa>6B0+mOW9Y&6qV#NC$hSt2~ z|FmL#Xp(L(!(?}RW%|an_*j!)Qn>Lycx-054S3qLe$5o@_44K>8bu`jlD(sm_@C`+ zZ$~^6rpa;Z=R5l*jz(sm#sXo!&`GhU%6N12M`3lg0FAxeOyP;proCmSMEzOy5<-F* zqHl`!lx;6url#^xHGRorqznK zkkrQ*UWcBf6YaDvf{QtGt6Wko0=kX96(EDfC_2U^!`7!ACxlLCgT;6g02tkb+d9eHICkf&-~qn-iUIRncYW@4@*JGI+mD{CB%sf`owe_1_do;g zhmfH`qami1OIwzps#281Wo*v1NW2aUITb-8wg6MQ53qa05`7OxK}i$9D8I*cQsj`Ni zrqlrSHq_L{O-7!h)NG-(F%KvW27vVgLrpzEJwrjD0000q13&{nB+^L;Q)+3ddqGC@ zrcF1h4+5LjGHJ9;9--wL9-1eq`lqO99-w3zG-%pD0D6D}AOk=E001=50000FP-&s2 zng9Sv>XjsgPt^9Rc$3LLNKF`?qf9^=8X7b`CXJ{xWCI`rMuSX-fuPVd(V#J?42?7x zfuLdrfEosk000dQ28M=)Kq8bOGH95YGH9NFG(|rEYH5OEX{IKO(KMQ#Owh@J162Hs znx}@En@P1cLYv7wQ^uNVPYI?pX(yVSN_h+>Q}rk00h3C2X{4T0(*h@y^u$dBNg@O$ zMw*6bqxBcXiC&yL4`@>2mFN92sn-p>0`dOH^TOt(K*0ZMob#v~!!HE2nkQ zt_aSdE4od~uDZG|>g${bbmw-ul5XjB5svGwNOtK$S6jC(o!hR%cUKNd>AB8G={ud< zu-ucoxlZSHyU&FcHkU*vDLSk7t5m;%?rnUz0!6%|@R=yJSr{noNm{^N6Hzw1VOifF zu4pkec0^%^6-FJ)uTus~Wyx#b983qdS$9!ga?~pgRJMrROPJRx=O+#rZ9P|Z8LP() zT5Za3)HZej-9nND7!clRUM4MS;w=|5n9YF3Y>-el8kdu74V{x>w@E9Gx8_4k**0s8 zm8p$PTs4@@Y>P*knXTJo*~GyVnr3R_wRMn{CEoD?QE)_VC ztV0;K4*lBF%c)_xhGnctry8FvnJQVA1$#zHY#Ok4rI}%+mj`Vy^HXV-g$Y~ch#qGo zS?r@{X3Aj-Biyw-CR;v9s9Qrzkk%^GOJ;^rSXO~uQDJO@scy{Qqg2~VWw<$*VVQ0^ zHJPmB-*LNbjP`OzF3!&m%8Ls_LabA?!oc^Eg{o(ziFF`mzG!>aOE}~VVO4@fnVM;q z6jm8k6-tF3)I=+_)R{8Qe3;sdS3870N5<;IlI&UHFBxK`sWK}@Tx%_3S*dAi?yqRH zOk{Lxv@w}q2)Z>hn7!!8wo9^OnOm}0R5$AOm%zxfHI>xGI2>aGj6=$05E8OUS@30j z@+H)}mtWks{y)hdh;}HRu1~bh9@#0sxbC;@(%O8)760eCfNqOC&a$36#?0O%*F^U? zmABc4FXSk3-&0++31L{0^7F!DIKyz9D|N+#FAvh?lCLAyA~&hRFcQS?dyzpRXCXwWJ7lRE$1F0+7_8ey+$XiZz99c|S+m@=PR@#MH z)wxV-MkZF;G#4<;M7D~wTDgH$K?TZH6~;E&RTWXTjI^e^lbUsho6*MdC3_2z?XPD% zUy19n%T`v@tp-yQH|vz@PNY!|cP{65GH$z_-8!8*>~YZkR-9R|lAbJif;+2YD9hOX-=p~S57Y-+j^{ESA4!HTM zWeq%jviNfi9Aie)CQK=FM^`hI6Di4e7USNal|-3V#Dx(I7Yn*;T79#ZUG`_w8Pzb! znhaF5^3Bd=XUBu+ej}|qoAK4RmDOEU-{&{HD)+8bPf|{hD_xOMQMW4hvl5rhIJ2L1O|{+jR>3-GKTTsiX6|t9bzI$g`aOrJQ?lG;-P=9%$cPA(inHj~gH3+@y!Q#&Odbb-0|=d;5F9*s-0^&O z0)RyjP$2>gF(Lw#8wVglMMA(Lh-`oW0DzwsDk!Z8tafoxx+7#oh=RdDAp3ZfsG$ZR ziz%yGqSmWYrIyL5Cdi=}0--iE3LO{+0TgV19t!mr01^PfRTv~dAQ2T{z#-6MrbrSU z&xPhEZ=St{7WvH2L3H0kb@aM@4-X;5x!fyvaF({V?^Y^+>`K8%6p#S~TbvVsYvBVA z5{QZcGKm7_;ZRm}#&upwYRu7goyx_w#@v3krah+zqcf33MN7;GDWVK)83__3sx=!1 zDIy9&ii%AYlN4SZDlBhG_%`(0Z!5{5#*GHXG;D^+Mk^9n4I3FC(Tg{0$+hNcxl~nN zgKKo!(Q1;ZHpaF!ZRjg<)=jF4)p;$=wMDjhaZwv45+W2bNdguKC`&E1;mc!VV%r-O zWYvojQCOiWDm4+dHAX{X)LR&>8yjv~+f=*H@o$uvto8!tY1XWo%*PDYjaxNyS}wC3 z%(|`_th;S;>gLIE>orWbG?dj*&0$;KS9sy&&sndtXo)OI9*cAl2_lf;t{(Zm@m)*A z>bf%E(w5^_R_g06lQT@oRYxw9Rb0(cy3A7K)@ubFIdd~kIWDnWZMmF>dd+Y0{YOi^ zY1|l7M;+OrSRa4P9dT)g);)%_#hxusdTb&Uoo|DsG}Q{0bf>uMP|g=*W)*6lUkIDB zK=f3U*C`>PC0MBmi_G4`yV?+I6N3=pXTWF&F6^+3jN?&K3|1Im@)lw6wh~^MiK~L8 z?<_rtm@FwN6(y*6wG6`CVX#(rlCF_~Q%xj}_Ojq9P!ZU5_tD1@1VFO~89-G^j8Plc zdgrw7J#RZ>Rf`lc?@B(NUsQbStc>jL_A} zQPsHW0I&f-76j%pNzH6pi$rL)gI3go$301zV`1|wn5I9YnOJ8Zl${Eaa^vuvUPV|nq2JXTrhKT zInGY*blu&u4s^R*yR>t4E!Rtm<#pYYtGevc=VvWxzlF4kANi3x=T`srReQ&Mxp0}K5aAq9mI(J== za^oft=682oK%Lz;b<*piL!HaH-OTh|yj{-jolc#0IP9CQ?s1*Lm~))z-F89CjF>~2 z-Q95lcXZv?ORk9ycP{63V~v zQtwEC7y`i05zip7fd!?K$t@{LNogulw3bq?rFA5vtd&V@m6EKfC6bh^l_ZvuOC>C~ zc(&e6s_lCJaR@||NM~1#wNC9;?O$8hvTE9;@`yzgHejd1~2JVIfkoq9BG`s}?GA zcY?0UEL3b3?scy7-L-Egg-H-2HBrsYToh7Dn%goEnh@2;35>=H7{I8dZj@>@zf!eY zyh0;nHMP6PQzLC{C?TY?B(P`V(y@k>%f(IG}Q@p`@P zRjpBK2(1;O#ba%Y6&5kHfuhl3$)jUZQL!+?44B#>0!w3HqzH`|&}lSihLsRfV`7=0 zqKYWk)+nj9s;MJPF%6qE#>PTeGZHkmrZh58(X&BXj0R@gC~aaZNw!U3fe8p6H9QpS z@>H&T6E+YDt@Ude*`E{HFNKhY7u{Q(NWY$aIiFoK{c z>B}4O(BezQ{E)n{6eV$uos2)tQ_6$u?k5H3_u z!Df#=+Jt?{1Ty^*gZ&3A%~)o8t&yhGX@I{P!Kombu|g^+L?$m+*zjz5F@nARX_dOeG*r|uh!xNW1!*~&N|%VYsU;7V0{}5E zad*I&Tvv>wEs`L1Q^*XYDRPb|X~uYgO$6Bfwe^RmG9e`TNHih<-hlQYnUF$MTT%|O zpl7b-(48<^yac8KB*EaT`Pup}xQHhT7f41T%$e12)aaUQ2(R&R=WHJc4b4T0~2+~e!zE~fYBmC0&)QWdh-E-2!D4VFU_hY(6ll@ z4vRCR-1)9U=;1*8;pmN){-$zf`;c{Iq1bd*w2YHr;6CVd&C5Zr<~5SQ^TBv<0285K z=uX-eGfor^8_O3`f`2+gyaPz$LyHZcS|50MzeoEp-GU|a7CpL16d{1dlIsAma>BBOmImfQBjOR zlv5x>By19vNkAgb)~o8jbo?8|zlCbPX4N%R)l*e9Q*BDL5JC__1OfyDKo)wQpHu*8 z6>t_r!RtM?_b)%U+Wjn&NhGqeQc_7}NlPhNB&{WCQl%`FDJ3dWlGK%HDx{RGl_ey- zeeM3k(|SJHs^8_+Y+@khXk#p(81lw|MBCod{7Qj!ZOXX(Jags}z`Pn9(T@m#me?~I z5m68fET)&!8|%qHh6=ja!Wnr*;(m8c;)~Fld(i7(D0#)NT=E@~-PT~`7y!HgPntN> z#it@&-<~Me2rMvcIjBZR$@h;I5Q0JkD7a1M57uAtD-QYZxf%S9hcA^L0nf+}$5%;R z3l%sR3}=EV1LJ;pU?p1HVcb2(@T&XQFM2q0wu6kbrV4Og8aDFn1|4R^_5=B@z#3LL zSP$MlZU=$`nC5?oT)4Wtm{7Xj(%(c$5=SV&WrTAi4*(2hffTeM$%=En8z61RhB7KB zbpm0;ZAPe{1UA@|NAR8XDi@q+>Xj5M;vtr3bg;uuZ~G&LsuB?VM+=YFI365B?eL|H zr8M3b+)lk(HR8+m{&=#KuZ@(rGi-*0>LQC<;J|02N^69gO&>_RlwNk}14$)J>^9!O$fE|x45?2kzb79lAaQIT#y$tg7Q(xaA^yvYofLQ$w> zatf4U)d2{IA_Ry7MQMLrC|&*6U|$8WOuuU-f?2@^1oKi|fSncAh9n%{vysa1aF=Pm zIcNKugd2v8t19Jy`e#7{Aqk}5Y2bjQf?2XqCYA;?qz1vUgvAyyu$oO2Sdu7+iir_G ziX_R936dbOB9b(bnT$zLd3p8u56oW?^^Y~}lo~-4)$db#@J(T?Z<6x{xVE^mf|v>{ z;V>84j95%TaDj**@jcyGlqjKqQQImgST+$;C}qeHLm5J}3>F0$cUUN>*sxs@xFiap zNB~7^5Xx+;1kcF&bVUC2<$V9jdcZcPk=AH58OGR*Y1|idn2FT(+uu=!8}X2~6COG+ zIBu~86ggh^EqH)SlK~bGfJksS(%u9Eo%u+ci&m7PBN&Kv+>(@#l0bD`bTf6_kdT*G zT>@Qh|GnMx88^INW(X-Z}Uk_42bnUdgqhVrEOMkD)Qb~ zQiPI8B!-%18JcKjQkjw&lIyrgW@(`zA(&?KTD(__#4`gh%qdATGYrhaNhC7>0!aV~ z48oPx@wMZ4!e(A8u96ZG1uLz3K5tW<=xupgma?}E146iqiV7&QwiVqo_S1etA3! z2&Wu{jN&jPAt4wLj0C=n~T@X3N zn}Vt;0;qzD3aCghje|*)NoAA(@3ltf31fQ%O`8 zG%?Yi*TuHfA^k_i9+STf1kg}6i>(k%8Z;)xXxR>8PsAaYSrOV(0+LB&|OUhjd3*jZ6#s&agK~FdcA__6A zQk2O61h@(pVaQ;jGO?v7oLIOMYLN*RA4t$Y^d3mGx9Jl;&=fdBFx=E?*lFAe23Sdf zbc5?gvusQesxH>NEG8l#fLL&JEDTK~D;B{ADai#%F)>S+Ck^Fz($T4#GMm))7w=ll zk`gjTMp`7v8X}9(?W>k8je#p0QL%$)uwsghXecc0c|=}$dKJ$au_<7%$c&{hr7$>f z>k7Z|_Hqe1#$Gdd|MMCR)y`(b&YN^XKPE38D|rFdw{kh8Bbjm zat2II1Zof}5)E3Zs-T0#HVo5Mo@T{fjdYxOGw(qTFb|TZ6r4wln1v-ir$116Ut`z% zIOMvED@El3H}FwZ4IK2sC6kYf`~Ke%&Z&gw-R#-jD8&NO5f0~~-z8pZBL*@e=<8Z5 zO-1>dcSYu}wT=ay~aO!{B@(+{JoAo)iusBj? z$*?-7?&I}yNVsLnwfFrD4n@}LzsTR{E3Nnr-+W2;HdCI}^giiR39f6}FWh0MSt7w{8dKX#0o4e!1-uN9B{V8r6`*P#f)60X;fSajs*D_&M z{V_S68%gPFAfI=EW-~`0eS?T5R$Q-ElD^UXwA39e%|*pA)jAs8g%bKu!M;JGZ!T;R zcVO-X@4epe9--22U1-{({@>YGFR?09+UDQM25xoETJGT0FDS0_F#Pv8Wm@5?YIAQX z+P|~XSWR-PagtunH8J;1YA%w_J5e_|L}FPX9|2X0Xil3m_h&?W-+)|S_n7$X`4oEV zml@)%GgKqLT>2d9d)6-uJf8a1Js z#fqS{C?a)#kx7gc(^#;4F8>c=?5}Ij@!S0&esjCq*?M2gPrilaUHgo+Nud|_AjPMN zf4073NeZ=X!jb=jqk|9LO(8I6ygxrbD-IdO;f>o^f?>=K0Ai|{M9g~o{fet$(g zy`osGQBifBzEvfvm65q>Z>ZGA*i)_9!_%1Oaja$=M*Z@xD;(=|3@38!PNBth>fB6X z!%gigYOu#W9Rh zym4@P`nJvvKYa!q#`gVUNk+dnhw%GPA^B|d9pbB5)=Rj*Asz8}=}f!4pmha|5icuV zwn~*FfmvGS^3%7%^e(lSFstVuFTmyVao~lqXsTUP&&@EsFZwBYhO&8hf$)8^bn52f zF+=t%%(*<~Mxu3>wK?AbIIcX!x}=v;*=U-cr8FL7>?<}SRNZL2sHxCuE&P8X6O7DB zitdw^T3fMGP-)nohxC_I>l1nSyK}d_uj`YCwTMo3fQokThPLAC6uS$KM`zf3N#l04 z1Z(tmRT8gPpFbCi7t{TJR`>|Df#?_?n01lL0i@>jG5iG^`Lq2Y{mvdzv?{6jVDvlR zJ7XYR2qA@AKE}`v9SF_I6EukZ*JK{keEcfDj%MECbKS1=dSc(B63o1t)LxD^E>nwq)wIt5*Wn&{VwYNJhv@yqm`Bv+-CUHDfEVV!JoP(|rb0KZI=V z|CPNd@7^Cbr*kKbY{np6K?_~aN0EXRG0h6yL4g9xT>@R%N5R0A2Y6JQxDyPNhM%#G3${WYSPzwHVO`(nhh8-;wyA1@peBS=E6s zLM$jD38*$XxfgkNw5Z{v0!nhi;P4@@2hfk^I=VSk%vD>)+%>DU){lTC*{?RV+>i3FNN%?*4leIlxSi;m`ULE4P z`7ZO<{ZDq@SF`%ZTf0E164IhuT7^|rK?O04LX@r~a;i?@+A#He8HJ zm6I>X)AxJEEz7#%?WCKB6|C2J?niO0UZ-KGE*EJ80OTkJ5O8JfXXmNjQJ&pXlg<`Z zk)X}nT%Vv}e(H@KKOOzkK5l2a_W8QH$|$%DcLR)f zV{*8pFrM?0uyeJ>JZ5w7L^IbuWAYs0h|NZkAdOUWg{fj`(u92h%qt*J{0rZ&Tb%Fg zmyOiYCuyBi9C=C#{HEucIe$O41+pOU;G-teVE_RL1Jj|fa|=&F=>97vn4M^rB6Z0| zDxzCsMQv&p*=p4-5eitx_wTiN``Y#^Ey@q#m4~ipXb^w`Ql+PgctnNha!w)K?(U;T zfSn5N4iia-R5a%?fWCSbLR6IsAt4|~z|rXKsNKBwvzyWWbCc1Z17K{f`YYzbzh@Pj zzP!fbiNcPe0T#r?Vt9$ToH>o&OlnFx5}bz>5+T#0K1{c`CUk?v46VM_+%yN-mDrp- zFbX4N7#uefx!=5~y&s!3eaqiZ5l<7$qLmgeR3)7o?0AZzB7~ZVN-$)jBx?MX*OSJlENf`B!nP_o~w&9e&1MgJny9|D--|B`W&bsV^NBO1?&}jho^Pr@1C!* z@qWkLdc9v^smnKgPU3aiFG~zYuWmXFWIP`@%}vi81wg3NDoI;$PI%4@OY-ktTbHP!S4|9SOKYN9Pp6m|+bYSb`_N9;ji4gt2|I zs40ib6rv&&K$Ls`f$>JPkw_q_#srL;|FYc+CD0@p0FfC5={2>>a=C`6xWW;Tkc2%I z)LJI|On%FGv3zok+tKfOo!r7<7utI2KS`Q7{CU;7^&U*aO!9(u&hC{83Edsln2YS= z(BkjSx=zT>tuMkJYnMiZMHjfVMFD+=oA7Ho8$CI2g|@KZ%Tpn!)s`DZL@*Hwp5seQ zVw|?bSdT`MswlAcH?}(eGltAn6-a#_L!G$PhS8o!wK{szD2Rw?@Nz)?kq*#Fvkw}0 z@S(7VAGlew4GFM@Ac@_V0WeL+=$J!+qLCB@&zj(d3N*j1RoF z3&R$rzxh#!OMKd%EEYeiy~#c!7fT6m{=mdro(DKax|QmyG9jr!?X?w>vzP zd3zpip$^eaDk*5LIJE_kLO{T43p{K>K)R&}B1M9Sy5?aJS_N)YrJ*O4*0(5qNy!FAer$hNT!(5l-ZjJ>m|Ka8+;7d z8-`37WyWba4&TOM4y$~r?fo9W%?BD%)dnJ2WkjWD^G)O2Ze{0d6Vt;mn9X4Wp5t!Q z$7vnhkESET!z{*OI5XC@n#XMx88F;M62geEE~n7pjS=KP6j+4?oPc{m-K;QtZnLSV z#NTy4#s}gyc^5;Fy_PB5@iFep$fJ{_j(Gzo0a;n5u(uTf!4TeJ7na;jRo=$zI%9gg zdsy%@EW%UenC*u4am&ug9a&>2r-uiOXm2W}=%-A>CGIfa#OCqSOY(-&ILj=>wXlvU z*LJRX)i`Ckk3-f!Y`^fPPJ3NWXU4Ogcc{Z_S0l-G*Dy+6iqiR5?E1?RlH8)U`M3(! zpxxY2r0(d9l42@ziRR{Ab7w0|0wcp}XaZo?g&rivHynii4rQIE2@>NzDl65D6C`32 zHs=plv$v^ABSvIn8Yt0|V;ad|+Z08Tu%^iyOtiBmjF4=^vLH!DjYYkTu4a&-qM1gD zG?Hv;Eh&;VDUo6Tsv|RGij1bkfU#nzO2*kXK(cC$j6smvCQ+cXDEG%PM$wC4v8@?4 znPQ4eQDQ1INKysi%*x4c9mGY;l|luO)eHayq`O;S7S&a~@jSAkg^6aUpby_^AyvY-r=t|>MQj;mkpD))WV=(#HgXI_4}6Ny4RoFG`%H#2mq<24Jdt7^B}@9 z9&gb!xF1S@=EQ5D5e$R^uL1?{1+L#dBRB0-P?~vSsG;eqC{miI1^`^-?;DX?wV`r? z;G?Y}-v?YJnx|LjXJm`UBdwBn9ve^Z0twauqbC7c#g7qm^1Ixx9X(gXvr0``bBoW6 zq^;KTfDO#*O_Bp_f>xK*2QWZ(r(DW024H#cJQrRR2xli5fWYbjDo{_p1jYabLdnV? zm?cCFt8f7a=LDfrJ#}SI@FH=xiRum2@myYaAt)WR4Y+J^O0R=y6p%`_MG2dZ%7UVX zJTavOLlxkjSOXC>LeXlZPchlGep-I#sw)P2fN^%8C(JlP)8O zze7qO6sb#5?Bgf~twYSz9@rE`IJ_YWhZ;me0I>DLj#N;$s@w%s7HYK|exIF|Y)g(* zP~%3+fd~p+g}AD?~) zH+b^^zx#YbqJ?E^Z?5Tel!aB?YI$$Nd^I6qV7-sj8&Rh)npPlhpMWtI5P=2QkrPv( z1!cdH6J_nrnuvsw%7!xnn-5F?a_0l8CKNE?L7_Pv-#?6TsDU3P?!{Lys~lrk0s%78 zt+Yc~5ge=+I@EkoggCdUH?7H-TUHQ$YaA+~g=Nal-e8vH*>+BXh6>_%#iim(!vnpz zT+8eiA)bQ}iEJs0LPbh(YOQ1l5Lg{(UX>IqXtWVgfpcW2fKnm|17iJ55OchT2J16& zCUpRbsSL=8+xSv;^8#3Fd`6%qSBMP4g8iXH%T5p|?-E!NV*7HgR0{M!y;B1H+8k~Q z#4%`r3W0I01l*KTv5H*G+HGK@-1jZcvu6K;;s>3U9^0SGFeZJhmq%pM4`s6GAFczG3P>d z;tTADu|kD=z=?Z(d3}HGOVH1He#E4P@l*LW`Oc#mWjzjnfUII70wOub{|_gM1gs1E zKVzuQqxmY}$crh#UUZ=Nu@dm+C%a=ZUpV0q*r_pO(^-s3#Q4t9}dc;a0Ho^!+imBhC;v{7QR9QP=M8lG{Cylp6CLk^eyb`*?m&H6C-2<6EKE^ zB+62mLNH>{7sKj*U{1|XLl9SFBem@SB zxPW@S_jk=o1vCu`T!~usolU-IT>qiAPSIHss%+<%UVP4LJe`S&nL(zteM)REN|!!25=yN^saooN)U2=2&%Whg3`RI zzS99|xw(`TIVC{Bd(WUS9VX#niTpD@ z6)=TeGb#ckj+O0M=4d8<3}1qCcfD)6lxer6%53UJa=y^OwgV$uj3q5!#y4W5CJWHO zx|8%AaUu~0TxUlkh`xZD?gTkR2O{|P5DWvCha{yyqn12cbF1pA!el7CieZ99 zbctNEl%E9~q*cqPID250tQ;mPkx-MTRsbql0In$kr<(?Hby8$mvDk(Q?M$p3@I`E< zKvfmf{gEBbXS&Z!UTTh4}&MIqW>hA#+Pg#!&!}T3Mhqo&py2>bQY<%PB`_YfCG^9X@z%u+yoa;(jCTO|8!#^FCY zhNDF-bp4_pvMoJGZceN0xJLaT2%nS~y_|f+`I#3KF?)_09hiB<5VF72Utl{jRMH2~ z&%KPr;7ZHvt~N{cg+YrzZ(z`H)3iISmTdcq2Y?ye-_hM}M)?mCIL)(kBqzT8VOPIz zjNMChN^!l&^{j!u5hRx@czTE%X2T+f!LV~r)YIAGmG{6?W7DBPf!mST;dJc%g~k>K zowY)bSOl;^h~0vC>Pj6Lre;T}+ukKLN)=B9n2AHu8OH1a4}Gde zJ=s{E4iE>PD1qX*ClFAN)Fe+ZL!6=PKT3gx+Qs2_!b#hpX2lYMX;eWCDuL~`8-|qG zpohaEowA}noAftdc2BTSwq`^jM8i`A-5OSILXN22D9(iME!WE_fi;BLGbpMpEU1Ys zXK9O7kuATWu)u4nj9K+X6rxs3TP!_g&riNK=0gKdw{Htm97-=<(zrj>TSUvQ=(!h- zxv}vwzb6znwC`G#~3C5;9qA5mRVR z5PPgTv&3IFRtC(_^Y#NE5@LZ+kdS=;5!eKp6P-l}JwX18+yGJzvGA%B-)$V|V+LS8 zw7a}}p6j11%`puCD#+5Y5GfxhhhPpEABf|FQ@}YK)TJtszdbN)LDl~M0>#{2DTHda=^V{I-KPp8hv8?5A6va=*A ze@6{RZzr$qEyGTq57JLX18a~&)W`cGR4PiI7~n=Qyn|7at@i3D$d!s>djjv?a&`c6=kIlP2?5{qZJII|av z?Zaq?G(vDprdbR8Aos*3&fY~2#ofiW4q4_pF7Pk3G2B_ zoismF>PzRRWxi_^!IKV8L`aLd4u6vgMA~$L>o?Z%Ne`7zaQ940p3vnocKpn!NzLdL zIMIOgx{(VDJ7&yv=j09~`wiNGk2j|zy8h@l;QZm;j@S%}aoGptK=nsv0VR?C!z2L` z9Kn@$!KySm#SDOAYS-u_hqFcU$TAo3=i$YvV0T)p;D|eu?xd>!a35CxBHlNcBaCeGu=r@VNIt=Y!g5a=%ZZ zNCVKAuUFpotz>@!@In{zdOtQ)%4r4PYa^C5MY5jdq_A{oRvpqBRsE!kWE`2pGG>%M zQJffUM=*A$6bU<5C~(mGe=mtYH|%xkvW&~oLj`x4@fiJ%$CE_OaqBqw2v;?(T9Rp* z4u?&u04*y%5-)tM_4=dIPF^*#d*@*OC%p&eYHNI=zLVSt?~aBeRpx> zZ9YO|?PCn+TAmUE$>kjwi+3JOpJifO)-1KYrsi)#J1>|0{6;VfD^;uXin$=F1y6(1 zfIr7laFbVLcEz@P`fcSQbG`XSfw(6B!g6GPO28T@8 z37xcuzIP9mGD_`%(fqTh8w^Aw8I#?iB&)xnx)Oin$g`pnqFo9oK)~cfIFt z-O<9`I?LD%Sc)zD45m62-MRw>;TeV(cLZlhIdhGxl2l#^%uH2Nhm{d4O2Kp&^kL}3v0 z$3ND0he!H-DBheuq&I7QU#z>lkRB^J_o9R289^BP!qjo?AoYOb#r3s!U7#BKX(*QcA0j zLYqDe;$*HA@8q^DyLlzxCQN{cVc|C9ZyKs0lGY0Rr6KqJBOxjDM&jjsdy?(Q{iwoeiJ2Go(+dqDg&cvHbk@K~m?hwuRTZdXcdlSOt7@sR@Gpf1Ec z;q=fF|DBDFxbOOF`Zshj2no+?k7vk2+%g9z67AamsrfIy)G}eUtT#mt;s?&<_NI3L z50vqmsRlA4Zn06>g(mzS#)M81cV$W63^WbbL>?EnC+jEGF92~uQm~7XI>O*p{~gm) zd`*$B>$@Yg%*or-6i7WFz!EK*39+~?zG5SUeV7q2NQdh=`SNZ6+4w!TE#p@`mSI5d zw=JS?;duJp8XUE~xN!@&XM%W5{I5JEUK9!3umKOANSNBDsimfBimj{GEnCe?D~c#1 zl#mtu%mMu{y!)q?YXR)@4vlgcegUcQRE5%9uJjO3m^i3AZzimL!iZ@?q>>Pfl74_n zU&heLAW^K`Y?xqNb#LM-=Sft1a)jERC$6fHlBHJyLAORGw5WLgT`?$xgonIuQ^G&A zGaEgE_{F+}eCZ|S8@U3!!XEIza(k>PxN%WcK|~||K^Li_ehyi71A3n^^WDGegLWh; zeib`nYiM??dP=|?AmpT|HV5HZLHwrFK+Ydi@L3&s%y%5Mtvj4I^Bm!WjxgF5fs81) zyS?Vi#KoD94olYtY4rGVg9vc*`_{wEvj?!;I8%Rb17$w5ltTe50TabwAxmJ^hxo;k z7Vrc*AimH2*oGXz2_X$-pK3%7LujE!A}2GvQkCfot>-ElHL(g z-S>kYSE7c0Km6Ut;zhVpJ$H1S%-01y z@x38HG%G|7j?@n64HWW`5O#wjj)dW*U&%co%d?b}A=Z$-63X*EjCtqSv(EqTjuOE8 zW&EmP**EdULO^h7Ir>J)?t5=8R4gIKz+W6N1J00t6LcXU%&?-u{fhyNY$ZW{8gH;F z$?{IL^8(=JuW9~~J8-jL?qA*s#tAbp-6!(lDKQC_kj|Lipl1dy4~5M%7Wn7LUY_kk zwYVY15)#T70`WGWaD3#tB~;cg2}LkKy5WU(HYqtm z;ZU)&O4gDO+@SJA*eFoa$K?yG;gl{*lX}`EaV%cVnStyAkg4U!Ng*OYsG;0D!`L8O zg(95gzP1uqPBsg~-4LBGcS*PVHjwYIr(Ok$@Ja*uSlNhJ_GC&=uE)*1VVng!k{3FX z7pzCwgm)YTeCLOI^2YiGtiaj&4{&@|C{FU)#8UTYC3~06W|$LqCo}lUY4-)R=26b~ k{urLP6F8L#6fktqB=jnT-g^fH=~a3!(gdkW zQ}osM`hNG{{c)d}-E-!gXLrw>nX|J+*~(Q`T*;Ex#By?U83{NwefjVI2Y>$aeR{m@ z!|ns%@By%hR^EgyiUEi`y-8i`@&Ke8vCDl%^1=WDHe8mv`gc!7D!^VLNe6(`SCZOM zcI$NOdvB}D>ZA+XV(3Jc{3sxvc!iu800;>Xi(!dqG^W<0K$;jRTt!C;0q$jZOl@;q ze>u>XAGmmQd(4&N8tvdT;~oajDo0Q0N$0>_V|8^?_)4jfCB>>xJ?X+rcSQrEoTy?1sXAf?&f)~10sv+Je?!Iq zh!zMSTwDNNyrK4%PY%f7Or!iRZ5qa^utj~sY*pf$3#%l94ff$Y%yYV z2Eb7WfU~&%-(aZ#kNd8b@jq8^(8vn`0r1Z^J9UjYT{Su>ZY9-cusLG~pB?^&sn+En zbLsQMDf?h&*hdQ8$&;gO$$m&+Z#zE7LQLJy)^l2QX-%#%oW9$xh~V;^xkis~h%fF^zA~0z_k# z7(=@ca;NIbiuE_l`p^fo;=AA3@gE((58KUCiKOtAHS zT=Pah?~6$6BNM$$4KndBXG%h@-|ult_*|=ch~5|U<@Y&@yL~*Gu|D`+aMA6aTL_rZ zJESeR8bwdX7oIQjNT2pd>C?aNU0G?p3OrQZEBQu`4QNf9ez(m_&gGB# z%L}05aofSL#(9>+LBfkrc&6*d?p=b&uY{YTuz%&cO5~4{`^uft)Lb^-XBJ*_q2{G= z`tW>H`bh2~~gQU4%^i{O!w=BQl`mbLF zKHE0jyNez8F~_7b>$onh@9)H9Uo;mKLO z89taj8Dlw*|0nuT*o~e0iSN_y=}t*K=nKkUyT7JAx!W!?m*iHi4%T93PD2BiA@``0 zUwD*R*hQf|!$w}xvDGb!`d82=)ff@P*X;nIN;#{Wil?^mb{#EqFhccnS8wQ!)cW2= zH0T}G1(_QHtMTIIJsq>m^jd!Do?CPHRnTlvw<~Mj(ouE+G0xIYiNm|I-RG6$1HFJT zPKL|nw!qWI;ojq|>EGAuZH<&IUhfuUf^f-54RU)6pW5j`jPc(5L-L^Ct^aJZw~B`U zkVng2FXhGW^Z%Tg+$=XxCqDtZi^>RlzKs|@(P&|J$d%cq6_#)9ZK{y;Dxn)uY`;jI z^NeB>jbe+M7IZj#qlU7UIcV&7!};;9ITW=#)^1>+zPo<@!%vZI@G+AYHT&RG4%YV9 z4;%HG)?~gOJY^MpVRr6@J|n5n_0Mq+u19^mGq(I-KVaw7R#flOLD;d&_lb{?D)SqV27$ zr+O7ic>pL71QH|l`<*ZtxBH8#cVjBq)=P|I{!)AgCK({|c+c`6bQY=7Kyrjl#sSj^ z2%gdakk24MeEHiUf=EMB0dle(w?acgN-)|G=`aMPP@^;Ef)N9vNDwa`0V`M2!IKq!(QrrKAo~WTVE}lGq_z9Y+`)& zjWH=xaiq0vJynuRM2wm$xxt7&0B_2LO5;n+01Wa=mC!THlLS^jN_y~o>w5uX@NUSa zaR}MK)B662rcOmfAIi&C##s z)-DOUXaS2fc#0UFGy$Jsgm=-)rsq<_C1-sCg2i_9K{C-Uo?KaPc392JmQq)V?PoEZTc~}#VC(_P#r%2T5;MU!S)*L_AhIqk?G%k7GjlmO+>s&HJ|^2SU*=r&iKs7?}>^3C#RE?Df* z4no@P*@cV$@c^OP?CQ_)Vs79V3 zS8WP0gYg%?em__K;!(}Y5L0(qi|jbyIP#WqKBtbPZ8+GD8f2yYV`}_wm`IQ}CHp%QHO%`)daPRl!;7|n(+t9Z$7r&khFtxpH zVM065L^G|-COa~rNhJlEr6+`So24YJTuO5ktUQ`~zjX}ndby2BJ6yVIF-RzJ!kn;d z=>F#(`TySkGGAy@W)%4S^BZj(_p?J zGSk@re3B$$-0zYeIF=fIPj`~H za-NM9jc-#U4;c@wW)x1#;$u#BL#n_B`a9iwghkGgrbHRTXytehUAM2}g??1_zJVE^ z%Hx^+(hjE3i~^PBx(f?l9w;1c^>x`+oy+Ccxmb^^&s4~Kw1*kjQ;FIu+8z5O@k#4m zTPbz^wCe|s`W$OlF2y=5BDIXwiJQCBM-jt897!}?!A)LNz3VczQ~WBMz|0DFZurN0 zqFCZwAzP?*X0Tgwp4(^!iBpan-N)Bo?{nqYoa-4%puwr#55yTgk4+gy%hF;c74_{r zoz1;&u%QWs4H}XFDSIZI))HhU=a7EfY?0W)=Spbit3@lBzY1t+Q-O#ExwQjONt95R z(7arzia}~hLWDxt_Gje${cMS_^LeVTcUhZMWsKZNc62Wf#(FK^!*HXu>lAEEg*oY4 zc6OaX8m>W6k;9x!{mFJ>E-tIiF77U6Wvi8D&e_@7l`fWEI{wBrO_K{v3pF)Ue-qVg zBCI26<(!j~?c5o3J{y}DqVX_5$@+nlF9JqRs15Sj)6PUo(j2`p2H@|FRa9^dDXB(? z-+ihGqf-(FJNG`O0@~55V%$ynV!-IgI>Mp8R|#~{$qqDx#D>rh&|>;nQt=@lYbeZ2 z0>%Iasu40(lMyG@i6@qjh*?5i?6M|DF))Yy1OiPBkR&NzHeE6!Ehzvq%8ZFsO&lF{ zq>0`K4JJ;K1D&G&(vo4xmI;wV*<_@ekqd;SNG?-)*Tg0wf#_mx!>VCbbEsVhO(a$V zpbi|;HG^pmaj7d)idj3TBG5GAuVEy~)~0sx>P#I;WKbi*!Xhpb1d>Mnlta?c+z`xPs?HCGw5Ma~lG%lqskbRLAZ*TgD8^+RRUtS;Aq5nGOk&8A?`)R3<<>prMUO zUdm)b;smJEWTxz3N0XUeVx9B`su(pb`vHKCLLwomSY!dFglsbXB+`rm82Ci{o&BcwIUyrC2fCh>%}Eivi+F!{?gA zBhI7hf=Qw0CI^y&S*=>(4y7fg+~PDv{Ai3aakh{HmfXXPO4>x%kS-F1N)}o%tTkfc zb{`OQZ7V~y340*5Jgizdvp|tC*$HqhI1e!m#0m}p@l!~z=$N&3Ylg{qxg!ySgF|zg zO<=sSgFrkBn41ov>3I{7QBg3q{m(tKn&E&LAT%Pv=+5?O9X%yr(9~46y{45O$@Ein zRdivVJ{lP3Ofd%qSQ+ns9UlY-XeYsjiF>{fm0+|jkiJIj;cbDOI7BI`22p%x9F^0fM2J*`}5Z=3G! z*NX0HKD(mTF@+u*QO8vd+!hSkNU>9oRD~=vPmc#I<(X|xvK;VzJ_(Q7(YsLfeZQ6I zoygc-t^e)(Nad@dU0`(O@}JDwHlhL3k6qic6WbMwx5p3J)*8cfJ1}WEbTKYj57j}) z40p?%?7#J9`M1>CEHm8QU7Ry4Yo&yybR;F3r6-%FbR@?AR^H^~(hxO@_wWn7DC!%?~&+lMJ~({ok&_^Jb)4i}%Q_G%Kda%{pW-{w~}WII&f zz-@iEpL08&Mar=tBeS^HH9~q~|!z-h2i%uknj|rgB=1%ED*~d-6!*GOG+5T_ ztsZ}6-b8hTO}8MaXA5im5D#e!6#TWh{F&cLz+4)P1Uepcd9t|iC7|CV=8`ji+n95s z=^lBt35`h6(1Y;dkTEPZ$ofDThx5e}8pR1@=Q}7n8^sXL$3T|Kc(fwqCWC77Mj>~4 zl9GW0`>p((wQorTOh2ul=OvNRT55?Qt{puxHVc^RsembUXR-1CTh1ry#MhA-ZSldm z7@^@h8a1?F6w{KmtrWZ_-EFFMkx7}TVnL}VAvZ%&&x6H1ph2o9ddU)f&?rZu&>f}@3 zI$y=y0Yww`V3qo1dNqok@VylJNC@|6^a@~G_{!fc*)dmcsbg4bSnf<|RA30_M$|^i z8LQ;TAOwu$4xR4GcYGLJneXkw8_l^~H91D|^}%B$;??A{n`5T#;rOa!SL$jYC<%(; zLOeAVs8dm+x6qU$4YHj=INMY>02nwC=y~}&v*T}3erO;DjYbwyfCCy~W>~ZqM48W` z1>iCZQ_oUHM3G7WEKJJ0_2A}Gq0@#l$?<7Cj8=9}x*I_1YC3=-G8Wrx)nV~uK4)WP zpalsqyH+v{gxsSzaDo|Y7AyPulF^>Hl~R@c2)Gg1B{bA8+1%RB>tWun*>kqp?|If- zdv>1MwEyR{*h!NJ^-RjnZJ*L1QU6HgX#Z? zzXpPd(xBVGwL{tJlK9#n0N}K<5AYwK?LYZH4d8bOxUTg&^e(+_tf({vWvq7w|2Ox4_)Gr}7s57M?)mBNb+|R>n!1VRhW}arE)4iDl>Z|5 zk4iY%n+Z!A!)Zx_L5Bb$tWqL4QXKIgl>j#;br_6uIa|kw2>}9!Bk7-r5n<(RgaenY z33YlzBEgdcLwhbt-NO>E0U~aNJT^0Q{vEFSp+qNkby<;PW8G~IKY#C5T~Ft@l}SWp z=d1Mb2~c8`xT-3NU(pR=xoL9sJ_XS|haakW*FEm=2OPh!QL^%{tG!Qtri61=dEGXRNqV87>Xf zwteb;ol{qSRx_#Y5Z3{u3(&UW#DN&iGj$m$pJ(!yY zt4zbx&l^9Bm#Ujc_nq%OKD6yM&2{#2(uDY6HyOrw+W75RKwY?I3tV#DKZXK}0ffc^ zC=F|e#v0+dU!EB|v=5Q=R8RstS1{=-b_XChAz588aY$2BK*=cY%=Yk^O=94hS-X`- zne}nqCnF^6GGuBeWpi5c&(Y) zSwLh!Adc-crZjeQG5nG44zJ2aNh(Zs6b2eIvn`-qb7r@dz#beLb2qHEB=sZ1v-Wy_ z%gV}1tEtoLrPBCEM(c4U!f;Ww7RO;t!qSgT7-Ygud3@C|ZH&AO^DikJ&**9Qd?M2b7~Grjgt5R~GL zv5plNsI3wx>8=bGsnhPc2cr3PZ+CB)Ohbtja9Wu0hi&VA(q*aw=iTPMi}5(2u_~T` zgbs{|#>uI|G?j=A1qzB*TKcnUe1!wL!-8$LE}n~-pf|z=EfG$ZJe0)MH@oxArdfdZZ;ssSF82VzUORf zb=gq?KBc&2GUPR5UkLcJ)LNCLCdUiUVnkF>wyo({$fx#yf0G&VmT1>G+$;>6EtjqE zez=ooKU$p}m~6KXrq!h5B0zwoX5ldis39~RAE#+b_{!*|LH(1i>h?7htD~oRx0FYM zboBqduG6Sj$WEZ2a6*+K>fogPw_nVUM1xVFNJLphtp+OWlGv(wXV@-o7jBVVP=LC*K2-aC7jv{s0IncnckH8?K%oz;q^8R<6Va5w z*{rjzen%!7H-H4OEK>fz(BovkgSOL`p;=!}pYdYi3lf1Ho!ann8^JeaCx)$ENA!D=@S`pO=ISW< zd!-M&gT3QYeaD_JlVG`Y6tNhE;E1goX&>qY7lKU)sePGeQ&8G0#Xm~j982H-j1;Kq z@5sS%JhbFODge%?2Oi8Dj)cn0RbV731>!-p_!wa8P$br4)e*{~4p1i5{|AQUgvTlf zCSK%eL3G7Av&BJ5ltP29G?+PPhBi4rw2V9(&B+ZTPIT02Qe#Tx5>LZsp@(r=G)>I$ zYFrllSU$~F33aV45m&r`l(+*6xumfZ2F>e)Q#BUCMoaLer^S-v5aifgela&1%os$R zD;^sSlZ1&GM}y$0l*|brW~b~_UK1`JTJQ&GBN3;y@9Ulp7oDUWJ6&Ba-9!==2`wQ` zQb=DT4}%?ym1_*fG&+V`7V&byCPGq;UHJa_NXAI*`OvY)yW(f$U8L!G^%}nHt>eb& zk8x?c$cGE!YWE3JF#@%J+^ag}0}g8S5Rr7(%;|0W^P;q^g!v-~18GL>+ot&;Z(H;uR_Kl(q(Sr=AZFCu~ijD}}cf=3*$ zBuyhmqMupaaK3V34lUC(jpny!a4R!9FdDq@vYVL$C^sVAK7Qd_eW}^~{*7%75;@dg zMUi>aH#xCee((BF@Xqs5HMf%NyRE46LI6Q$n}dmlxq@N%H3@q>xxJl$w?vFq(Mb$) zcH^m}N5};VJm_2&MHPvH5UN(Vxk0isgdO?Oc!=GcW?_l47Oo$`Toyyc3B$pX?Exy! zA^OGUJdLl`W(A2tK z9+s5KbR$#EC@7z1yk_zS9Ybwu!Kx>T8BwZFdB)&Yh@ezDa+ylaMEsLvNW-u|9p%Iu zK2tJHZ$nNH0w}XKj-se`qGMpIQq&6~E7&B;Q~kbg5%gW>C}L>>2^cLV9-w=%tm;iO zQ8xDm>_xCdu_!nyQ2VNoA|*g>_^7J8O#b_an-7GQM311Hf_ATkL0qjdCsHN25P#1y zAd73$9@QD%fEA~{g1$6UA2{PT)t8tG^AEOty&1YhR;s^VlJPVi$suUFe+alBW#l;c z_@V0cm}SqE@17v>XVrleLt33m!x%U}8VK1#ScY@H>u@fe*27mV3DhqE1uYl|O90A+ z#PBoUObkZWp=vsWT^G%+(JEn8C5>MF&;p1NiH>LMQSkdiK;kM;mo-4r#WWssYxt~c zW?78wQj-i=)jRMvD+ETv+14qsM<%miK;3rti2Y~ry%x4^YHD7r%x=-jsxn!9F(PmY zMu&K##P#mw+w8hx{10Ss80mP~Zpr&@wG9@EY9ykvqXlI1=wHnmNxMoy$}WN0b9%(X z>ameQlN~w{!e^UEg6-bYaQcUDGy?P<&GxX!Sq8IA3X&kFo^;419N<8@NaslpD>20JHRK3c!I_4Wf;^fQ+rEmJ^B@S_Z|j8obL=*$|bG^0pXJF}RK?YKMZd zrr6b^VokwgSfJCN?Q0ZrKf2ntA|jvfib|6!8hcJmS&czjy6jC9jrYJ$FMWFr`1U>Y zm(G#tY>(Q^lTvQwheYo@3S-i54LiaJeBkP|b4GLLzRxNyR);_46waK={gXNpmt<7^ zx!?jDN7h?U>5L*9ja7hw0c)V^tF@cgt@9Ue9IwhZr8e|CDC*5$eLB6H-mg6UU^7v6 zb{e_x+4XCGp0OF@bNy#oash_$cc&`}C=!L)cttfXh9i9HZTo}cO1WNKgS1_qNx+3_07l1KSF@cH+E2(Oa6~J% z_h_w-u&hfLUu{Tl?IWK(lwgD@3ZZ@1b79#q)CVO{dZZAP4F0pK0+Ld2xtlI)UUl^E zL%Jx(hDoVmurN(^Y^p)7> zoYDG_=$oBAsv`y;3?D*_j~u2W}P$f9$(B7$Y-dx!?Y6cRd z?q~5Tt6uKQ`6SS`UGKBv6bBf>X905vS%3lo3k$?3iWop#sPr)7jjQ-Kj;d_38diMO zQ3mJXChlUWxrU;qkkDwO!!x|*@*Y?4z1QDjVm}2CAirsdsvbsHt+0JPX%W+eK*U)Z z{7ye~po?_$Qp<{Uyljs?yIhZGC%iSB{w~|Y##N2GXVI*}eyk{+k1_&K5xi*;w+>5! z6uzUVRxw;#oSu*vd&F(>RJ~j0$Cs(>6&(OFkO3c+nRv~Epl{^hePKW3`IlOk?>X0k zd@`j5Z!7pGA%IP5iY?BCb8@~>?!iMQih6_)!Ag`Gd*FpA>3Ak%LhL<| zn%Oo&WuenWOpwGppls{>Hnr^H82Qkg?`mhjdfU_OgzBVU2136W)5r|>>Bf8{9N^>Cr*YSU0%CQnp}+an%4!3*dpEHcvvcROoar2H#7CWB->Mre+w zEOkGGzKl?~Jx7Y~Yd$5oZnPBhDc)M=EM$_%+3Yh)11=5Xnf+MtlA^0je0wh-xnxg{ z=MRIBQ|g^0oWKMsfLdXcObbp&7B7cg?Ote=&HZyu!Fx!27-v>>)H(B|Cs(eh`1w>+ z;ioJ+7in?2xu_7eC?^~O4P5|A)BbXCpMm^aUUqBsCI8qhp#b#wCZvi$&=^ZBJ6IQ-kM>V9(g`veuFO+Cl+gO^0|pDg`a z!(DuSz0i0o{Dx8D?OE=+^lcVjqtWHN$-nZ-y;sbd1rVZy*g2*Y?2LgrKLx#e(~FL z|8Vy9b_ZVJTZc*`LQd7d^Ddx!0?SIAo`DZaz4_K)1n8=y-$mbZNLej0<|L&aM~=@_ zYU7#GbvkwV?M3oLtakQPg0B`2<=f!E4?0|LABR)>2Cb{}w_1>#D)*1ByiY3Vl5$+l zvZ)?>+u-_h{hP$zt9Liw@P{KGyUR`EcK)0lJo*WI!oHhWDffZp~|`PFTDqne36&CS@|MdzsT3)@bGjtjB* zwvLv8+ii;5>hli%j1$Xodda>-^6;LiOv&mPRChB)u*L6%<(-rn9qm7dsggR41>WqO zOVl>+*nWf!f|8YeQ>WoqRwbA=gCIH z{}{cGrg{d{JMK3R778M{dtmSlKt(}z{haB^VYI+E^|UOET86Qu6T6! zn8Cy%iE@147Hjj@fBwuIFQfMVk?r!zkFst!5b3z$+zxmk_myLFjDbqd?ug?f?r=_v z*$l{Hm>$@g&~?Po z82-%qkgC_u4IUgCad8Q;@{lk{u}JYE2)Nx-+HHHo%|-9cr(GL}oSt;0J@1;|s;JF=?;hR~ z_e#MawU`XW@wj?vTRLLoRBsOTsd?0Ib^E2-=a207ppOjtx4fgWQ+NuRg#}*=Na99T z6mUJS($He3txmH0RjU z(9>sp`)yDD-=NFMd>NH#A-fc_bozS0#|PR2kca{ z6MTi3IwIP3Lw;;NpQRoP62Es}O771)pMcQQsO12GH$=|p6z#4mjnX`lzq=~*RjoKL z(f7HZans9n_Y5!a@huFEZf=>QVjIl?P0=6+8hm7z$RJjoZqzvH8`H3&6rMZ_2qpuo zqiG^E{zQQ4gP)pn>SC=&Q#G^U;SryYul6jLALcH6X?}enJMCb1iAg!yoO4tD7SyG^ zUAxWtZ)^H}kYsz_mRjl?CMz<|_gn_L-|pw{^h$?;^S1%+Xc9$G#`V2tH1BYn%vP}0 z;^<#TNfKrOGZ00Z?=7L%IVFS9Ke{6B#eTUFm8&oRdRx!fj8Y6`LdWp%sSY+UYtuq7 zk*`Rc+W7f|Q*c6RNvsy1*C!R4(>?Mw7Au72NNX=s17d{6S@;+7W`xCbo5#>9~xED|3g3ceygD+8E*vg2H z&$mjv_B-`JHQ#W9oZSo(0WjRDQIk@$Ia!WGw&o5O!#o>YngNZN)Q(Z2E@b=1l1Brq zU{JjCe4uAEoU}BcXm?lZ%%JG{vO3P5n6N-ZBaZSWM*R4@q=3JCLFW7ODHdOQmHbYZ zaLpbCwxYqiF?Df!B;OHMe + 1 STUDYID Study Identifier + 2 USUBJID Unique Subject Identifier + 3 SUBJID Subject Identifier for the Study + 4 SITEID Study Site Identifier + 5 SITEGR1 Pooled Site Group 1 + 6 ARM Description of Planned Arm + 7 TRT01P Planned Treatment for Period 01 + 8 TRT01PN Planned Treatment for Period 01 (N) + 9 TRT01A Actual Treatment for Period 01 + 10 TRT01AN Actual Treatment for Period 01 (N) + # i 39 more rows + +--- + + Code + get_data_labels(adae) + Output + # A tibble: 55 x 2 + name label + + 1 STUDYID Study Identifier + 2 SITEID Study Site Identifier + 3 USUBJID Unique Subject Identifier + 4 TRTA Actual Treatment + 5 TRTAN Actual Treatment (N) + 6 AGE Age + 7 AGEGR1 Pooled Age Group 1 + 8 AGEGR1N Pooled Age Group 1 (N) + 9 RACE Race + 10 RACEN Race (N) + # i 45 more rows + +--- + + Code + get_data_labels(adas) + Output + # A tibble: 40 x 2 + name label + + 1 STUDYID Study Identifier + 2 SITEID Study Site Identifier + 3 SITEGR1 Pooled Site Group 1 + 4 USUBJID Unique Subject Identifier + 5 TRTSDT Date of First Exposure to Treatment + 6 TRTEDT Date of Last Exposure to Treatment + 7 TRTP Planned Treatment + 8 TRTPN Planned Treatment (N) + 9 AGE Age + 10 AGEGR1 Pooled Age Group 1 + # i 30 more rows + +--- + + Code + get_data_labels(adlb) + Output + # A tibble: 46 x 2 + name label + + 1 STUDYID Study Identifier + 2 SUBJID Subject Identifier for the Study + 3 USUBJID Unique Subject Identifier + 4 TRTP Planned Treatment + 5 TRTPN Planned Treatment (N) + 6 TRTA Actual Treatment + 7 TRTAN Actual Treatment (N) + 8 TRTSDT Date of First Exposure to Treatment + 9 TRTEDT Date of Last Exposure to Treatment + 10 AGE Age + # i 36 more rows + diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index c61f0d29..cbfcbd78 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -690,6 +690,7 @@ test_that("test IBM rounding option", { group_count(gender, by = "Gender") %>% set_format_strings(f_str("xxx (xxx%)", n, pct)) ) + expect_warning({tabl2 <- build(tabl2)}, "You have enabled IBM Rounding.") expect_equal(tabl2$var1_Placebo, c("485 ( 49%)", "515 ( 52%)")) diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R new file mode 100644 index 00000000..90ea0cca --- /dev/null +++ b/tests/testthat/test-data.R @@ -0,0 +1,6 @@ +test_that("get_data_labels", { + expect_snapshot(get_data_labels(adsl)) + expect_snapshot(get_data_labels(adae)) + expect_snapshot(get_data_labels(adas)) + expect_snapshot(get_data_labels(adlb)) +}) diff --git a/vignettes/Tplyr.Rmd b/vignettes/Tplyr.Rmd index 5c2068b9..4ebe4009 100644 --- a/vignettes/Tplyr.Rmd +++ b/vignettes/Tplyr.Rmd @@ -21,9 +21,6 @@ library(tidyverse) library(magrittr) library(Tplyr) library(knitr) -load("adae.Rdata") -load("adsl.Rdata") -load("adlb.Rdata") ``` # How **Tplyr** Works diff --git a/vignettes/count.Rmd b/vignettes/count.Rmd index ca77ee72..5cf01cd8 100644 --- a/vignettes/count.Rmd +++ b/vignettes/count.Rmd @@ -20,9 +20,6 @@ knitr::opts_chunk$set( library(Tplyr) library(dplyr, warn.conflicts = FALSE) library(knitr) -load("adsl.Rdata") -load("adae.Rdata") -load("adlb.Rdata") ``` At the surface, counting sounds pretty simple, right? You just want to know how many occurrences of something there are. Well - unfortunately, it's not that easy. And in clinical reports, there's quite a bit of nuance that goes into the different types of frequency tables that need to be created. Fortunately, we’ve added a good bit of flexibility into `group_count()` to help you get what you need when creating these reports, whether you’re creating a demographics table, adverse events, or lab results. diff --git a/vignettes/custom-metadata.Rmd b/vignettes/custom-metadata.Rmd index 5b75c0bc..55f5e9f2 100644 --- a/vignettes/custom-metadata.Rmd +++ b/vignettes/custom-metadata.Rmd @@ -25,8 +25,6 @@ library(knitr) ``` ```{r data prep, echo=FALSE} -load("adas.Rdata") -load("adsl.Rdata") t <- tplyr_table(adas, TRTP, where=EFFFL == "Y" & ITTFL == "Y" & PARAMCD == "ACTOT" & ANL01FL == "Y") %>% set_pop_data(adsl) %>% diff --git a/vignettes/denom.Rmd b/vignettes/denom.Rmd index 3caefcc2..a65d2674 100644 --- a/vignettes/denom.Rmd +++ b/vignettes/denom.Rmd @@ -20,9 +20,6 @@ knitr::opts_chunk$set( library(Tplyr) library(dplyr, warn.conflicts = FALSE) library(knitr) -load("adsl.Rdata") -load("adae.Rdata") -load("adlb.Rdata") ``` Counting is pretty easy, right? There's not all that much to it. With a few considerations we can cover most of the scenarios that users will encounter while using Tplyr. Denominators, on the other hand, get *_a lot_* more complicated. Why? Because there are a lot of ways to do it. What values do we exclude from the denominator? What variables establish denominator grouping? Does the denominator use a different filter than the values being counted? If you've programmed enough of these tables, you know that it's all very situational. diff --git a/vignettes/desc.Rmd b/vignettes/desc.Rmd index 112d7105..180f6012 100644 --- a/vignettes/desc.Rmd +++ b/vignettes/desc.Rmd @@ -21,8 +21,6 @@ library(tidyverse) library(magrittr) library(Tplyr) library(knitr) -load("adlb.Rdata") -load("adsl.Rdata") ``` Descriptive statistics in **Tplyr** are created using `group_desc()` function when creating a layer. While `group_desc()` allows you to set your target, by variables, and filter criteria, a great deal of the control of the layer comes from `set_format_strings()` where the actual summaries are declared. diff --git a/vignettes/desc_layer_formatting.Rmd b/vignettes/desc_layer_formatting.Rmd index 0bad68a8..75a17b30 100644 --- a/vignettes/desc_layer_formatting.Rmd +++ b/vignettes/desc_layer_formatting.Rmd @@ -21,9 +21,6 @@ library(tidyverse) library(magrittr) library(Tplyr) library(knitr) -load("adlb.Rdata") -load("adsl.Rdata") -load('adlb.Rdata') ``` A lot of the nuance to formatting descriptive statistics layers was covered in the descriptive statistic layer vignette, but there are a couple more tricks to getting the most out of **Tplyr**. In this vignette, we'll cover some of the options in more detail. diff --git a/vignettes/general_string_formatting.Rmd b/vignettes/general_string_formatting.Rmd index caa4754b..3e14338d 100644 --- a/vignettes/general_string_formatting.Rmd +++ b/vignettes/general_string_formatting.Rmd @@ -20,9 +20,6 @@ knitr::opts_chunk$set( library(Tplyr) library(dplyr) library(tidyr) -load('adsl.Rdata') -load('adlb.Rdata') -load('adae.Rdata') ``` A key focus of producing a clinical table is ensuring that the formatting of the table is in line with the statistician and clinician's expectations. Organizations often have strict standards around this which vary between organizations. Much of this falls outside the scope of **Tplyr**, but **Tplyr** gives _great_ focus to how the numeric results on the page are formatted. R has vast capabilities when it comes to HTML and interactive tables, but **Tplyr's** focus on string formatting is designed for those traditional, PDF document printable pages. The aim to make it as simple as possible to get what you need to work with a typical monospace fonts. diff --git a/vignettes/layer_templates.Rmd b/vignettes/layer_templates.Rmd index 3c1bd5f9..ab0f3ea7 100644 --- a/vignettes/layer_templates.Rmd +++ b/vignettes/layer_templates.Rmd @@ -17,7 +17,6 @@ knitr::opts_chunk$set( ```{r setup, echo=FALSE} library(Tplyr) library(knitr) -load('adsl.Rdata') ``` There are several scenarios where a layer template may be useful. Some tables, like demographics tables, may have many layers that will all essentially look the same. Categorical variables will have the same count layer settings, and continuous variables will have the same desc layer settings. A template allows a user to build those settings once per layer, then reference the template when the **Tplyr** table is actually built. Another scenario might be building a set of company layer templates that are built for standard tables to reduce the footprint of code across analyses. In either of these cases, the idea is the reduce the amount of redundant code necessary to create a table. diff --git a/vignettes/metadata.Rmd b/vignettes/metadata.Rmd index 9edf5cf4..a553b1d8 100644 --- a/vignettes/metadata.Rmd +++ b/vignettes/metadata.Rmd @@ -22,7 +22,6 @@ library(tidyr) library(magrittr) library(Tplyr) library(knitr) -load("adsl.Rdata") ``` **Tplyr** has a bit of a unique design, which might feel a bit weird as you get used to the package. The process flow of building a `tplyr_table()` object first, and then using `build()` to construct the data frame is different than programming in the tidyverse, or creating a ggplot. Why create the `tplyr_table()` object first? Why is the `tplyr_table()` object different than the resulting data frame? diff --git a/vignettes/options.Rmd b/vignettes/options.Rmd index 529c5cd5..f2201995 100644 --- a/vignettes/options.Rmd +++ b/vignettes/options.Rmd @@ -21,9 +21,6 @@ library(tidyverse) library(magrittr) library(Tplyr) library(knitr) -load("adae.Rdata") -load("adsl.Rdata") -load("adlb.Rdata") op <- options() ``` diff --git a/vignettes/post_processing.Rmd b/vignettes/post_processing.Rmd index 0578797c..78521385 100644 --- a/vignettes/post_processing.Rmd +++ b/vignettes/post_processing.Rmd @@ -20,8 +20,6 @@ knitr::opts_chunk$set( library(Tplyr) library(dplyr) library(knitr) -load('adsl.Rdata') -load('adae.Rdata') ``` We've made a large effort to make **Tplyr** tables flexible, but not everything can (or, in some cases, we think should) be handled during table construction itself. To address this, **Tplyr** has several post-processing functions that help put finishing touches on your data to help with presentation. diff --git a/vignettes/riskdiff.Rmd b/vignettes/riskdiff.Rmd index 296338da..b5805d0e 100644 --- a/vignettes/riskdiff.Rmd +++ b/vignettes/riskdiff.Rmd @@ -21,8 +21,6 @@ library(tidyverse) library(magrittr) library(Tplyr) library(knitr) -load("adae.Rdata") -load("adsl.Rdata") ``` **Tplyr** does not support, nor do we intend to support, a wide array of statistical methods. Our goal is rather to take your focus as an analyst off the mundane summaries so you can focus on the interesting analysis. That said, there are some things that are common enough that we feel that it's reasonable for us to include. So let's take a look at risk difference. diff --git a/vignettes/shift.Rmd b/vignettes/shift.Rmd index 05094358..6cd7b091 100644 --- a/vignettes/shift.Rmd +++ b/vignettes/shift.Rmd @@ -20,9 +20,6 @@ knitr::opts_chunk$set( library(Tplyr) library(dplyr, warn.conflicts = FALSE) library(knitr) -load("adsl.Rdata") -load("adae.Rdata") -load("adlb.Rdata") ``` Shift tables are a special kind of frequency table - but what they count are changes in state. This is most common when looking at laboratory ranges, where you may be interested in seeing how a subject's results related to normal ranges. The 'change in state' would refer to how that subject's results were at baseline versus different points of measure. Shift tables allow you to see the distribution of how subjects move between normal ranges, and if the population is improving or worsening as the study progresses. diff --git a/vignettes/sort.Rmd b/vignettes/sort.Rmd index 57d3a38e..437b8db8 100644 --- a/vignettes/sort.Rmd +++ b/vignettes/sort.Rmd @@ -20,9 +20,6 @@ knitr::opts_chunk$set( library(Tplyr) library(dplyr, warn.conflicts = FALSE) library(knitr) -load("adsl.Rdata") -load("adae.Rdata") -load("adlb.Rdata") ``` At surface level - sorting a table may seem easy, and in many cases it is. But in a handful of cases it can get quite tricky, with some odd situations that need to be handled carefully. For this reason, we found it necessary to dedicate an entire vignette to just sorting and handling columns output by **Tplyr**. diff --git a/vignettes/styled-table.Rmd b/vignettes/styled-table.Rmd index 31cb89c5..16c50869 100644 --- a/vignettes/styled-table.Rmd +++ b/vignettes/styled-table.Rmd @@ -21,7 +21,6 @@ library(Tplyr) library(dplyr, warn.conflicts = FALSE) library(knitr) library(kableExtra) -load("adsl.Rdata") ``` In the other vignettes we talk about how to get the most out of **Tplyr** when it comes to preparing your data. The last step we need to cover is how to get from the data output by **Tplyr** to a presentation ready table. diff --git a/vignettes/table.Rmd b/vignettes/table.Rmd index 1f268b3d..c8da37f9 100644 --- a/vignettes/table.Rmd +++ b/vignettes/table.Rmd @@ -21,8 +21,6 @@ library(tidyverse) library(magrittr) library(Tplyr) library(knitr) -load("adae.Rdata") -load("adsl.Rdata") ``` Most of the work in creating a **Tplyr** table is at the layer level, but there are a few overarching properties that are worth spending some time discussing. One of the things that we wanted to make sure we did in **Tplyr** is allow you to eliminate redundant code wherever possible. Adding some processing to the `tplyr_table()` level allows us to do that. Furthermore, some settings simply need to be applied table wide. From 1b56858dfc29dc7949b3950fab3f712140278a6a Mon Sep 17 00:00:00 2001 From: Michael Stackhouse Date: Mon, 18 Dec 2023 08:35:08 -0500 Subject: [PATCH 21/83] Update tests/testthat/test-collapse_row_labels.R Co-authored-by: Shiyu Chen <39443807+ShiyuC@users.noreply.github.com> --- tests/testthat/test-collapse_row_labels.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/tests/testthat/test-collapse_row_labels.R b/tests/testthat/test-collapse_row_labels.R index e6242eb9..86a34184 100644 --- a/tests/testthat/test-collapse_row_labels.R +++ b/tests/testthat/test-collapse_row_labels.R @@ -1,16 +1,16 @@ dat <- tibble::tribble( ~row_label1, ~row_label2, ~row_label3, ~row_label4, ~var1, - "A", "C", "G", "M", 1L, - "A", "C", "G", "N", 2L, - "A", "C", "H", "O", 3L, - "A", "D", "H", "P", 4L, - "A", "D", "I", "Q", 5L, - "A", "D", "I", "R", 6L, - "B", "E", "J", "S", 7L, - "B", "E", "J", "T", 8L, - "B", "E", "K", "U", 9L, - "B", "F", "K", "V", 10L, - "B", "F", "L", "W", 11L + "A", "C", "G", "M", 1L, + "A", "C", "G", "N", 2L, + "A", "C", "H", "O", 3L, + "A", "D", "H", "P", 4L, + "A", "D", "I", "Q", 5L, + "A", "D", "I", "R", 6L, + "B", "E", "J", "S", 7L, + "B", "E", "J", "T", 8L, + "B", "E", "K", "U", 9L, + "B", "F", "K", "V", 10L, + "B", "F", "L", "W", 11L ) From 5e5d24429142358c5a55379c3b0f0b1ec4a1512d Mon Sep 17 00:00:00 2001 From: Michael Stackhouse Date: Mon, 18 Dec 2023 08:35:16 -0500 Subject: [PATCH 22/83] Update R/collapse_row_labels.R Co-authored-by: Shiyu Chen <39443807+ShiyuC@users.noreply.github.com> --- R/collapse_row_labels.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/collapse_row_labels.R b/R/collapse_row_labels.R index 23c1f376..d4a7e547 100644 --- a/R/collapse_row_labels.R +++ b/R/collapse_row_labels.R @@ -29,17 +29,17 @@ add_indentation <- function(.x, .y, indent = " ") { #' @examples #' x <- tibble::tribble( #' ~row_label1, ~row_label2, ~row_label3, ~row_label4, ~var1, -#' "A", "C", "G", "M", 1L, -#' "A", "C", "G", "N", 2L, -#' "A", "C", "H", "O", 3L, -#' "A", "D", "H", "P", 4L, -#' "A", "D", "I", "Q", 5L, -#' "A", "D", "I", "R", 6L, -#' "B", "E", "J", "S", 7L, -#' "B", "E", "J", "T", 8L, -#' "B", "E", "K", "U", 9L, -#' "B", "F", "K", "V", 10L, -#' "B", "F", "L", "W", 11L +#' "A", "C", "G", "M", 1L, +#' "A", "C", "G", "N", 2L, +#' "A", "C", "H", "O", 3L, +#' "A", "D", "H", "P", 4L, +#' "A", "D", "I", "Q", 5L, +#' "A", "D", "I", "R", 6L, +#' "B", "E", "J", "S", 7L, +#' "B", "E", "J", "T", 8L, +#' "B", "E", "K", "U", 9L, +#' "B", "F", "K", "V", 10L, +#' "B", "F", "L", "W", 11L #' ) #' #' From ad619ea88627de544683e62db26e0c325d317e5d Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 18 Dec 2023 17:59:29 +0000 Subject: [PATCH 23/83] Remove unnecessary and untested complexity from assertions --- R/assertions.R | 53 +++----------------------------------------------- 1 file changed, 3 insertions(+), 50 deletions(-) diff --git a/R/assertions.R b/R/assertions.R index ba108032..4e36c217 100644 --- a/R/assertions.R +++ b/R/assertions.R @@ -42,22 +42,7 @@ assert_has_class <- function(x, should_be) { # Is the argument the class that it should be? if (class(x) != should_be){ - # Grab the trace back into an object - trc <- trace_back() - # Look at the length of the traceback - max_length <- length(trc$calls) - # If it's >1 we're inside a function, so grab the name - if (max_length > 1){ - # Pull the name out of the call stack - cname <- call_name(trc$calls[[max_length - 1]]) - # Make a display string - func_str <- paste0('` in function `', cname, '`') - } else { - # Filler - func_str <- '`' - } - # Abort and show error - abort(paste0('Argument `', param, func_str, ' must be ', + abort(paste0('Argument `', param, '` must be ', should_be, '. Instead a class of "', class(x), '" was passed.')) } @@ -75,24 +60,9 @@ assert_inherits_class <- function(x, should_have) { # Is the argument the class that it should be? if (!inherits(x, should_have)){ - - # Grab the trace back into an object - trc <- trace_back() - # Look at the length of the traceback - max_length <- max(trc$indices) - # If it's >1 we're innside a function, so grab the name - if (max_length > 1){ - # Pull the name out of the call stack - cname <- call_name(trc$calls[[max_length - 1]]) - # Make a display string - func_str <- paste0('` in function `', cname, '`') - } else { - # Filler - func_str <- '`' - } # Abort and show error - abort(paste0('Argument `', param, func_str, - ' does not inherit "', should_have, + abort(paste0('Argument `', param, + '` does not inherit "', should_have, '". Classes: ', paste(class(x), collapse=", "))) } } @@ -197,15 +167,6 @@ unpack_vars <- function(quo_list, allow_character=TRUE) { quo_list } -#' Check if a quosure is null or contains a call -#' -#' @param quo_var A quosure object to check -#' -#' @noRd -is_null_or_call <- function(quo_var) { - quo_is_null(quo_var) || inherits(quo_get_expr(quo_var), "call") -} - #' Check if a quosure is null or contains a logical value #' #' @param quo_var A quosure object to check @@ -222,14 +183,6 @@ assert_is_layer <- function(object) { assert_inherits_class(object, "tplyr_layer") } -#' @param object Object to check if its a layer -#' -#' @noRd -assert_is_table <- function(object) { - assert_inherits_class(object, "tplyr_table") -} - - #' Return the class of the expression inside a quosure #' #' @param q A quosure From 46c5b67194a2ed5802d7f02cd615674f68087c57 Mon Sep 17 00:00:00 2001 From: Andrew Bates Date: Mon, 18 Dec 2023 18:22:16 +0000 Subject: [PATCH 24/83] prefix data sets with 'tplyr' --- R/data.R | 8 ++--- README.Rmd | 2 +- data-raw/adae.R | 4 +-- data-raw/adas.R | 4 +-- data-raw/adlb.R | 4 +-- data-raw/adsl.R | 4 +-- data/adae.rda | Bin 7372 -> 0 bytes data/adas.rda | Bin 15031 -> 0 bytes data/adlb.rda | Bin 15730 -> 0 bytes data/adsl.rda | Bin 11970 -> 0 bytes data/tplyr_adae.rda | Bin 0 -> 7374 bytes data/tplyr_adas.rda | Bin 0 -> 15047 bytes data/tplyr_adlb.rda | Bin 0 -> 15769 bytes data/tplyr_adsl.rda | Bin 0 -> 11980 bytes man/collapse_row_labels.Rd | 22 ++++++------- man/{adae.Rd => tplyr_adae.Rd} | 6 ++-- man/{adas.Rd => tplyr_adas.Rd} | 6 ++-- man/{adlb.Rd => tplyr_adlb.Rd} | 6 ++-- man/{adsl.Rd => tplyr_adsl.Rd} | 6 ++-- tests/testthat/_snaps/data.md | 8 ++--- tests/testthat/test-data.R | 8 ++--- vignettes/Tplyr.Rmd | 36 ++++++++++----------- vignettes/count.Rmd | 10 +++--- vignettes/custom-metadata.Rmd | 6 ++-- vignettes/denom.Rmd | 38 +++++++++++----------- vignettes/desc.Rmd | 12 +++---- vignettes/desc_layer_formatting.Rmd | 34 ++++++++++---------- vignettes/general_string_formatting.Rmd | 16 +++++----- vignettes/layer_templates.Rmd | 6 ++-- vignettes/metadata.Rmd | 8 ++--- vignettes/options.Rmd | 14 ++++----- vignettes/post_processing.Rmd | 10 +++--- vignettes/riskdiff.Rmd | 16 +++++----- vignettes/shift.Rmd | 8 ++--- vignettes/sort.Rmd | 40 ++++++++++++------------ vignettes/styled-table.Rmd | 2 +- vignettes/table.Rmd | 10 +++--- 37 files changed, 177 insertions(+), 177 deletions(-) delete mode 100644 data/adae.rda delete mode 100644 data/adas.rda delete mode 100644 data/adlb.rda delete mode 100644 data/adsl.rda create mode 100644 data/tplyr_adae.rda create mode 100644 data/tplyr_adas.rda create mode 100644 data/tplyr_adlb.rda create mode 100644 data/tplyr_adsl.rda rename man/{adae.Rd => tplyr_adae.Rd} (88%) rename man/{adas.Rd => tplyr_adas.Rd} (88%) rename man/{adlb.Rd => tplyr_adlb.Rd} (88%) rename man/{adsl.Rd => tplyr_adsl.Rd} (88%) diff --git a/R/data.R b/R/data.R index bfe03a1e..25332b39 100644 --- a/R/data.R +++ b/R/data.R @@ -8,7 +8,7 @@ #' #' @source https://github.com/phuse-org/TestDataFactory #' -"adsl" +"tplyr_adsl" #' ADAE Data @@ -21,7 +21,7 @@ #' #' @source https://github.com/phuse-org/TestDataFactory #' -"adae" +"tplyr_adae" #' ADAS Data #' @@ -33,7 +33,7 @@ #' #' @source https://github.com/phuse-org/TestDataFactory #' -"adas" +"tplyr_adas" #' ADLB Data #' @@ -45,7 +45,7 @@ #' #' @source https://github.com/phuse-org/TestDataFactory #' -"adlb" +"tplyr_adlb" #' Get Data Labels diff --git a/README.Rmd b/README.Rmd index d4c29c51..b86086fa 100644 --- a/README.Rmd +++ b/README.Rmd @@ -78,7 +78,7 @@ Enough talking - let's see some code. In these examples, we will be using data f ```{r initial_demo} -tplyr_table(adsl, TRT01P, where = SAFFL == "Y") %>% +tplyr_table(tplyr_adsl, TRT01P, where = SAFFL == "Y") %>% add_layer( group_desc(AGE, by = "Age (years)") ) %>% diff --git a/data-raw/adae.R b/data-raw/adae.R index 6513c2d8..5c187c73 100644 --- a/data-raw/adae.R +++ b/data-raw/adae.R @@ -2,5 +2,5 @@ # this is a copy of the PHUSE Test Data Factory data, trimmed down for size load("data-raw/adae.Rdata") - -usethis::use_data(adae, overwrite = TRUE) +tplyr_adae <- adae +usethis::use_data(tplyr_adae, overwrite = TRUE) diff --git a/data-raw/adas.R b/data-raw/adas.R index f078817b..5222a90a 100644 --- a/data-raw/adas.R +++ b/data-raw/adas.R @@ -2,5 +2,5 @@ # this is a copy of the PHUSE Test Data Factory data, trimmed down for size load("data-raw/adas.Rdata") - -usethis::use_data(adas, overwrite = TRUE) +tplyr_adas <- adas +usethis::use_data(tplyr_adas, overwrite = TRUE) diff --git a/data-raw/adlb.R b/data-raw/adlb.R index 53c62018..df2972ea 100644 --- a/data-raw/adlb.R +++ b/data-raw/adlb.R @@ -2,5 +2,5 @@ # this is a copy of the PHUSE Test Data Factory data, trimmed down for size load("data-raw/adlb.Rdata") - -usethis::use_data(adlb, overwrite = TRUE) +tplyr_adlb <- adlb +usethis::use_data(tplyr_adlb, overwrite = TRUE) diff --git a/data-raw/adsl.R b/data-raw/adsl.R index 2ddadf89..a56cf66f 100644 --- a/data-raw/adsl.R +++ b/data-raw/adsl.R @@ -2,5 +2,5 @@ # this is a copy of the PHUSE Test Data Factory data, trimmed down for size load("data-raw/adsl.Rdata") - -usethis::use_data(adsl, overwrite = TRUE) +tplyr_adsl <- adsl +usethis::use_data(tplyr_adsl, overwrite = TRUE) diff --git a/data/adae.rda b/data/adae.rda deleted file mode 100644 index edfb559cb234c5a3da1fff2446615d0b8a341b84..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 7372 zcmX9=XE+;-_eJf}CRT~jh=@HKqehEHBnV=bpv0)H_H1i6gd!nE@Y;LtRV_lrsy%9T z7%kPI)mF#bf8XE#e7NU4&;4@lhkKr5;NW#tMc*D~W$!e3;>4((bpOv^{QKwIfAs(O z8GUyD*0+p*|NJ>nocZ(n;Dzk9j}Z*VC(Yr0THzf}y>lb{+Y(!c*Er?k7#P&~(|uSN z9VS4m>%1P*3`}th+D4A?1@Sp)d{E?E;T*mj)Z)T@Df>m_xsoGKZiq~r8r-`Az^a#C zP&wftRzqH*^7xy>Obb*WR8y@$81tp2Pv%zc^tzfl@{&IW6oqu3;3AurlpRJ()xA|A z!J|vEE0%Pn>Rv4Pa6$A^tLrjg^Qt4KKP$QruB&${2;--zVD+?c?pv5gI_<(Zz0 zrvBm;YSDQ4Ky&{r@sg3El2t?1-p10xBe5ucL~p?^o5v*Y&c|PLk;8M(4j@clqapW< z!$v=TK$`0|-+oXdXco^cUiQ5&38(%4vyk_DT1=#($mMll$6t6~WMyrhPcZ}!`+kK0?f{buIQ{m53 z5j3HP@)4}*c_c~CPm`votPpuJQOU33OsK$Q=;j+P<5*(btZmQBu1CjX(QhsdwBYW4 zQ+N!&E9iWb-%xwSY zb&*5FZ9rO}R_xfzPxXm5ACr)dR zHSlRw-%qc7V`G;jzTupI6>x&5A+^r`GfQN?EF`C4oyf~b=;0C+G6VmJEK`#c8{xW4 z>R^a+Bi*vl@?C$s27vDT1Oh&6&_Z(%^UWWReJEV_xO8!{Y>*|-m1zijdu%5WjYH)o`B~C8O{*j$5AeSx~Jp+ zX5zUiItQm9)ZpR+cR$j#Fl7={h=-Fg{w|4wL6GT*m_(t1@4T?mvmTwp42m~T%JqxJ z16xP2k|hrHDCc&;>78UFJti0hQd>Ltg+}NB0H=^~a)6Y?pNvp(CKWy(Zhq)ZD6JH! zz>i@DdP%oqE6e9$V;Np;k96lD8@Ai!23#2sd;9{zfvI(!SzEEN)i`w3s%?T&*{Gx%JC_a))UUk!-u#uXyE#vZbC(8wiEw5aLlzl#`tluA&+_v}UxP=Czor6>HA8q=5vm5DD@`D5QZ3mOE{jIsaFu2H_Dxu9wYY(mALz}Y zH=CMFy$mWYuD}4Cl+eVULNc}ia2w>zdzUVTrkRQ(AYKgm-~|0@$xgnB6i_l3%u>xH znagy(iVrER&}y4MeA8uh#EV|#>JfWOz3HI4clAD%^`=e& zTH10umM00uto*SrC8t+U+68KMMQ|ynJiVF*26*pMA>%ZNg8>fHnTTO6WS^{rdx#74 za~P*z0^}go+GKn945}ruSZOQBP3g*XnPAB&Qxz^wYF17eN1E*mjGzUxVH!XW3J6Yo zmLkI>lpWvO5%mnsF~FHXoj+5&rW4_}I|rllq>x(5ix_o)s6rmy3dU?6$>rJOtI4l|U-4dsH6l4sH2Bccj@8~Bb-QXmd6rmh?6r$B|{>Tkv8?3^Dio%xXgD_aA0qSOXyPvR| zw<%R7XTe5*jPy*EaGzGy@3chZPptESj7e~siVKaFk>)u;mmh(qQYGCCJ#kEu`qeUq z5GW8|#fr7GG|0iWmZl1*OQVIzP)iUVK4naY`6y$6%ryCYUUYS`eyRae8y{SVsMgd} zSKfv+knxnjHt|@dSB{U^bFyX&%p=uOe4z5G(@&(=K}diK89GOosa?u0_dp{o{fzPI z5?GMCd#8`Ayid16TDSD_%_e^=0$ZB_@HmGqA6MW(Aj`Sa9n@8AY-O98%E!xzh85Oc zYvUWjIDW$>qQkQD(j$dSRXy)O|MG0h2)#XU%8||+Q6Ugo@ugXixY{Q_`LdL=2&Q~I zC;{|)7jw^c(gaF&0+X_rUXUOcY~FE&u`-$0IE$kGgd>B5dDtdlD}5e>N84r~lxdd0 zcu7W?8~>KV2_vC$R?W}fp1fUq+M`ieF4k#Q1!Su~diqWD9@+Wv@bJA0XZK3a#1_|p z^`}GKU*%3N*L_tge2HdEbg5M%f-w4q!Z1!bUVcMX6?_J=-JcJil{YJ)A(zjMSc`m%}uDMUXQcDny3=>`;{duyOifyI?wqY7OWxRHsMDaLzh_UmdY zPJS7d1D19HQ^&_b@EUT0!@~#kSaLN zp8nLnX(O-`Z+~IKM@>!Ko}$BB9egu6CVwl+ZTQYpq}T<)ZB$||$-^C?1@6WnE^U;# zGNuAt1&}H(7IpTiq%sc@zp<596$RD0GT1QNfbJ|@^$+(Ce~T8td&|>u2(^{oS6$NS zR@s;^4!)Z}zE$OC_xE+a<$ovt43)c&x-HHDA<0NU6Hxx;U4CB14|6?}X5px|bx)2I zF++D*Spfv)Ea;-*UDfdXLap~VanN`9#gl8JQg+_8M`p;z2O(FdukcNd1=C3To2Y3? znDJ9PY!cEv%&$#>1pA6!rFv&CugLZx=Uv-r^(L;aQ(Rh$K-;u5+P;1I$Fn<0KF|ArT3%KweW{LH+Fl>KPZ-V9Dg;Q#`eR?MCp=jv;1@1odtK(zYl zN#4LIkESihzKNIcrI)!Z{Fl74Ju4!%c1?#KLnN@m>GWiXmJzX;=0@ALU!W5eBB{@>!TH9+;oqG_e^G7igSWsw>_2*kv1>g#GHUg<%1;YQvJy2Zx2u zCVA7VD-~`s1<-;@BZ!3gxiMjX0di)i8C9E&Z zuR86yW+-fEDDXEjc&+WZYbylnWlMUZ1MM5aSBewUkS@Jshqpq?BER874H70RXfY6dV4>`*}dbPNtn{OCz(^CK-guQNS{ao9c6O z!s1e0RT=mY367mNYOOY|&AF!KE`?+X=A%cRqe|nYOEG-jxrW$O?m8aztxdzUZ1tS? zZ}V%{8-NdkgMZ}}AE}4tir40=zzq?8R6||zz~Ux4gDI}>kv8?2^jH>Y&}p>-vMllWw4s8 zXl_6GG`K*9xu! z`4tuX^6R!JF5=RZnj*Cdal*ZPjX*0FjT1+$fyb5i}0s=W}6)~PLn(r zeBgUDZ_Wd+Z2W-?GjkX;eXY%+9#NldW6Rlo zS?}}RCrOO8MXj@3FWJz&B5pzFFe2_a;nk+C-lXiLB28t5-cSC#FAoA6-tIQ^y~s>> zYPWXEc5eaQmkkJ>BWP%a2EM23kj%VJv{QlP(cC3CWNnWB05d>Gag zBt6~SZmy(bu}YPhL7!M_DjE)B2CAChCzrF-ed2P}O-nqt*l@iSA$p7NTUqx4o9A%M z%SBpjHz6?t$U1nRzZn&S2XE|QPagB{N0n{8Mv(@$VwXc_{TF2*r4L*IctOZTuhUoJ z51Gy09u3yCKuP9a2+@n3(Zz(sEP|G(R4T)-4mXzInL!?Z!N!*R&t6GrhQAU0=eq^7 zlXv4CC$(4Q%yFu4*~$uW_9x_~^+u~2AY1J1nx$>==oYiWz9xYl>fG}lb)ub`VQul| z+D870`tl@)4Y!bqQXD}igk|d^>ovDMFM{UhSNT~)Nv6AebU>h)qjuqy7MncOx2){$ zxex0!awQ3^P1DZ{NzhP(zJtVkPC{wEOWaP(+0^^oz*GrdQvES!;tKt?rduPvV~h}e z>UDc;kc5_}NX&h?Y|6xHJS+TL{%4-+yDy;w*9eXeC9l9dX2BxuJmbUK%)2&ru`l@a z8WoI`%R2aTaQZ~Lw+HLM{gA8D*$T_&%$KtaI6iq+55FYuk(an43!n zLB-r~hV|B+IB1vE2;>5)9Q*{q$@v0%A!@Z=_cHUN_-s93q`h8sJl zm3P&2WwWKKrEcW3GpSYP)V=>9A5F2!G0%n$n^&QXdbq`*Cs6&w8Y%X5Xx#&jgKac4 zzc3;Ma^aqK6p}qL0en;T(S@I2A-9!;_y+zbx{d+tH*HEd1kgMc;2>0p9 zPowMCGqvgNVYV^7EC43*A)OVFNYUJ7svBwwjYc9)^BcDe_4L>31>X^|V z*+8FN77|z2GX=7Fg}>P?(L{*S^xwYAERL; zWHR~b^RaElynsRZ^D))o@>aJ^xwYdnhtriFpw`IjOTfL$953E7>MQ_*kqsv~znxp` z=ACz#Q{yvOiSiTBDd~Jt+W3Lv)k`ExuLjxrD%&@$u zT)Zl)fddPO{Oj=4aiAvXu4yFV1B8pl1_3{ZEohHUf;|fG)EF`OG1M1+BLX&1?NOTl zSeC1R3e;AB^JX#;N)&(^8>0xV=T|A&?f~U?1eqLvg&PBe=5depZO1_frMqZ!A2Zlg(y*S8Wtt6vrZX5zaHemC)w{6l? zDJK$@j4M*Q>JgS_C$@7&^stN4qmxX7oocb&jj$ zoQ+a~f+qK9kiOewE%zgZV~vu8gm(e>D<8_w`=2(-^u5+;0qj!3dVA7Z*N06tQ_VcH zG}6C>zX({iVdXpgZi9i~KVF!rQ6?n3*v_?+?z3nmHEY~}Y{jBl>)o%^D8&X9Ms4($gS+223RC?zEz%!cAtwWz zWz*yDgcu5BEu4%7KDbq*7IZ7D@k@%_p1aA!?Gc*`53H}=E_OfoECsSS$SjHdt#w}W z#7w1V_R}lM=9y&w$t*wK)(siYT3_VZ!lWm~zN>E^Im9f-x{K+edbY*AiVvE%&`1~& z2Z-Ogl#(Cl2RbT+Bm1Yi56m;`Dylj?hPGE`JFW~3h}ky&=y}=l^zG>fmE-pJLfXG) zuPM2WX)o^0xNSx0Z1>2T`1bRdYs=(`tZ7G8onAd%p6q`uFIA^0CS@gH5;*AFZP;?_ zgI&ueH#x!yc1~b_&#Iq)R>`>!)@D-N_P6O>x@zdS9J#hxzULej7TRp54(Tfi4`~{7 zvp+w*E#bK5Y%u5>x#tY&N!uy>{D@n0>kY6)##sq;65#8!x52>9#0%By3)Vf2D0aX<68YsFgGY;&7dR5g9!GsfP0TT;JlM@4$&M;8JFVnCv*Q zKVG0H{X_l@dK`7}OU_Tjw6j2>Z1bF=3YYUp(A=JXsNx>#);85+AS->m`Czq5xadK# zx>DtY&Q`Q4@1n+x@{N>AUcvr-*2H-qgyK(&w*J%iQe`fN3zO499}1pXRpK^+dtf4C z$(OIu0JlZOYo6@?Xraj-$>6SseO$5T@ z{1c74SN7;r!aC6Ac=BVXV^#L%b4A;zmGx|xs;-~&@ZkF$Ha``(+|+fjd*cv_QVUlfB z69(T?!yaZARQ28|fB0))-TzU}iY>*Tzg$4**e;~0%b&8#&*NuvHnr-68;SccDH}C$ u@m{H{+Sez95-kX7BDV>lr`;(abFwcXp$(IUH$NLv+)cYv1|G=W?f*YBZ)W!Z diff --git a/data/adas.rda b/data/adas.rda deleted file mode 100644 index 59f8236e603123ac7b1efdbbe8508d8d5ee71577..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 15031 zcmaibcT^K!(01rG^xg@fgeD~*RVkqa2oQR&0Yk4M0xG=(f)IL@-jN;@L8W)4cTjp2 zL_k3O>Bswi=llDcvuDrlJ$q*Eotb@h?sNBQ*q{}q)vbk0tqFfo$PkY3z4-V4ldonx zr>`Dpi35vo0007&5T_en$w*@WfHgxx4$%2UC4ATHc>Ozos@~LWmGJv-073ssbbBNK zdq-m@yTUVn8U`^oH;@4YlDOPzL9|c5mpis zCQ4?FOx+TI@#D^zuK)l^wb_NnZ?bo$Z#S-4LPUa9x~OsR(uzw10|c~}+6ayXK+!WO z^mJ8Jrbh;S<^_VmyE;RN5imEhY&sfa>LD%5G#wwwQ5-wTI6_*^L2-l*gQC^rR6ISZ z5b9OYLTU&?G@(aT;;g2gs=-{i*$N*T4Va?68y*1tLoFM*x9++nLE>Ys+wvXszT}|v)cJk4ge8?R(HAt2n9f|WMt4D

S{2O7Wu z1l;-HPSX?sepJb1fGjCa8|XJxFMT$$qWJ-USIbB`b?m<`v1I4H_EhAKg;O)iv`P7kVmC3Gl9mWb;V#XOWSiQ|i1B61~KdEP6sr@EcQf`b=F7CFPg5 z#r4Ig$wA&1A6L1CR+b(hsR;c93-gKD)lDIqVr(McVRi;yN;Za?m{B{@&LSz5olb(D0(ozq%KalsyFmTzw|muO=E7Zu$a zu}LwLN%vqS<0#0qdmFg2IojA?xFWt1xHs#sIF4-`mXuQ*m9WDHC5SFF^5c5vCl|9z{Xitr3f4rc$;1NjZ(BuWOk;f!uEPEnm z&3Yv0Y-Z?q1UfmnLnUo#gm0Iti4?cSziACWx-lyx-JxA4o%~_fb0)Fd>-BOy_E(Ng zy|oBE>%+_I(?T^Cb$a?iSr|I-K1cnl-eJlI^tf!{?vg$R#?ij~|ys?T3p>rWbsf#_L}BOFKBUzeJL3l3ZW%PpTkh z-=OFid_O9cGLkC`8^@TsD?lQ@aXIK=|3=zSc{;2Tk59ROf{+k82E!EOzdo-5`7iL_ zSNt^lDs&Ok}q*q6t`UU-{Qx8|HnbY41NVjUd4 zWAtSbnoWKRy8V(M!O4b3d3Z?`{vj2#C32a2!Qm?DSq7K0v63`UqzDyAq_ z)*!ui-;kQmC4igP5=WaoZlvxRFLb6^SNLdC^oIer72N&eC8$UXzAnoR;zD){E&qjn zwKGQPl*;HZf2i{6TbtGP+I9Yspr>moMn2y9CQ1OFy_GLqpUX0ktVvqv8nNHmvB(QVd*&LmR(a6`Ds2jv zx9-v<&KT=?Ek1AOWW412#X$S{<--t$>SC_x6bPXYJAZn=yv^x+(y9lm;ixRb0h!6) z63I`N>ZV;v?UJK;!ApS@r3?|1z-dI#>($hB77;~WfpO~M?^72yTICUI;Nb4%?STo2 zR`Ikzv(9^Yd>j=~CwXFYFcJ@2I#?rR1iE_-Mc}+TEvx^RLM_Q`@*W8cR_84OFh2-J8aW__ z&z^nDl!{G>VylUldQfQe98>l|gQ2}0Uq4$X)Amq*c)S1ab6FqfX^#?>I*Pa7zEg^p zd~j%57vFiu@*&A?2*~yBvtvQR=Qg>q`hDowe?6?inU^o;j;33eeQ)WRuy28k1zFvE z5&msxf~5?>5wTf*C^4d(GUN3+W$i+ zhFdzkq=dMT(tO`-ibh__B(XJwwbw=^&(1$pGirNg-B5=Ct)=|qW4fE+x|W}*W{)UQ!&X%hBcGM_4I?2&+h z618(rfY{Z)SNJgbI_hV|`F>Kl8+;@dPJj-L*bRP0akvCru>AGoMYaTo!mzA*;YzD1 zM?>5G*`Z{g>|$05)4Ba{?|1!-!#I;Xlvk#1CCSegD!xe9iy#+zas$u0t7*>LN6M_w zns(2R-AuL~7mov-V=8a6a^#f04^Whg8E5D;RbrWPsY#Z8IkrAmX~)k*$C|}X`Q!J- z^q_TBeOYqsjpC~!Y2@_WZ^30huKhf&NWboU8ko|s$6(zULp*i+yTvqr>8lopwxR+94I!>y66SXbBHvQO~2qyBcjrge{fv6=A9i zU`@lAzNp8x-Dly(QOBX)xl?|VPm#!iXFY_q&h$k`Pk|aceF#8=kfVKpBcJsZ;$8<^ z8HiLwmpnF+fRCz4y%H=hFGiDqc(d*0%?|XO-7;SBYhC#0`{hIODRak@U-!ZQBE}5# zdenLzqmLK$X*wmc!qQlMG`k2Wdps;N-PZ)=(&g6XMHDfLh{fHaf?r`$B@4#X7=ndP ziJ%F8JfbzqAQ7Qsf4e5zV*0@T_(%7;>Y%>^h-kb;N5f}-cFtc?)L3veTwHw9L9^Rz zNr#@^n`sSrF*hQqf}#$e4TCm!aZ@a*nNYw^zOU+xMNk7;`p#Y2Ac>=PrG!@w%%v+^ zKZv*lC0LUSCMLu@zl2kQ)DZ&=;`b_z{YO#g$1>}cfhk>?0W+6<6V05Rg}S^2xV6M82cM)tvdD-ocoRFCa*qOWxAR zi&}}bvD4!6EfZi}f$Eht804Vgf4t)*J5O*$mk*?J9ZgoEN(=OJWC(@Tss~gX__ty5 z)+NNyGrsxi5PK(@eo-0|l1d``a-c>3vO;P--rvXzfzGbwc?F#BShyGM%5>4#hQ?H7~m*zutJ- z@rX*yrcUOl#miREJc?v{!&Tz@RJy_|Mg0_Fe~?}u0A=OuweUninJ=}VX!A6 zz}C+5>(SZimxIp@wKE#p)?C*HMp|bE^6%Wmt_vn@_>Mj1M)<0F60kpmgVtLmPwY$6 z6px?O-M?9o`TpqMCo=X4NXNhon8Ob3M&I#ohQPE=6Ff{YTMb!7FRxW0MZ8U;IExc`1pZtW|0;UB_x=r|M|!78tsCFv{dtu?!rv}`y^JUS@z++fxk5bD zSVfSraJmZY4r2EBIih?lESb9XvC%gOE3(0j@#im2VV+-FviYMT&(Qjwy9^?flOU!Q zU$19GbJUuK_x%?5F~Q-}AK84X6DGrD7>tCve4uAS1@603xUc#-K#$uCyWrlvT$dtW z!0Y84q7)RdnYuWRqG}$Rq+M&-`0e3sEoNUtEoG6h**YrO-L|x{?KJl1sO-17t{{yP zJHUll+TxKn6^TF=oM?oN&Ml;o9ModF!tHG;5 z0K%=mVYzkW-e2}t6ur-QGtX>pZd(mRo+6WygbnX=V70m+AFUH@-UZH}5b&-wxQI~K zD@3X27l(h!9Pc}u-tkIPJrW3s*w+ucjx3Y7aF(4#7}N~4X#ZpQ*RZJVs=~7S zg46z6Pui4N*MT`Ao%@gaJgT!)xwvs(E@X;e%c%rJ3{Tx}exzzOnrb&)_TJql&+N0_ zZSBhHf0MvviM@SCxwwpHM6NhII1)g{IU zYSW#&*WAJ{Gg^4o^o}>7+glVM-7U0vmyyZ1=qid61Sh`9Od`kd(at7f_!8FC)$WlV z)s(3llf=PZHMKgawQ401ipNDqlWQ?s@YT@Mfl2`;)+WZ0WmbHUUu(QDw`RwaUXG3# zYHbFQGF{3fCf%AydQ2@K4fN4O_*TYB-KIQl&#V3CVDE6NhO6X5XS??>nb2f*{To zg?^yS+=n00eRy*F=c5r3yE{CPDGqGBKSxd zoG0Zx1_$_PLhfQWmB~zZWWXtsUA?uG_tsI~ z=oJiR%8NyUjY6WOV#WqEYGMpG*It1LIl~MRQ474K6D!9h^Qcb(rZ!Gh4JRg(ri)adr~B z6P2-<8L`JQl6XJ9I)pF&z>Mdc8f~(0ox)Gu*h`!MAI*1%8TA!1ktpvvz%FtOBwzDd zS9Ft3DtomnIPwXrTt!tJh*3mCl){+6lTRv9Jem?cH+%YkbuD<176J72eTr9 ztysy>7WYEWY58u{)wdjR?6rd`teAMM(N4dS}?~-{$jW-GYb}p@8v``B0E^HCCQww zMw~lEpZ480m7DlYCD<`4WQr2ViWV4K7AI4twn!_`-1lto=kHzL|DvJLI%r4T>9;Jg z51V-WZbyp6oM%nF`@+)(a0g4Q%A4=_y^G?|{ea2wLC%sUx~$MVZRhb8I9YsJYp}CT z$N+!66~Y|qVmiPkKho&6o7qgH#D+=PEwQ2lda z+VV~3BNrEsY{me(Unh5ZM;?6|L9lerk?KmVARnT{#Z{oB01ZZN2w@9373H5OC_wZ= zAY}!qH2h0DRom{9T!q}94EItE_sN9fq)r1(%XOp<=Dbh6mp?AAeLa{SZF}U3E8?aM zboyFOjV*vWw-$17rw(CrgV_8{k^lQdJk1`KQ%Ny(KcM_=IZf)YtNW+aefp)-Cn;Di zEvQs=(Ay2l;1D*`7~CKPz5zjSX>%xZ6-_8}sHSZ(^469y~e|@;SFK z>h*t6)QptY=Bv3EMF4}+(bJuo(DOx{^*?hiA!E76J`?_>N++94l8aZlvzTJ#6F)tp zK0Vz$@y(=@V7D2FT|-llFAtTJiIW-8(6XkNDbq&Mcj;oS`BG|0Yc#CzRyc$^Uu9yQ z86b@rnZ(SXPE2J2gV%erP2k{J)cE*@h@!3z@Z-bD-Y&7SeM58YMP@+9VpPm$IA?`I zjavuXUJJE*n}(vQ0UVqzTx#s8YLF!5a603Y;sbMqb0oV#;%7yv6SeS~NKW)*rqz6m zpmC-ZJgKCym4n&6+@%bkyUMmAiol|y+tCZjHu7a64eBmSt=>Z|t#^zy%w-T=?}=@- z#>JP4q)54ukOJ|mqT}ASW*Xj^V=VYaH!p8bpGGuZqMp+Nv(n;)Zt3WVu9NS;bZ|`9 zt;jc`>%A>RYdX+nUAZM&m%T zGCr*}QM5sh($;NV3eCtyT9Gqc6Cg_xGD)hyJ9U4$df5@Cy$cz52($Idt*~le1+qrD9D){i_|fPC@E)Eb9MrxaMaX)@WqSmsEJM1M2@^aOlrTG4d_YGYa&X?)~q=2l6+qbAgNl`sVaZxt?| z2mG=L+X!8Jf4~op;=@@9(K*Ws%5@~pN|Q9os4YurdB_UDg%&F7Js8>9E3l+B3uPwL zb>JRbyORytp_$kb%A_hDT+2`_QYF`_u}{>6?Mr17S2vHa(jPvxr_Xray^3*sNb_I) zXH#}-htYS48-MZ$S8ob}p33A8QGXgC{>VOEI+GQ}*xAGQ2{;0Ob9VBIF(=G?e z=o%S}yfzRqV2b>3s=$Q)j zBCj6kT(n%+ubT{e`Q)q)_Ysp}o?QoJ{JEe`jAU2-<5<2GVwF3Z1~(BN(4(asiFy6! zM&VrhW*{XtY28lZh-i+?n@&Wr=7fN#O!aMBOw75kAQZh^o{@2fq+GmDn7(mJ^_S%a zakD_tJJYV3k6ee)cQ}|pCanEwXhK0o9=&%5#KFkkv|htIFy%}t&j50B$eU)kb7Kci zLgdl?&DFv#`3jg21qCH}Qy`F=W>{ED{_YOyz5J#yRlt2KU&{OI$n>Z-$=E_8$pqHB?x8USYaB9l$jR^rkVI1Z4#F2ziD^EGsAG|!?2VWCA zo77a)gn#z>7|i*WdXo8f>f_D@!t9yF%qo^v0C@fMI{pwqC`ydMW{D?*YZ+Jot>EZl z;wvoAottulI2GhLpy3BwO3?7b)?q1Hcfvv~@Xf=QJ87xIWI-88V4~RAXDB{7iqrNW zj#Mn0Mk&opNN<~e90{DF7Zp2#OOrRFW-8=RxD!F$a_Uqdb<}2J?DA+^MgT=*MdDou z+-E@P-@0y0XN1CZ#-4$J<#3SS=bfGjFsS!gFb;n1hw{F78KFu#hQ27mW?tUS!kkB^ z+oD=W`FMNz>3$l5%wTLhBcVvD^RY<;i~8 z=+RmjwYrl12L9Vom9>n!6Dn>~tSTXMr&1+Oj;VjlyPAF!!RGl8_$B5Hr^~M5rGh$A zfH0l0!Q0R=^# z8}FY9x&5E~1MjkRT9HTLpt|rhL`KCbgoV;1vy!P2q6gO!g&R_J-oq8Cn_!F z1EHT@@-O*6MQBez1B3lTQ-?koKB1p>8BBucR^A!226&gQEw^cpLERb~yW~gJVI)*Gg>)t`VApdpKP-m4uXjTF8z{f^g(7jk7pXV#KH6cwQ8>39w-uP_)m zyn{-M{{&?6M?HO1Y8msZ_-PaN6M4YM34BL|R=O2xO0mB zreZ|DR8c7ib-rQHP%YDd=*5cjn`l_`LkLSuOpsbI!9+b>OgbBSc}GD_A<{~mNh7T} zo1vrzLR=#VuE1QJUo#~~6k)7!S$l7V>3I~&kNoI@2AVjx)AxjM6K;(NR zOQ(;f(nB}rm(l6f$U|r7VkbQLEoyx%7^uK5h-d){X8Zse^Pw#R-gTPVc+7nWLe-Ri0vH8%u)GPmdwvm2W-SfBYil>12C9Z4UU8QTj zUhZ9Cg%Yhg{Z_sCbIMQ#fr+OtrH^@P5rsT0Z3|pQ9QV066cv@^L%CntD9QT=yTHP~ z)7({>6Ead&cR9g^E(h|EC45VEe_Da_TzN}sfXgh=d9QMhQi9O>V_G?}U^w}bJ|-T= zN1IdH?flq-q-irWx^De!>yO$z#zGBnJ+64S6i#fWO!UDZD_$4$RQ!4JW%BKl7h`=A zksTl#+N@TP0v20?FZXFj+M@6)@)8^v32#SwIXiB}kyTHTMKuiDwpFbF$h=upw3Z(^ z#?|OAn$KWqt{zCC=0l@9$G}{z#Yj{ts;l&iH0g0>T?tO2??jtHo6Z^L5Nl24eXwBV z?jPD|W0K%nZE0JdijZ71OdU^GbJfx^p~mTF57nI-P`79dq=U^&Rm>r3%J&szhREkA zSU{-=e>jUSUrHvDiODe4AQ>F;bEQ)Y|Lz&;+TyWc!6p}E+ri-DU0?fT`z)=pnuT7La+`8b2~Kqu`629m5Q}j|IfDjHKH^}0>-6hI zKPsr0#tV16NXQmk2jTXJpAz5U?qHREy*++?1L-6&fYvhC)S=Qm*rZVz{OlabB%bP# z+Okj%1Ra1kNYLz;&^6Zv3&Q|r$t2Zkj`})~?Rj$9KSl#u)R=BO~a}TYSENW?d)2m3a z&TMdX0FwCp0&|qBB|D4^j^6G3PJ71YdoM#&cQq$nPwztn%N!pl-tP^Iaz??@(qS_j$III1>6(;1xG8;e zN?nF4)k@0F=sfqcyot^4&nu?2J!Q(60kbbVKd@z!^pVnibtuYT=%BN6A>hODr!ZSI zcv{tzj5KPLqT{V&VG=AF>Sc~u4=5T<{+RYw+O-fRbu~70oAe3ijp_{5nVJM`*$9@~ zI#S6QzbX;giC9c-wrqsh0KgR$%hT%Cq+Dp+@h3B&}JHZ7@9njqQ?;#^zT zdZ*t)e@98ycjlZb%{cXy(NPeme+DXMWIDYWlyrq0A9XUxv1r|=X;;W1XDQV6i-;xg zKb@~?Y>$Jt2x}oZ5t%?!n6b}$LUl1$<}jACgxCf*&Gq?0N!J&TWY+Q^Bs66*A{8aLMkR--puWWHTm&ACq@8?HNhK5$6R{3!lyqxcL0cFpB0W7E4-`5p8 z#9fvuyPj+9RIOZRB+2;*wXysc19lU&kr1yHWS5W)-n3iJZZn>l8=8p5R6T5~M%dGH zBBZtJtSH3XO3LPU5O(?Qt6J@N1jtIaBhz?j9o-HW1yw866!EI^Pb1%`v@je)ri z^R^ak#szgMTDiG9PKTm!a%Pd}sd7O4$w7x)MQG8F0q#gguBoh_h?b z3rU5-*@DfZSDiUssVvYHLi2UD+TU$0q`i=J<+i?ot1we*3`yu~OYz0$yA#Xq>>@H2 zvCUKb9r%e7WAAK{0aq8Pd=G3Ul7d5@LMGig-NQV_v)pEAWoD%gB803$ui$Kb+K9!6 z;C!nTf~aU&c}7lBHEOw<(6hRq2#4Xu(A~C{#*S{R=SruGUmyZeDNiNO0fC|PtmWN> zpzSRjE-v6?78xpS-EoLax*LbAtF(*@YE0gJTq_ZsTUFW`EuIN7LuASdP1btoRSk+V z%I9KC87f4^-K5Ms+&#*SH6YF~90x;;x`ZY|N*v`5Lg-GQs@@^|=|#n%l|neP0=8T& zn4HE~qNzOeu688RmKCb1DiBFYHHuQ9i z5JDuq6{yD+SL!Y@=7C_K5``EqAu~94L4 zGy>s@GDUHU#4(cyeOz)zmdu<@%{_o|P`nPB%v zLj934Ad;7K?~S|qH(TQy{xBv*WuQmk`gcM=Kuks&0YG|r^v(E=MDH5<5p6?LEddh( z1x*8%{^c-J_?5r16|J(ASic)Wr}br?GA>hc;6?1wyW+wRz zi#KQ@>@=`lo&f|Z_@Q16X8brg*H9?lu@-#pst4tXu=LXP`yHVBYB3&-W45?~` z6rpFdMRRDWjW;b;J9iI|UHmg!RVYeHKREUhD!I4WtR0oedBgbheYD@#6yTC=xI*6S z%w-VTo@%ygtW1U31RxILxyOYA>2su!B?syXZ;0O7mb=v6g&qiSWEGa38ZL{m(h!py&q*LQ_P#6A)JpY+BJyLliPB`#)aM%Z1 zSm3kKq;&}B!MbYO-hWnn5Acy;O4t7$T@?O)s_?4hH830+&QE}9vfUSMKY!S}`y>e@ z#rH7mFhjPG_QrHOp?}KHMO5gzVMacZj?htwy)3;YDf<=e=h$AEz>jo9uMU)G#mqy1 z1|Jjtc~GjUZHI)1es?$d`#WsAtqTvTn~F|y*CoTKZ~a{V)uRD(gC%ZU42Jq2rfCSl z%nTu4zZX_}mPB4D&l8i)@5reEc{-NgY-MQ2Md8D$c=K zamjEyvNJOVrtJjUA!g?T#1qQ~gRtu<`q{=vd7@}*iPJzj8lze;PAao@@qU^C;aYG+ z{I;oN95ZXACj51}R#|jX9K90#4B0R360;R8*t^$%&%|;+5(8G`xvQ_DtrG7@Mz9an0Sui@TIa|rJK%UCvw_=@B9RNY3Uqkv~G+UO3(H2El{Dv zW^VSdKy%%>34d?5?%#yJhEjibl?=oyMni?^&bqcATGx=I(GlT7g#V-}?_+bEmZ@ii zzHAp{H$CnV5+O_ze{K(C5E^FMr&9)P|DplSMRkmS`D|4?ysX2to*r)H&dbD65d}#6 z4afptnhAy$DqPQhu^mY0$#=-P{jv72GXYuLAi4D&xB2^6y0Ut>_Au>R@{7;e^T#rc zk3R~e|Kjv`hx+*qp{jg~ut)(}Y~^Ym8W__KM5iS4i85`aihELh|LNPayB2Na<(&F6 zAWuTEVaZ=1So}dP&*{7DqT>GsoMvh!k&R%sgq8@Fy<=jWiP+HUKb2B24D+h0Q|Rc) z5phyc1Z#U$6aS02IYC71dV;`p-rnp|_Ym-Pi)YzRE%q507WU6PKp>t;|LBZI_J_xh zXG6>1i^Z>c@Y}K4OSd(a0;qQ(Z6k{&>jsi-D}pclXu4-7ul5Q8_noLkM%wC{-mw_L zOr9r25YmMzSM@61N-uveI_WaHqBpEHdv%n)WBbIko&VQg9c!Q1 zV_!$^m5nyCEM0+QwkM?0$>*I`xr5`g;(xDwLVej+(qHRfm-6A$Y?-{-+D?*_HBPJF zOQ)rGKlfH`^LSN|3QHGtKK<-(UL~3xORT=m1zTSzrtq!)mZ|o8Z8qw<YPvYUO$5FUb4_*B($H>Wq`=cbEW6ZU9Z1)KiUWKZP12i;&5c zOVJsh$48^T2MH+14mq_Pm-*;1)>-F<_rr}*5WmPL|44vlizl|%K52b|)3n*dA@J8j zBAU;(7nL6FIP@Nsa1wKEf^Y@@hPVjOc?HJGHDEVhyRJa&SX=RozwaFxFZ;zf{6(f$vy4)4H^236T7e)`Aze_WlVSwEt&`-aC@8u9L>F=le7$m-(%0oS>a`k zGTdywzsJs)uG#xJO~!ZwC-VE*i!s~xPZ!YJkRKBUXmK0;!B>)XPs~CXKGCF9^WN`c z<`|{0_IOJ1-E&6M>no4hrBEVpiwt^^XRXaU@|kFlX23>AB>ux#{JkxEQ|^on_G)0u zb!9@+JE?OD$v?MIzbC}JG)0DC?rF4}Bq3=W$6*OuA1v@cTJ}71CULITT^lhs_dB99 zUi_MQk;WnTHr(YwFn%Ie0@YL{*ZX5{YP7UJT~of4H)KFU#rccRXP)dFYUyLBy|%!* zfc+!qiof?(dEBQ0aAE4T@1Ax3J%G7NUIv}bsK8nzO|-M4t)k>3_l!HLrii}z9DFEG zems-hm1*QmmZ-B2`ISsAA|v(d-=~@ba%wu#q8ca1Aj<-p_fjW+KRUd77wzDhb3s|3 zcgSw)-)3&JHIN8nN6bRlQa-vm>~Vs5@5*$qEeE_={NLz`6lF%-&-RqU7ByKT z&A;Apx6Ce2=Cso8v*mk;HK2B!iC$T3ZW5)@N{1!Bqy-H94x~|%@~RDZZN~Z4ugCEC ziKONMX+Y`=6t(f^wQb#EM3y5}a~L6FgEW#gk(m_V+OzV{g@)TRJmL07F3DB3>t@Agg3%*a{m%>M zm9h~T3<(`$&yQLa;=0O(8Dd?7*8#F!b~@B^FNS=rwVxT1)oke(3V~)t-DKLQ?{y;2 ziX4j-n;-N}TpIsr`)+aZ%+ba)`{cO_#k1%bJ_X+{<07xeancnlxyKQ%9rVu346`a! z!V=TlmPNGGQM$T&ZM#R1%7xFeaeL5nVGw zm(XQ5Uw~O81wo}vY8#kK;n-$bd2XH2_V}5-(!MM`>#H2^>Z~c_Vi|cPNzi4vUVB9ui-}?T1 zh=>@KCsFp#_^APWet+@bqC-TL^Fu89LDJ9jryl2M-ySwzau>39{HJNpz4SF`KRh@1 zH?F18CS&ft@u;V`VcJtQo2}j2)7&bdKZXA1LTiL5VJRSqY?y|Nw0m%Bj5`QmgK;Q% zwr2F-axHP}_hE@-+B35U_8E(Wr(YWX#1VTk3o<)|FjMJ8NjBk!Wz_#dE6Tq)g_12i z%oV(68??1USZ)3Xn6rHEx8@a4r9N-uNU^)(S4vT0+MJK;Hudd!ZBhqw73YfA9{$i$ ztxfMk(Wi@E3b;x@uX2!N|b-8Fk-fbg={=D#O9)wRE@ zRawn-29ZoIYQzeToAgs8BYiJos!Cf(DfDL;zt~CQJ{DoPsFCzihBj=KFA7dJu31ln zpa0P#yr!(E#%jzl2+tG4%?O2;pBwA`tq>j-WT{y}DwH28(Q^I`0ecmt*oBDV`nbjD z86-4(dOCJ~tX!5Svy6JwENEM}Sa!dXoOLk2Y9zDo?zIhD5mC7!o28wKpfCB>`ckFqN9Y-8!1v;MAq{NSSx*8Y$lTgjPl(08`;zpE9|yT z`moAqj8ePe1-RlD!-gD`!@2XtTT8K?_X$7U!s{M&DF(1z{k&x(wA9ehWeyG>30VE& z_4gQm`+DuVNjh3G%6bi?OfZyh$=GIRu`U1+6&W148o^;O_5GnDeI?uMq0KU7XQ?c! zIK;9rXF%2KbHIC{xr<|I#*4dsXiVqbPP;Ehau{~|846ZA=i!vFw6xe)jZ`)z#&cPv z<1=e44~Mrb+upx_jipbKo7HU$mL??6-+NejmgP>J<-^Z+sIwWz$~rA$j>^qqFHcs! z)@9_0idd3Wa#f#7_WL8=#Q?Fue_Ua-eYAf&AHkC?s+S|w#Rl}b526qV{QSk?z0SVv zOhj`2@Uh>){J-aRCIPz4%jSroq9^YkhS(0~-ERu=+U42!*4a&o=I*$Bn6I)4W+*St){m)~1#vyUB0kSJ zF532_S&xi@)o%5WrI;Gwk1zP6;DnTsacxin4bO|LQa>6B0+mOW9Y&6qV#NC$hSt2~ z|FmL#Xp(L(!(?}RW%|an_*j!)Qn>Lycx-054S3qLe$5o@_44K>8bu`jlD(sm_@C`+ zZ$~^6rpa;Z=R5l*jz(sm#sXo!&`GhU%6N12M`3lg0FAxeOyP;proCmSMEzOy5<-F* zqHl`!lx;6url#^xHGRorqznK zkkrQ*UWcBf6YaDvf{QtGt6Wko0=kX96(EDfC_2U^!`7!ACxlLCgT;6g02tkb+d9eHICkf&-~qn-iUIRncYW@4@*JGI+mD{CB%sf`owe_1_do;g zhmfH`qami1OIwzps#281Wo*v1NW2aUITb-8wg6MQ53qa05`7OxK}i$9D8I*cQsj`Ni zrqlrSHq_L{O-7!h)NG-(F%KvW27vVgLrpzEJwrjD0000q13&{nB+^L;Q)+3ddqGC@ zrcF1h4+5LjGHJ9;9--wL9-1eq`lqO99-w3zG-%pD0D6D}AOk=E001=50000FP-&s2 zng9Sv>XjsgPt^9Rc$3LLNKF`?qf9^=8X7b`CXJ{xWCI`rMuSX-fuPVd(V#J?42?7x zfuLdrfEosk000dQ28M=)Kq8bOGH95YGH9NFG(|rEYH5OEX{IKO(KMQ#Owh@J162Hs znx}@En@P1cLYv7wQ^uNVPYI?pX(yVSN_h+>Q}rk00h3C2X{4T0(*h@y^u$dBNg@O$ zMw*6bqxBcXiC&yL4`@>2mFN92sn-p>0`dOH^TOt(K*0ZMob#v~!!HE2nkQ zt_aSdE4od~uDZG|>g${bbmw-ul5XjB5svGwNOtK$S6jC(o!hR%cUKNd>AB8G={ud< zu-ucoxlZSHyU&FcHkU*vDLSk7t5m;%?rnUz0!6%|@R=yJSr{noNm{^N6Hzw1VOifF zu4pkec0^%^6-FJ)uTus~Wyx#b983qdS$9!ga?~pgRJMrROPJRx=O+#rZ9P|Z8LP() zT5Za3)HZej-9nND7!clRUM4MS;w=|5n9YF3Y>-el8kdu74V{x>w@E9Gx8_4k**0s8 zm8p$PTs4@@Y>P*knXTJo*~GyVnr3R_wRMn{CEoD?QE)_VC ztV0;K4*lBF%c)_xhGnctry8FvnJQVA1$#zHY#Ok4rI}%+mj`Vy^HXV-g$Y~ch#qGo zS?r@{X3Aj-Biyw-CR;v9s9Qrzkk%^GOJ;^rSXO~uQDJO@scy{Qqg2~VWw<$*VVQ0^ zHJPmB-*LNbjP`OzF3!&m%8Ls_LabA?!oc^Eg{o(ziFF`mzG!>aOE}~VVO4@fnVM;q z6jm8k6-tF3)I=+_)R{8Qe3;sdS3870N5<;IlI&UHFBxK`sWK}@Tx%_3S*dAi?yqRH zOk{Lxv@w}q2)Z>hn7!!8wo9^OnOm}0R5$AOm%zxfHI>xGI2>aGj6=$05E8OUS@30j z@+H)}mtWks{y)hdh;}HRu1~bh9@#0sxbC;@(%O8)760eCfNqOC&a$36#?0O%*F^U? zmABc4FXSk3-&0++31L{0^7F!DIKyz9D|N+#FAvh?lCLAyA~&hRFcQS?dyzpRXCXwWJ7lRE$1F0+7_8ey+$XiZz99c|S+m@=PR@#MH z)wxV-MkZF;G#4<;M7D~wTDgH$K?TZH6~;E&RTWXTjI^e^lbUsho6*MdC3_2z?XPD% zUy19n%T`v@tp-yQH|vz@PNY!|cP{65GH$z_-8!8*>~YZkR-9R|lAbJif;+2YD9hOX-=p~S57Y-+j^{ESA4!HTM zWeq%jviNfi9Aie)CQK=FM^`hI6Di4e7USNal|-3V#Dx(I7Yn*;T79#ZUG`_w8Pzb! znhaF5^3Bd=XUBu+ej}|qoAK4RmDOEU-{&{HD)+8bPf|{hD_xOMQMW4hvl5rhIJ2L1O|{+jR>3-GKTTsiX6|t9bzI$g`aOrJQ?lG;-P=9%$cPA(inHj~gH3+@y!Q#&Odbb-0|=d;5F9*s-0^&O z0)RyjP$2>gF(Lw#8wVglMMA(Lh-`oW0DzwsDk!Z8tafoxx+7#oh=RdDAp3ZfsG$ZR ziz%yGqSmWYrIyL5Cdi=}0--iE3LO{+0TgV19t!mr01^PfRTv~dAQ2T{z#-6MrbrSU z&xPhEZ=St{7WvH2L3H0kb@aM@4-X;5x!fyvaF({V?^Y^+>`K8%6p#S~TbvVsYvBVA z5{QZcGKm7_;ZRm}#&upwYRu7goyx_w#@v3krah+zqcf33MN7;GDWVK)83__3sx=!1 zDIy9&ii%AYlN4SZDlBhG_%`(0Z!5{5#*GHXG;D^+Mk^9n4I3FC(Tg{0$+hNcxl~nN zgKKo!(Q1;ZHpaF!ZRjg<)=jF4)p;$=wMDjhaZwv45+W2bNdguKC`&E1;mc!VV%r-O zWYvojQCOiWDm4+dHAX{X)LR&>8yjv~+f=*H@o$uvto8!tY1XWo%*PDYjaxNyS}wC3 z%(|`_th;S;>gLIE>orWbG?dj*&0$;KS9sy&&sndtXo)OI9*cAl2_lf;t{(Zm@m)*A z>bf%E(w5^_R_g06lQT@oRYxw9Rb0(cy3A7K)@ubFIdd~kIWDnWZMmF>dd+Y0{YOi^ zY1|l7M;+OrSRa4P9dT)g);)%_#hxusdTb&Uoo|DsG}Q{0bf>uMP|g=*W)*6lUkIDB zK=f3U*C`>PC0MBmi_G4`yV?+I6N3=pXTWF&F6^+3jN?&K3|1Im@)lw6wh~^MiK~L8 z?<_rtm@FwN6(y*6wG6`CVX#(rlCF_~Q%xj}_Ojq9P!ZU5_tD1@1VFO~89-G^j8Plc zdgrw7J#RZ>Rf`lc?@B(NUsQbStc>jL_A} zQPsHW0I&f-76j%pNzH6pi$rL)gI3go$301zV`1|wn5I9YnOJ8Zl${Eaa^vuvUPV|nq2JXTrhKT zInGY*blu&u4s^R*yR>t4E!Rtm<#pYYtGevc=VvWxzlF4kANi3x=T`srReQ&Mxp0}K5aAq9mI(J== za^oft=682oK%Lz;b<*piL!HaH-OTh|yj{-jolc#0IP9CQ?s1*Lm~))z-F89CjF>~2 z-Q95lcXZv?ORk9ycP{63V~v zQtwEC7y`i05zip7fd!?K$t@{LNogulw3bq?rFA5vtd&V@m6EKfC6bh^l_ZvuOC>C~ zc(&e6s_lCJaR@||NM~1#wNC9;?O$8hvTE9;@`yzgHejd1~2JVIfkoq9BG`s}?GA zcY?0UEL3b3?scy7-L-Egg-H-2HBrsYToh7Dn%goEnh@2;35>=H7{I8dZj@>@zf!eY zyh0;nHMP6PQzLC{C?TY?B(P`V(y@k>%f(IG}Q@p`@P zRjpBK2(1;O#ba%Y6&5kHfuhl3$)jUZQL!+?44B#>0!w3HqzH`|&}lSihLsRfV`7=0 zqKYWk)+nj9s;MJPF%6qE#>PTeGZHkmrZh58(X&BXj0R@gC~aaZNw!U3fe8p6H9QpS z@>H&T6E+YDt@Ude*`E{HFNKhY7u{Q(NWY$aIiFoK{c z>B}4O(BezQ{E)n{6eV$uos2)tQ_6$u?k5H3_u z!Df#=+Jt?{1Ty^*gZ&3A%~)o8t&yhGX@I{P!Kombu|g^+L?$m+*zjz5F@nARX_dOeG*r|uh!xNW1!*~&N|%VYsU;7V0{}5E zad*I&Tvv>wEs`L1Q^*XYDRPb|X~uYgO$6Bfwe^RmG9e`TNHih<-hlQYnUF$MTT%|O zpl7b-(48<^yac8KB*EaT`Pup}xQHhT7f41T%$e12)aaUQ2(R&R=WHJc4b4T0~2+~e!zE~fYBmC0&)QWdh-E-2!D4VFU_hY(6ll@ z4vRCR-1)9U=;1*8;pmN){-$zf`;c{Iq1bd*w2YHr;6CVd&C5Zr<~5SQ^TBv<0285K z=uX-eGfor^8_O3`f`2+gyaPz$LyHZcS|50MzeoEp-GU|a7CpL16d{1dlIsAma>BBOmImfQBjOR zlv5x>By19vNkAgb)~o8jbo?8|zlCbPX4N%R)l*e9Q*BDL5JC__1OfyDKo)wQpHu*8 z6>t_r!RtM?_b)%U+Wjn&NhGqeQc_7}NlPhNB&{WCQl%`FDJ3dWlGK%HDx{RGl_ey- zeeM3k(|SJHs^8_+Y+@khXk#p(81lw|MBCod{7Qj!ZOXX(Jags}z`Pn9(T@m#me?~I z5m68fET)&!8|%qHh6=ja!Wnr*;(m8c;)~Fld(i7(D0#)NT=E@~-PT~`7y!HgPntN> z#it@&-<~Me2rMvcIjBZR$@h;I5Q0JkD7a1M57uAtD-QYZxf%S9hcA^L0nf+}$5%;R z3l%sR3}=EV1LJ;pU?p1HVcb2(@T&XQFM2q0wu6kbrV4Og8aDFn1|4R^_5=B@z#3LL zSP$MlZU=$`nC5?oT)4Wtm{7Xj(%(c$5=SV&WrTAi4*(2hffTeM$%=En8z61RhB7KB zbpm0;ZAPe{1UA@|NAR8XDi@q+>Xj5M;vtr3bg;uuZ~G&LsuB?VM+=YFI365B?eL|H zr8M3b+)lk(HR8+m{&=#KuZ@(rGi-*0>LQC<;J|02N^69gO&>_RlwNk}14$)J>^9!O$fE|x45?2kzb79lAaQIT#y$tg7Q(xaA^yvYofLQ$w> zatf4U)d2{IA_Ry7MQMLrC|&*6U|$8WOuuU-f?2@^1oKi|fSncAh9n%{vysa1aF=Pm zIcNKugd2v8t19Jy`e#7{Aqk}5Y2bjQf?2XqCYA;?qz1vUgvAyyu$oO2Sdu7+iir_G ziX_R936dbOB9b(bnT$zLd3p8u56oW?^^Y~}lo~-4)$db#@J(T?Z<6x{xVE^mf|v>{ z;V>84j95%TaDj**@jcyGlqjKqQQImgST+$;C}qeHLm5J}3>F0$cUUN>*sxs@xFiap zNB~7^5Xx+;1kcF&bVUC2<$V9jdcZcPk=AH58OGR*Y1|idn2FT(+uu=!8}X2~6COG+ zIBu~86ggh^EqH)SlK~bGfJksS(%u9Eo%u+ci&m7PBN&Kv+>(@#l0bD`bTf6_kdT*G zT>@Qh|GnMx88^INW(X-Z}Uk_42bnUdgqhVrEOMkD)Qb~ zQiPI8B!-%18JcKjQkjw&lIyrgW@(`zA(&?KTD(__#4`gh%qdATGYrhaNhC7>0!aV~ z48oPx@wMZ4!e(A8u96ZG1uLz3K5tW<=xupgma?}E146iqiV7&QwiVqo_S1etA3! z2&Wu{jN&jPAt4wLj0C=n~T@X3N zn}Vt;0;qzD3aCghje|*)NoAA(@3ltf31fQ%O`8 zG%?Yi*TuHfA^k_i9+STf1kg}6i>(k%8Z;)xXxR>8PsAaYSrOV(0+LB&|OUhjd3*jZ6#s&agK~FdcA__6A zQk2O61h@(pVaQ;jGO?v7oLIOMYLN*RA4t$Y^d3mGx9Jl;&=fdBFx=E?*lFAe23Sdf zbc5?gvusQesxH>NEG8l#fLL&JEDTK~D;B{ADai#%F)>S+Ck^Fz($T4#GMm))7w=ll zk`gjTMp`7v8X}9(?W>k8je#p0QL%$)uwsghXecc0c|=}$dKJ$au_<7%$c&{hr7$>f z>k7Z|_Hqe1#$Gdd|MMCR)y`(b&YN^XKPE38D|rFdw{kh8Bbjm zat2II1Zof}5)E3Zs-T0#HVo5Mo@T{fjdYxOGw(qTFb|TZ6r4wln1v-ir$116Ut`z% zIOMvED@El3H}FwZ4IK2sC6kYf`~Ke%&Z&gw-R#-jD8&NO5f0~~-z8pZBL*@e=<8Z5 zO-1>dcSYu}wT=ay~aO!{B@(+{JoAo)iusBj? z$*?-7?&I}yNVsLnwfFrD4n@}LzsTR{E3Nnr-+W2;HdCI}^giiR39f6}FWh0MSt7w{8dKX#0o4e!1-uN9B{V8r6`*P#f)60X;fSajs*D_&M z{V_S68%gPFAfI=EW-~`0eS?T5R$Q-ElD^UXwA39e%|*pA)jAs8g%bKu!M;JGZ!T;R zcVO-X@4epe9--22U1-{({@>YGFR?09+UDQM25xoETJGT0FDS0_F#Pv8Wm@5?YIAQX z+P|~XSWR-PagtunH8J;1YA%w_J5e_|L}FPX9|2X0Xil3m_h&?W-+)|S_n7$X`4oEV zml@)%GgKqLT>2d9d)6-uJf8a1Js z#fqS{C?a)#kx7gc(^#;4F8>c=?5}Ij@!S0&esjCq*?M2gPrilaUHgo+Nud|_AjPMN zf4073NeZ=X!jb=jqk|9LO(8I6ygxrbD-IdO;f>o^f?>=K0Ai|{M9g~o{fet$(g zy`osGQBifBzEvfvm65q>Z>ZGA*i)_9!_%1Oaja$=M*Z@xD;(=|3@38!PNBth>fB6X z!%gigYOu#W9Rh zym4@P`nJvvKYa!q#`gVUNk+dnhw%GPA^B|d9pbB5)=Rj*Asz8}=}f!4pmha|5icuV zwn~*FfmvGS^3%7%^e(lSFstVuFTmyVao~lqXsTUP&&@EsFZwBYhO&8hf$)8^bn52f zF+=t%%(*<~Mxu3>wK?AbIIcX!x}=v;*=U-cr8FL7>?<}SRNZL2sHxCuE&P8X6O7DB zitdw^T3fMGP-)nohxC_I>l1nSyK}d_uj`YCwTMo3fQokThPLAC6uS$KM`zf3N#l04 z1Z(tmRT8gPpFbCi7t{TJR`>|Df#?_?n01lL0i@>jG5iG^`Lq2Y{mvdzv?{6jVDvlR zJ7XYR2qA@AKE}`v9SF_I6EukZ*JK{keEcfDj%MECbKS1=dSc(B63o1t)LxD^E>nwq)wIt5*Wn&{VwYNJhv@yqm`Bv+-CUHDfEVV!JoP(|rb0KZI=V z|CPNd@7^Cbr*kKbY{np6K?_~aN0EXRG0h6yL4g9xT>@R%N5R0A2Y6JQxDyPNhM%#G3${WYSPzwHVO`(nhh8-;wyA1@peBS=E6s zLM$jD38*$XxfgkNw5Z{v0!nhi;P4@@2hfk^I=VSk%vD>)+%>DU){lTC*{?RV+>i3FNN%?*4leIlxSi;m`ULE4P z`7ZO<{ZDq@SF`%ZTf0E164IhuT7^|rK?O04LX@r~a;i?@+A#He8HJ zm6I>X)AxJEEz7#%?WCKB6|C2J?niO0UZ-KGE*EJ80OTkJ5O8JfXXmNjQJ&pXlg<`Z zk)X}nT%Vv}e(H@KKOOzkK5l2a_W8QH$|$%DcLR)f zV{*8pFrM?0uyeJ>JZ5w7L^IbuWAYs0h|NZkAdOUWg{fj`(u92h%qt*J{0rZ&Tb%Fg zmyOiYCuyBi9C=C#{HEucIe$O41+pOU;G-teVE_RL1Jj|fa|=&F=>97vn4M^rB6Z0| zDxzCsMQv&p*=p4-5eitx_wTiN``Y#^Ey@q#m4~ipXb^w`Ql+PgctnNha!w)K?(U;T zfSn5N4iia-R5a%?fWCSbLR6IsAt4|~z|rXKsNKBwvzyWWbCc1Z17K{f`YYzbzh@Pj zzP!fbiNcPe0T#r?Vt9$ToH>o&OlnFx5}bz>5+T#0K1{c`CUk?v46VM_+%yN-mDrp- zFbX4N7#uefx!=5~y&s!3eaqiZ5l<7$qLmgeR3)7o?0AZzB7~ZVN-$)jBx?MX*OSJlENf`B!nP_o~w&9e&1MgJny9|D--|B`W&bsV^NBO1?&}jho^Pr@1C!* z@qWkLdc9v^smnKgPU3aiFG~zYuWmXFWIP`@%}vi81wg3NDoI;$PI%4@OY-ktTbHP!S4|9SOKYN9Pp6m|+bYSb`_N9;ji4gt2|I zs40ib6rv&&K$Ls`f$>JPkw_q_#srL;|FYc+CD0@p0FfC5={2>>a=C`6xWW;Tkc2%I z)LJI|On%FGv3zok+tKfOo!r7<7utI2KS`Q7{CU;7^&U*aO!9(u&hC{83Edsln2YS= z(BkjSx=zT>tuMkJYnMiZMHjfVMFD+=oA7Ho8$CI2g|@KZ%Tpn!)s`DZL@*Hwp5seQ zVw|?bSdT`MswlAcH?}(eGltAn6-a#_L!G$PhS8o!wK{szD2Rw?@Nz)?kq*#Fvkw}0 z@S(7VAGlew4GFM@Ac@_V0WeL+=$J!+qLCB@&zj(d3N*j1RoF z3&R$rzxh#!OMKd%EEYeiy~#c!7fT6m{=mdro(DKax|QmyG9jr!?X?w>vzP zd3zpip$^eaDk*5LIJE_kLO{T43p{K>K)R&}B1M9Sy5?aJS_N)YrJ*O4*0(5qNy!FAer$hNT!(5l-ZjJ>m|Ka8+;7d z8-`37WyWba4&TOM4y$~r?fo9W%?BD%)dnJ2WkjWD^G)O2Ze{0d6Vt;mn9X4Wp5t!Q z$7vnhkESET!z{*OI5XC@n#XMx88F;M62geEE~n7pjS=KP6j+4?oPc{m-K;QtZnLSV z#NTy4#s}gyc^5;Fy_PB5@iFep$fJ{_j(Gzo0a;n5u(uTf!4TeJ7na;jRo=$zI%9gg zdsy%@EW%UenC*u4am&ug9a&>2r-uiOXm2W}=%-A>CGIfa#OCqSOY(-&ILj=>wXlvU z*LJRX)i`Ckk3-f!Y`^fPPJ3NWXU4Ogcc{Z_S0l-G*Dy+6iqiR5?E1?RlH8)U`M3(! zpxxY2r0(d9l42@ziRR{Ab7w0|0wcp}XaZo?g&rivHynii4rQIE2@>NzDl65D6C`32 zHs=plv$v^ABSvIn8Yt0|V;ad|+Z08Tu%^iyOtiBmjF4=^vLH!DjYYkTu4a&-qM1gD zG?Hv;Eh&;VDUo6Tsv|RGij1bkfU#nzO2*kXK(cC$j6smvCQ+cXDEG%PM$wC4v8@?4 znPQ4eQDQ1INKysi%*x4c9mGY;l|luO)eHayq`O;S7S&a~@jSAkg^6aUpby_^AyvY-r=t|>MQj;mkpD))WV=(#HgXI_4}6Ny4RoFG`%H#2mq<24Jdt7^B}@9 z9&gb!xF1S@=EQ5D5e$R^uL1?{1+L#dBRB0-P?~vSsG;eqC{miI1^`^-?;DX?wV`r? z;G?Y}-v?YJnx|LjXJm`UBdwBn9ve^Z0twauqbC7c#g7qm^1Ixx9X(gXvr0``bBoW6 zq^;KTfDO#*O_Bp_f>xK*2QWZ(r(DW024H#cJQrRR2xli5fWYbjDo{_p1jYabLdnV? zm?cCFt8f7a=LDfrJ#}SI@FH=xiRum2@myYaAt)WR4Y+J^O0R=y6p%`_MG2dZ%7UVX zJTavOLlxkjSOXC>LeXlZPchlGep-I#sw)P2fN^%8C(JlP)8O zze7qO6sb#5?Bgf~twYSz9@rE`IJ_YWhZ;me0I>DLj#N;$s@w%s7HYK|exIF|Y)g(* zP~%3+fd~p+g}AD?~) zH+b^^zx#YbqJ?E^Z?5Tel!aB?YI$$Nd^I6qV7-sj8&Rh)npPlhpMWtI5P=2QkrPv( z1!cdH6J_nrnuvsw%7!xnn-5F?a_0l8CKNE?L7_Pv-#?6TsDU3P?!{Lys~lrk0s%78 zt+Yc~5ge=+I@EkoggCdUH?7H-TUHQ$YaA+~g=Nal-e8vH*>+BXh6>_%#iim(!vnpz zT+8eiA)bQ}iEJs0LPbh(YOQ1l5Lg{(UX>IqXtWVgfpcW2fKnm|17iJ55OchT2J16& zCUpRbsSL=8+xSv;^8#3Fd`6%qSBMP4g8iXH%T5p|?-E!NV*7HgR0{M!y;B1H+8k~Q z#4%`r3W0I01l*KTv5H*G+HGK@-1jZcvu6K;;s>3U9^0SGFeZJhmq%pM4`s6GAFczG3P>d z;tTADu|kD=z=?Z(d3}HGOVH1He#E4P@l*LW`Oc#mWjzjnfUII70wOub{|_gM1gs1E zKVzuQqxmY}$crh#UUZ=Nu@dm+C%a=ZUpV0q*r_pO(^-s3#Q4t9}dc;a0Ho^!+imBhC;v{7QR9QP=M8lG{Cylp6CLk^eyb`*?m&H6C-2<6EKE^ zB+62mLNH>{7sKj*U{1|XLl9SFBem@SB zxPW@S_jk=o1vCu`T!~usolU-IT>qiAPSIHss%+<%UVP4LJe`S&nL(zteM)REN|!!25=yN^saooN)U2=2&%Whg3`RI zzS99|xw(`TIVC{Bd(WUS9VX#niTpD@ z6)=TeGb#ckj+O0M=4d8<3}1qCcfD)6lxer6%53UJa=y^OwgV$uj3q5!#y4W5CJWHO zx|8%AaUu~0TxUlkh`xZD?gTkR2O{|P5DWvCha{yyqn12cbF1pA!el7CieZ99 zbctNEl%E9~q*cqPID250tQ;mPkx-MTRsbql0In$kr<(?Hby8$mvDk(Q?M$p3@I`E< zKvfmf{gEBbXS&Z!UTTh4}&MIqW>hA#+Pg#!&!}T3Mhqo&py2>bQY<%PB`_YfCG^9X@z%u+yoa;(jCTO|8!#^FCY zhNDF-bp4_pvMoJGZceN0xJLaT2%nS~y_|f+`I#3KF?)_09hiB<5VF72Utl{jRMH2~ z&%KPr;7ZHvt~N{cg+YrzZ(z`H)3iISmTdcq2Y?ye-_hM}M)?mCIL)(kBqzT8VOPIz zjNMChN^!l&^{j!u5hRx@czTE%X2T+f!LV~r)YIAGmG{6?W7DBPf!mST;dJc%g~k>K zowY)bSOl;^h~0vC>Pj6Lre;T}+ukKLN)=B9n2AHu8OH1a4}Gde zJ=s{E4iE>PD1qX*ClFAN)Fe+ZL!6=PKT3gx+Qs2_!b#hpX2lYMX;eWCDuL~`8-|qG zpohaEowA}noAftdc2BTSwq`^jM8i`A-5OSILXN22D9(iME!WE_fi;BLGbpMpEU1Ys zXK9O7kuATWu)u4nj9K+X6rxs3TP!_g&riNK=0gKdw{Htm97-=<(zrj>TSUvQ=(!h- zxv}vwzb6znwC`G#~3C5;9qA5mRVR z5PPgTv&3IFRtC(_^Y#NE5@LZ+kdS=;5!eKp6P-l}JwX18+yGJzvGA%B-)$V|V+LS8 zw7a}}p6j11%`puCD#+5Y5GfxhhhPpEABf|FQ@}YK)TJtszdbN)LDl~M0>#{2DTHda=^V{I-KPp8hv8?5A6va=*A ze@6{RZzr$qEyGTq57JLX18a~&)W`cGR4PiI7~n=Qyn|7at@i3D$d!s>djjv?a&`c6=kIlP2?5{qZJII|av z?Zaq?G(vDprdbR8Aos*3&fY~2#ofiW4q4_pF7Pk3G2B_ zoismF>PzRRWxi_^!IKV8L`aLd4u6vgMA~$L>o?Z%Ne`7zaQ940p3vnocKpn!NzLdL zIMIOgx{(VDJ7&yv=j09~`wiNGk2j|zy8h@l;QZm;j@S%}aoGptK=nsv0VR?C!z2L` z9Kn@$!KySm#SDOAYS-u_hqFcU$TAo3=i$YvV0T)p;D|eu?xd>!a35CxBHlNcBaCeGu=r@VNIt=Y!g5a=%ZZ zNCVKAuUFpotz>@!@In{zdOtQ)%4r4PYa^C5MY5jdq_A{oRvpqBRsE!kWE`2pGG>%M zQJffUM=*A$6bU<5C~(mGe=mtYH|%xkvW&~oLj`x4@fiJ%$CE_OaqBqw2v;?(T9Rp* z4u?&u04*y%5-)tM_4=dIPF^*#d*@*OC%p&eYHNI=zLVSt?~aBeRpx> zZ9YO|?PCn+TAmUE$>kjwi+3JOpJifO)-1KYrsi)#J1>|0{6;VfD^;uXin$=F1y6(1 zfIr7laFbVLcEz@P`fcSQbG`XSfw(6B!g6GPO28T@8 z37xcuzIP9mGD_`%(fqTh8w^Aw8I#?iB&)xnx)Oin$g`pnqFo9oK)~cfIFt z-O<9`I?LD%Sc)zD45m62-MRw>;TeV(cLZlhIdhGxl2l#^%uH2Nhm{d4O2Kp&^kL}3v0 z$3ND0he!H-DBheuq&I7QU#z>lkRB^J_o9R289^BP!qjo?AoYOb#r3s!U7#BKX(*QcA0j zLYqDe;$*HA@8q^DyLlzxCQN{cVc|C9ZyKs0lGY0Rr6KqJBOxjDM&jjsdy?(Q{iwoeiJ2Go(+dqDg&cvHbk@K~m?hwuRTZdXcdlSOt7@sR@Gpf1Ec z;q=fF|DBDFxbOOF`Zshj2no+?k7vk2+%g9z67AamsrfIy)G}eUtT#mt;s?&<_NI3L z50vqmsRlA4Zn06>g(mzS#)M81cV$W63^WbbL>?EnC+jEGF92~uQm~7XI>O*p{~gm) zd`*$B>$@Yg%*or-6i7WFz!EK*39+~?zG5SUeV7q2NQdh=`SNZ6+4w!TE#p@`mSI5d zw=JS?;duJp8XUE~xN!@&XM%W5{I5JEUK9!3umKOANSNBDsimfBimj{GEnCe?D~c#1 zl#mtu%mMu{y!)q?YXR)@4vlgcegUcQRE5%9uJjO3m^i3AZzimL!iZ@?q>>Pfl74_n zU&heLAW^K`Y?xqNb#LM-=Sft1a)jERC$6fHlBHJyLAORGw5WLgT`?$xgonIuQ^G&A zGaEgE_{F+}eCZ|S8@U3!!XEIza(k>PxN%WcK|~||K^Li_ehyi71A3n^^WDGegLWh; zeib`nYiM??dP=|?AmpT|HV5HZLHwrFK+Ydi@L3&s%y%5Mtvj4I^Bm!WjxgF5fs81) zyS?Vi#KoD94olYtY4rGVg9vc*`_{wEvj?!;I8%Rb17$w5ltTe50TabwAxmJ^hxo;k z7Vrc*AimH2*oGXz2_X$-pK3%7LujE!A}2GvQkCfot>-ElHL(g z-S>kYSE7c0Km6Ut;zhVpJ$H1S%-01y z@x38HG%G|7j?@n64HWW`5O#wjj)dW*U&%co%d?b}A=Z$-63X*EjCtqSv(EqTjuOE8 zW&EmP**EdULO^h7Ir>J)?t5=8R4gIKz+W6N1J00t6LcXU%&?-u{fhyNY$ZW{8gH;F z$?{IL^8(=JuW9~~J8-jL?qA*s#tAbp-6!(lDKQC_kj|Lipl1dy4~5M%7Wn7LUY_kk zwYVY15)#T70`WGWaD3#tB~;cg2}LkKy5WU(HYqtm z;ZU)&O4gDO+@SJA*eFoa$K?yG;gl{*lX}`EaV%cVnStyAkg4U!Ng*OYsG;0D!`L8O zg(95gzP1uqPBsg~-4LBGcS*PVHjwYIr(Ok$@Ja*uSlNhJ_GC&=uE)*1VVng!k{3FX z7pzCwgm)YTeCLOI^2YiGtiaj&4{&@|C{FU)#8UTYC3~06W|$LqCo}lUY4-)R=26b~ k{urLP6F8L#6fktqB=jnT-g^fH=~a3!(gdkW zQ}osM`hNG{{c)d}-E-!gXLrw>nX|J+*~(Q`T*;Ex#By?U83{NwefjVI2Y>$aeR{m@ z!|ns%@By%hR^EgyiUEi`y-8i`@&Ke8vCDl%^1=WDHe8mv`gc!7D!^VLNe6(`SCZOM zcI$NOdvB}D>ZA+XV(3Jc{3sxvc!iu800;>Xi(!dqG^W<0K$;jRTt!C;0q$jZOl@;q ze>u>XAGmmQd(4&N8tvdT;~oajDo0Q0N$0>_V|8^?_)4jfCB>>xJ?X+rcSQrEoTy?1sXAf?&f)~10sv+Je?!Iq zh!zMSTwDNNyrK4%PY%f7Or!iRZ5qa^utj~sY*pf$3#%l94ff$Y%yYV z2Eb7WfU~&%-(aZ#kNd8b@jq8^(8vn`0r1Z^J9UjYT{Su>ZY9-cusLG~pB?^&sn+En zbLsQMDf?h&*hdQ8$&;gO$$m&+Z#zE7LQLJy)^l2QX-%#%oW9$xh~V;^xkis~h%fF^zA~0z_k# z7(=@ca;NIbiuE_l`p^fo;=AA3@gE((58KUCiKOtAHS zT=Pah?~6$6BNM$$4KndBXG%h@-|ult_*|=ch~5|U<@Y&@yL~*Gu|D`+aMA6aTL_rZ zJESeR8bwdX7oIQjNT2pd>C?aNU0G?p3OrQZEBQu`4QNf9ez(m_&gGB# z%L}05aofSL#(9>+LBfkrc&6*d?p=b&uY{YTuz%&cO5~4{`^uft)Lb^-XBJ*_q2{G= z`tW>H`bh2~~gQU4%^i{O!w=BQl`mbLF zKHE0jyNez8F~_7b>$onh@9)H9Uo;mKLO z89taj8Dlw*|0nuT*o~e0iSN_y=}t*K=nKkUyT7JAx!W!?m*iHi4%T93PD2BiA@``0 zUwD*R*hQf|!$w}xvDGb!`d82=)ff@P*X;nIN;#{Wil?^mb{#EqFhccnS8wQ!)cW2= zH0T}G1(_QHtMTIIJsq>m^jd!Do?CPHRnTlvw<~Mj(ouE+G0xIYiNm|I-RG6$1HFJT zPKL|nw!qWI;ojq|>EGAuZH<&IUhfuUf^f-54RU)6pW5j`jPc(5L-L^Ct^aJZw~B`U zkVng2FXhGW^Z%Tg+$=XxCqDtZi^>RlzKs|@(P&|J$d%cq6_#)9ZK{y;Dxn)uY`;jI z^NeB>jbe+M7IZj#qlU7UIcV&7!};;9ITW=#)^1>+zPo<@!%vZI@G+AYHT&RG4%YV9 z4;%HG)?~gOJY^MpVRr6@J|n5n_0Mq+u19^mGq(I-KVaw7R#flOLD;d&_lb{?D)SqV27$ zr+O7ic>pL71QH|l`<*ZtxBH8#cVjBq)=P|I{!)AgCK({|c+c`6bQY=7Kyrjl#sSj^ z2%gdakk24MeEHiUf=EMB0dle(w?acgN-)|G=`aMPP@^;Ef)N9vNDwa`0V`M2!IKq!(QrrKAo~WTVE}lGq_z9Y+`)& zjWH=xaiq0vJynuRM2wm$xxt7&0B_2LO5;n+01Wa=mC!THlLS^jN_y~o>w5uX@NUSa zaR}MK)B662rcOmfAIi&C##s z)-DOUXaS2fc#0UFGy$Jsgm=-)rsq<_C1-sCg2i_9K{C-Uo?KaPc392JmQq)V?PoEZTc~}#VC(_P#r%2T5;MU!S)*L_AhIqk?G%k7GjlmO+>s&HJ|^2SU*=r&iKs7?}>^3C#RE?Df* z4no@P*@cV$@c^OP?CQ_)Vs79V3 zS8WP0gYg%?em__K;!(}Y5L0(qi|jbyIP#WqKBtbPZ8+GD8f2yYV`}_wm`IQ}CHp%QHO%`)daPRl!;7|n(+t9Z$7r&khFtxpH zVM065L^G|-COa~rNhJlEr6+`So24YJTuO5ktUQ`~zjX}ndby2BJ6yVIF-RzJ!kn;d z=>F#(`TySkGGAy@W)%4S^BZj(_p?J zGSk@re3B$$-0zYeIF=fIPj`~H za-NM9jc-#U4;c@wW)x1#;$u#BL#n_B`a9iwghkGgrbHRTXytehUAM2}g??1_zJVE^ z%Hx^+(hjE3i~^PBx(f?l9w;1c^>x`+oy+Ccxmb^^&s4~Kw1*kjQ;FIu+8z5O@k#4m zTPbz^wCe|s`W$OlF2y=5BDIXwiJQCBM-jt897!}?!A)LNz3VczQ~WBMz|0DFZurN0 zqFCZwAzP?*X0Tgwp4(^!iBpan-N)Bo?{nqYoa-4%puwr#55yTgk4+gy%hF;c74_{r zoz1;&u%QWs4H}XFDSIZI))HhU=a7EfY?0W)=Spbit3@lBzY1t+Q-O#ExwQjONt95R z(7arzia}~hLWDxt_Gje${cMS_^LeVTcUhZMWsKZNc62Wf#(FK^!*HXu>lAEEg*oY4 zc6OaX8m>W6k;9x!{mFJ>E-tIiF77U6Wvi8D&e_@7l`fWEI{wBrO_K{v3pF)Ue-qVg zBCI26<(!j~?c5o3J{y}DqVX_5$@+nlF9JqRs15Sj)6PUo(j2`p2H@|FRa9^dDXB(? z-+ihGqf-(FJNG`O0@~55V%$ynV!-IgI>Mp8R|#~{$qqDx#D>rh&|>;nQt=@lYbeZ2 z0>%Iasu40(lMyG@i6@qjh*?5i?6M|DF))Yy1OiPBkR&NzHeE6!Ehzvq%8ZFsO&lF{ zq>0`K4JJ;K1D&G&(vo4xmI;wV*<_@ekqd;SNG?-)*Tg0wf#_mx!>VCbbEsVhO(a$V zpbi|;HG^pmaj7d)idj3TBG5GAuVEy~)~0sx>P#I;WKbi*!Xhpb1d>Mnlta?c+z`xPs?HCGw5Ma~lG%lqskbRLAZ*TgD8^+RRUtS;Aq5nGOk&8A?`)R3<<>prMUO zUdm)b;smJEWTxz3N0XUeVx9B`su(pb`vHKCLLwomSY!dFglsbXB+`rm82Ci{o&BcwIUyrC2fCh>%}Eivi+F!{?gA zBhI7hf=Qw0CI^y&S*=>(4y7fg+~PDv{Ai3aakh{HmfXXPO4>x%kS-F1N)}o%tTkfc zb{`OQZ7V~y340*5Jgizdvp|tC*$HqhI1e!m#0m}p@l!~z=$N&3Ylg{qxg!ySgF|zg zO<=sSgFrkBn41ov>3I{7QBg3q{m(tKn&E&LAT%Pv=+5?O9X%yr(9~46y{45O$@Ein zRdivVJ{lP3Ofd%qSQ+ns9UlY-XeYsjiF>{fm0+|jkiJIj;cbDOI7BI`22p%x9F^0fM2J*`}5Z=3G! z*NX0HKD(mTF@+u*QO8vd+!hSkNU>9oRD~=vPmc#I<(X|xvK;VzJ_(Q7(YsLfeZQ6I zoygc-t^e)(Nad@dU0`(O@}JDwHlhL3k6qic6WbMwx5p3J)*8cfJ1}WEbTKYj57j}) z40p?%?7#J9`M1>CEHm8QU7Ry4Yo&yybR;F3r6-%FbR@?AR^H^~(hxO@_wWn7DC!%?~&+lMJ~({ok&_^Jb)4i}%Q_G%Kda%{pW-{w~}WII&f zz-@iEpL08&Mar=tBeS^HH9~q~|!z-h2i%uknj|rgB=1%ED*~d-6!*GOG+5T_ ztsZ}6-b8hTO}8MaXA5im5D#e!6#TWh{F&cLz+4)P1Uepcd9t|iC7|CV=8`ji+n95s z=^lBt35`h6(1Y;dkTEPZ$ofDThx5e}8pR1@=Q}7n8^sXL$3T|Kc(fwqCWC77Mj>~4 zl9GW0`>p((wQorTOh2ul=OvNRT55?Qt{puxHVc^RsembUXR-1CTh1ry#MhA-ZSldm z7@^@h8a1?F6w{KmtrWZ_-EFFMkx7}TVnL}VAvZ%&&x6H1ph2o9ddU)f&?rZu&>f}@3 zI$y=y0Yww`V3qo1dNqok@VylJNC@|6^a@~G_{!fc*)dmcsbg4bSnf<|RA30_M$|^i z8LQ;TAOwu$4xR4GcYGLJneXkw8_l^~H91D|^}%B$;??A{n`5T#;rOa!SL$jYC<%(; zLOeAVs8dm+x6qU$4YHj=INMY>02nwC=y~}&v*T}3erO;DjYbwyfCCy~W>~ZqM48W` z1>iCZQ_oUHM3G7WEKJJ0_2A}Gq0@#l$?<7Cj8=9}x*I_1YC3=-G8Wrx)nV~uK4)WP zpalsqyH+v{gxsSzaDo|Y7AyPulF^>Hl~R@c2)Gg1B{bA8+1%RB>tWun*>kqp?|If- zdv>1MwEyR{*h!NJ^-RjnZJ*L1QU6HgX#Z? zzXpPd(xBVGwL{tJlK9#n0N}K<5AYwK?LYZH4d8bOxUTg&^e(+_tf({vWvq7w|2Ox4_)Gr}7s57M?)mBNb+|R>n!1VRhW}arE)4iDl>Z|5 zk4iY%n+Z!A!)Zx_L5Bb$tWqL4QXKIgl>j#;br_6uIa|kw2>}9!Bk7-r5n<(RgaenY z33YlzBEgdcLwhbt-NO>E0U~aNJT^0Q{vEFSp+qNkby<;PW8G~IKY#C5T~Ft@l}SWp z=d1Mb2~c8`xT-3NU(pR=xoL9sJ_XS|haakW*FEm=2OPh!QL^%{tG!Qtri61=dEGXRNqV87>Xf zwteb;ol{qSRx_#Y5Z3{u3(&UW#DN&iGj$m$pJ(!yY zt4zbx&l^9Bm#Ujc_nq%OKD6yM&2{#2(uDY6HyOrw+W75RKwY?I3tV#DKZXK}0ffc^ zC=F|e#v0+dU!EB|v=5Q=R8RstS1{=-b_XChAz588aY$2BK*=cY%=Yk^O=94hS-X`- zne}nqCnF^6GGuBeWpi5c&(Y) zSwLh!Adc-crZjeQG5nG44zJ2aNh(Zs6b2eIvn`-qb7r@dz#beLb2qHEB=sZ1v-Wy_ z%gV}1tEtoLrPBCEM(c4U!f;Ww7RO;t!qSgT7-Ygud3@C|ZH&AO^DikJ&**9Qd?M2b7~Grjgt5R~GL zv5plNsI3wx>8=bGsnhPc2cr3PZ+CB)Ohbtja9Wu0hi&VA(q*aw=iTPMi}5(2u_~T` zgbs{|#>uI|G?j=A1qzB*TKcnUe1!wL!-8$LE}n~-pf|z=EfG$ZJe0)MH@oxArdfdZZ;ssSF82VzUORf zb=gq?KBc&2GUPR5UkLcJ)LNCLCdUiUVnkF>wyo({$fx#yf0G&VmT1>G+$;>6EtjqE zez=ooKU$p}m~6KXrq!h5B0zwoX5ldis39~RAE#+b_{!*|LH(1i>h?7htD~oRx0FYM zboBqduG6Sj$WEZ2a6*+K>fogPw_nVUM1xVFNJLphtp+OWlGv(wXV@-o7jBVVP=LC*K2-aC7jv{s0IncnckH8?K%oz;q^8R<6Va5w z*{rjzen%!7H-H4OEK>fz(BovkgSOL`p;=!}pYdYi3lf1Ho!ann8^JeaCx)$ENA!D=@S`pO=ISW< zd!-M&gT3QYeaD_JlVG`Y6tNhE;E1goX&>qY7lKU)sePGeQ&8G0#Xm~j982H-j1;Kq z@5sS%JhbFODge%?2Oi8Dj)cn0RbV731>!-p_!wa8P$br4)e*{~4p1i5{|AQUgvTlf zCSK%eL3G7Av&BJ5ltP29G?+PPhBi4rw2V9(&B+ZTPIT02Qe#Tx5>LZsp@(r=G)>I$ zYFrllSU$~F33aV45m&r`l(+*6xumfZ2F>e)Q#BUCMoaLer^S-v5aifgela&1%os$R zD;^sSlZ1&GM}y$0l*|brW~b~_UK1`JTJQ&GBN3;y@9Ulp7oDUWJ6&Ba-9!==2`wQ` zQb=DT4}%?ym1_*fG&+V`7V&byCPGq;UHJa_NXAI*`OvY)yW(f$U8L!G^%}nHt>eb& zk8x?c$cGE!YWE3JF#@%J+^ag}0}g8S5Rr7(%;|0W^P;q^g!v-~18GL>+ot&;Z(H;uR_Kl(q(Sr=AZFCu~ijD}}cf=3*$ zBuyhmqMupaaK3V34lUC(jpny!a4R!9FdDq@vYVL$C^sVAK7Qd_eW}^~{*7%75;@dg zMUi>aH#xCee((BF@Xqs5HMf%NyRE46LI6Q$n}dmlxq@N%H3@q>xxJl$w?vFq(Mb$) zcH^m}N5};VJm_2&MHPvH5UN(Vxk0isgdO?Oc!=GcW?_l47Oo$`Toyyc3B$pX?Exy! zA^OGUJdLl`W(A2tK z9+s5KbR$#EC@7z1yk_zS9Ybwu!Kx>T8BwZFdB)&Yh@ezDa+ylaMEsLvNW-u|9p%Iu zK2tJHZ$nNH0w}XKj-se`qGMpIQq&6~E7&B;Q~kbg5%gW>C}L>>2^cLV9-w=%tm;iO zQ8xDm>_xCdu_!nyQ2VNoA|*g>_^7J8O#b_an-7GQM311Hf_ATkL0qjdCsHN25P#1y zAd73$9@QD%fEA~{g1$6UA2{PT)t8tG^AEOty&1YhR;s^VlJPVi$suUFe+alBW#l;c z_@V0cm}SqE@17v>XVrleLt33m!x%U}8VK1#ScY@H>u@fe*27mV3DhqE1uYl|O90A+ z#PBoUObkZWp=vsWT^G%+(JEn8C5>MF&;p1NiH>LMQSkdiK;kM;mo-4r#WWssYxt~c zW?78wQj-i=)jRMvD+ETv+14qsM<%miK;3rti2Y~ry%x4^YHD7r%x=-jsxn!9F(PmY zMu&K##P#mw+w8hx{10Ss80mP~Zpr&@wG9@EY9ykvqXlI1=wHnmNxMoy$}WN0b9%(X z>ameQlN~w{!e^UEg6-bYaQcUDGy?P<&GxX!Sq8IA3X&kFo^;419N<8@NaslpD>20JHRK3c!I_4Wf;^fQ+rEmJ^B@S_Z|j8obL=*$|bG^0pXJF}RK?YKMZd zrr6b^VokwgSfJCN?Q0ZrKf2ntA|jvfib|6!8hcJmS&czjy6jC9jrYJ$FMWFr`1U>Y zm(G#tY>(Q^lTvQwheYo@3S-i54LiaJeBkP|b4GLLzRxNyR);_46waK={gXNpmt<7^ zx!?jDN7h?U>5L*9ja7hw0c)V^tF@cgt@9Ue9IwhZr8e|CDC*5$eLB6H-mg6UU^7v6 zb{e_x+4XCGp0OF@bNy#oash_$cc&`}C=!L)cttfXh9i9HZTo}cO1WNKgS1_qNx+3_07l1KSF@cH+E2(Oa6~J% z_h_w-u&hfLUu{Tl?IWK(lwgD@3ZZ@1b79#q)CVO{dZZAP4F0pK0+Ld2xtlI)UUl^E zL%Jx(hDoVmurN(^Y^p)7> zoYDG_=$oBAsv`y;3?D*_j~u2W}P$f9$(B7$Y-dx!?Y6cRd z?q~5Tt6uKQ`6SS`UGKBv6bBf>X905vS%3lo3k$?3iWop#sPr)7jjQ-Kj;d_38diMO zQ3mJXChlUWxrU;qkkDwO!!x|*@*Y?4z1QDjVm}2CAirsdsvbsHt+0JPX%W+eK*U)Z z{7ye~po?_$Qp<{Uyljs?yIhZGC%iSB{w~|Y##N2GXVI*}eyk{+k1_&K5xi*;w+>5! z6uzUVRxw;#oSu*vd&F(>RJ~j0$Cs(>6&(OFkO3c+nRv~Epl{^hePKW3`IlOk?>X0k zd@`j5Z!7pGA%IP5iY?BCb8@~>?!iMQih6_)!Ag`Gd*FpA>3Ak%LhL<| zn%Oo&WuenWOpwGppls{>Hnr^H82Qkg?`mhjdfU_OgzBVU2136W)5r|>>Bf8{9N^>Cr*YSU0%CQnp}+an%4!3*dpEHcvvcROoar2H#7CWB->Mre+w zEOkGGzKl?~Jx7Y~Yd$5oZnPBhDc)M=EM$_%+3Yh)11=5Xnf+MtlA^0je0wh-xnxg{ z=MRIBQ|g^0oWKMsfLdXcObbp&7B7cg?Ote=&HZyu!Fx!27-v>>)H(B|Cs(eh`1w>+ z;ioJ+7in?2xu_7eC?^~O4P5|A)BbXCpMm^aUUqBsCI8qhp#b#wCZvi$&=^ZBJ6IQ-kM>V9(g`veuFO+Cl+gO^0|pDg`a z!(DuSz0i0o{Dx8D?OE=+^lcVjqtWHN$-nZ-y;sbd1rVZy*g2*Y?2LgrKLx#e(~FL z|8Vy9b_ZVJTZc*`LQd7d^Ddx!0?SIAo`DZaz4_K)1n8=y-$mbZNLej0<|L&aM~=@_ zYU7#GbvkwV?M3oLtakQPg0B`2<=f!E4?0|LABR)>2Cb{}w_1>#D)*1ByiY3Vl5$+l zvZ)?>+u-_h{hP$zt9Liw@P{KGyUR`EcK)0lJo*WI!oHhWDffZp~|`PFTDqne36&CS@|MdzsT3)@bGjtjB* zwvLv8+ii;5>hli%j1$Xodda>-^6;LiOv&mPRChB)u*L6%<(-rn9qm7dsggR41>WqO zOVl>+*nWf!f|8YeQ>WoqRwbA=gCIH z{}{cGrg{d{JMK3R778M{dtmSlKt(}z{haB^VYI+E^|UOET86Qu6T6! zn8Cy%iE@147Hjj@fBwuIFQfMVk?r!zkFst!5b3z$+zxmk_myLFjDbqd?ug?f?r=_v z*$l{Hm>$@g&~?Po z82-%qkgC_u4IUgCad8Q;@{lk{u}JYE2)Nx-+HHHo%|-9cr(GL}oSt;0J@1;|s;JF=?;hR~ z_e#MawU`XW@wj?vTRLLoRBsOTsd?0Ib^E2-=a207ppOjtx4fgWQ+NuRg#}*=Na99T z6mUJS($He3txmH0RjU z(9>sp`)yDD-=NFMd>NH#A-fc_bozS0#|PR2kca{ z6MTi3IwIP3Lw;;NpQRoP62Es}O771)pMcQQsO12GH$=|p6z#4mjnX`lzq=~*RjoKL z(f7HZans9n_Y5!a@huFEZf=>QVjIl?P0=6+8hm7z$RJjoZqzvH8`H3&6rMZ_2qpuo zqiG^E{zQQ4gP)pn>SC=&Q#G^U;SryYul6jLALcH6X?}enJMCb1iAg!yoO4tD7SyG^ zUAxWtZ)^H}kYsz_mRjl?CMz<|_gn_L-|pw{^h$?;^S1%+Xc9$G#`V2tH1BYn%vP}0 z;^<#TNfKrOGZ00Z?=7L%IVFS9Ke{6B#eTUFm8&oRdRx!fj8Y6`LdWp%sSY+UYtuq7 zk*`Rc+W7f|Q*c6RNvsy1*C!R4(>?Mw7Au72NNX=s17d{6S@;+7W`xCbo5#>9~xED|3g3ceygD+8E*vg2H z&$mjv_B-`JHQ#W9oZSo(0WjRDQIk@$Ia!WGw&o5O!#o>YngNZN)Q(Z2E@b=1l1Brq zU{JjCe4uAEoU}BcXm?lZ%%JG{vO3P5n6N-ZBaZSWM*R4@q=3JCLFW7ODHdOQmHbYZ zaLpbCwxYqiF?Df!B;OHMeea0002kRxyB3r4j~#wnW*vfB*mh z8%J@0wxDGqMG+CSCbSr>hLVnkhOFRt1D@+<4H6(^6DFEAkYzSTiKdv;(WX(Slhm72 zCQYg8c?~j#Xww8w)J>oanwn{o)NM@~WMC5}$u!COrkZ*to|73PN2%!=JwwuI;ypqP zA|V25r{S(0000q00Tf801W^DGynhq00uw?fuleHpkP1-O#lD@G|8aIGyo*^N>W77Q`E%M z(HaJrnFfX&HOqv)*O#lD@10VnZ4Ff;`000JoQA7w$1OkmQ zl%6IjJvBc?4XM3I$R4JR00000G-v<-000000000FPyhe`8fmBVP!%4;RX%(L0m2HR z1msGjr7271UT1geyy}f!jdZs)+^uzPSC2B@H)AfLb97v_*GA!P+mnTNTI0KOJ6+wm zwf@g5#TN0!+uyp?&9{xMx}DaWoW`QNuDZ^P7e_8HTdSqz+t$*(Jn}0N;%AN>PwOZ7 z@V~H*Spnbju>pAe**B$R*L;W!N`oxAHIv3{P-6y7rEuL;{DAyrw5yB^n}+Y1@dld^28DWJ$?qqBKUO(F*-#w@@=z?SV`$U zLaQq$Wq)Q?4Uf6XWvSZ=+07QkXqO(%NPc9l@3WtAf$Q#C!kX2HnW|`$+Ie5ZTv|bL zy|!iUs#3>20ZS_09*iYvnYaUWtUzBEHJ49e>C;5jZpQXS0Qa4UPaW^miEootKx^m{ z49>|<%VXz!{wt((-W05Sh`Ymr}Oo} zwlQF}Es$3i4)hAcSZE<6Kpmyv(MbdbD@InTBIIdPIOImIRhDaOZkH>edo#QEn#PM( zy1ZH8uDZEYh*i8602g8~P3)mreZ^m8i}VR&0s_Q%d)?Gph|wU{MG3h{!?jQ6An3ro zX?P49E7A3BLi)#C^qj~x*nr!D7=YPD;b9e_oA)Z+D$Q_yS1jNg1T->|ZseUTfE}pL zIQkaT64Ld|(nNH_xS%FsQGC_*N(nHM2T}kc3rH=}+7Z5&j=5?Zm<-s!bT&dda4K*N zP0gyJ&?lHN1c&)B%$XSgxZtS56C^G-r4+~$v?q$!^iz*a?70Sr7NT{~(aJ=mMCfWp za4pW33-o4TyV z(-AgczOj6}zF7bO0R#JF1ceL|AqU2?HAx>fm`M^0q!a@K10)gvFa@AtQ$q#`SkZk!st}NI{XJC6+BDMWB&}m?6w_ z?|2b2E6oX}n+hAW7V&g0sdjFN^hj|ReI>TJ(+g^>wxTU1sU4q=>k+LajOXXm>Rvxu zEwxmZ)xlC`XvwjXq9}$`5Cjr$UC^Qp7D5mtS0LNv9kjp!p&_vv*k*6KAd_LxHCK6J zU3C|+E|u3^w@axRDzf7>mSM9@bK9~y+hmJkNovt81q47M>prD4Go+-x72wL9X8;yq zNLK4U<~($5$*>?HAS{TPpd&~M$OzwXo%5XMEX|UMHki-R=Pq6Ua`XEfJRRoBV6N7l z8nw2uUOUcN3l$(+DjKA;kVwO^3RTvn#*k+ekO^c)k`h8jM2sNH%I3d4n9W_Ld`>J_ z?lP2>4pKP65H6ssOeBL?U^NUdv5N$OQiPEK#wNFQXIaKsY`}Ih!l|Wb%UO|yxG-V9 z43=@vSkiTB@qH(j%pbA=-Iw zgSmw(3szqfEee#aC03IWmL^jfXwiej!&OR()rJ){R#mF1%_fS$S}}sK!KcM&WYJhz zUeA+Dd26QncX>N~W-`)ALYDq;N)VV3!^Y+sQsDrhfRQ<@X3|oMGMf;9L8pY=aS23b-4d*EL@LCpDkTbJO9d2>g)T(7X@((zR^@J$ zn})mNEj7aA&Um@1TC8bU@OLR)*zfbFgw56DeUEpGobHco@%Wv?x#K(!7I?dA+URWA z$!7*$J|t?(lxfD;WvQCX+;Ze^rex0}NUa=^xy0IV+_9GnHcYa_t(&%GqSW1ZY&6-c zg`2dKM-8%PS)^+$WtQ^}9C-5~2WNx4@bY-tGQw6Bl`F`@DrJf0RW*4YeX+A`bCb^3 zRb^G^X9})tHO(bb^No`b%P_`|LQfs$5*EwZOv`A}Zt8I`4QL(ly>aS<)o~xeUy)ErLQj?A(4wfX7 z5t5UdLJb)BiSAT@qWu*`L=pmmsm_o^ia=Eel`NM87)V4gsU*3?f-TElnyt2@ZKGI| zQK(I%DA7y}Ca97jBrH)`HVv_~rcIQ}X)23JqccR2vSt||+9@JTWNeBJB}p1$7_eeu zM#VE^WR_tPM9q@1qO&c55}?x*qLC5^u~LI5sVN~!DA-U$iyIUqjLDKI4KW&JrDT&e z7$%57Xrmg#H4+vX zW?&R-jUxyc$&zSfl+DK;fB8xg3DGBR2<6&5vH7R6f>YOGeasG=y;Mu;+j zq|sv*i6SFW2F5KL87iw4R@TvDQAMKBsx)k4ZH=vpqSnQ&YOi}mNmc$jZ#fckt0hK1&tVzRij9T7>Yzl5>OJ9Kcohc7)~8(aW`Df@|Zpo8V26{F)FKCI5Z40P~aGGWVwd@d%f=qiKr$cbY!Ba;LK%F z4Ed}vx$|l^68*tNv~+_lSRVY03(KdTTYM}ao20>^iuSHdx-{;3B`HR&WC1$Z3BP_$ z&YfV8b{%w`-Ym|7Ao!g;&tBr=4YRkt$FbUR^v9pCB;}m=cWUh8)ahrb9@VUwEV)c# zD&dB3`p&aztFmbz$Zv@DI-WUeNaol{ASn;KZg8YZyd!p<0JG)gfy+F_FyS!RSm znGqg;y(ec_AGG=(M$b_YY}!uJ)D{4%lrgz$t1VOuE6A4|g(^XEH(w;k%xxit7-I`Q zZ@0Qbn^t5X^RyxOQXt+Z4U9r3y~}QVV_CFVs}NnYH8UFKV_1`1qBo6jh}Ei8R=JXD zEtbWyy!J_C9hObvTA+gQZ19d*()nn+es99u%Qk2#y zWs)pdjEvw#SruY2BNE8O!j(msnkAT$krfn;6O0j=DsWWOB1IMiMKjD3-Si$qpzSBv z%&pxJ%0d!FBvM961d!E5YSPS=9D2;jlxUG-VI~QN9wlTdDi%bR`0)=OeQ7$(O%9tD z7RfrMCt|fQ$S=>C$f9IOMHVmhzDiW*010G{5wOgdQX`yp^wf-Yww80UV#{5vZyjSd6wGO%)VuX==HaH(Er`}~ zW8oo}poT4$R7FBXXp~lhK_Wzo5kerb1(H&mO{Qh7EooX-mRp>wNYu(^NhWC#!4adp z?TvMd8j&4SH6>V1on+5uI;PCDWu`Vux>~07{jKq>N;ZNvDrK0>u!=T{iY*wlY$m9( z8&O6vR8>8$^J2O`=JbTd}bb zqd{UtLu+cpNQ4lJpraCuLV}?Zmwqa>8(6l!CADsCY#UT>#rIX`#dYH5uA1Ds7AT66 zF;_TZmfBjXO)i#CsP=w$&h@^3;Is6tJ@PTTl4DD43sgWzQxHQ!iJ&4_On?OuAeSu= z>M8z@`3x~tdX93&9Ax8dBv3$IgG;PypsM{3}J4qVc zHPc=;o!HcL+V4AU;|F=yF7vUbYn9h@Tb=3Wcx#;Vyw3{djiXLoYr5-mU6*$*??b$= zF>>j1Ym#$vicd!V*tOy!#ebDwqS2D&c&euvuHFHws*`pREWY{BS=B|}4a~8>04Y{&tB!bN%K^AKmv2S1AdiIY; zvhKz`PZu`c9ojbU!1c+RAg^6=jTWNRWJDo^b8?;4*^cV#y5zZy%$Z%-ySo}T4(_|V zmruK1-uLSEh^MLQywet5I>nUIrliP}noJf^q%jsojH1bzncceQV`WP2=?KYSE4!M> zuI^;Up0{r&h!Z2bmE!L^M^-|zOqys&rZjhPwC>!l?YS({DcyCMl1$o7Mx3~fAzbYe zEL`OviaE+CtjUHMA#-(^p{tvwgbK5bXSJ z&C^O3yBc&|f4`{Nc2)6y2pw19b!%1ZYk7Uq77|Eg+ZNc^!KB2IF-D*bg3?xIHZ_fC z#T6O%ay{3sG@g!+r|j&OyE&GK7N@Rb3F)XXJ#8%h*${MlC&3MMkUF&s-41=H(KI3r z^db#BJ(ipy?g)cllSj$=uOrD0&jg7p$6$aL_vsPh&`j&h=w;2J14O5 zp2U(#J)sbDKBLXlh&T}kGo0-~(i&ImmTKRVbYZf+o{I??wW~nn{ki~)oimO5W_&c& z6=QYhI}&9d1MdEo*TgleZ`1m=nX7AitXN{iT8WvZkeIS9Lz<%0PVQ`N%xfEJjJ92^#AT?OVw?$t07w zL>YEBBV$P?Q4{7((IDTd4}uOR!UvUD6(I(Y%j>}{gp=kldrk*+DG+uYVV>Qjl1XH- z9*3a&5J1OSwRew~THG9*+;<;pk z6BLh;u27NaL8z0}ARLbgBG!2;dsAsonq+>jCAnvt#L&k<~fEV;%iTTvZskhLeR#5a-;A*Qivl`R&@ zEmZG_gM?8KU_=6fx70&~a>|bvx-TwcPyn{-H{ie^ATo$X_~8!N#ocvO<3QFRqU$4Q zaV&t1G)YRH_oBy|%5f9hl3=IMq$Avhh)Fz25MbxSbZU}R!*ufPB$7-`9h``Rmxa7W z2!nDU)T;3NY+z_dl?4M+4WOc49BpbK6%BA-ija?xB4QklMC1sAZ9a>va`O0RX)Kts zNmfCEFo=T?rV5Bs%oO~ow`rE5Af@57k${L4S9leu6~zM@rklY)2U!3c2I{J}%z=;t zP;vr+yJ?Im8JB1TZ#b?ht6CYuVO3k8h#5gsfT?2Kjc1RP8;FC}-gQl?sU~;$=?SU= zV2C=yuQv(d2!pVQJ#MJ^x5jwi;aGT7eT3Cj=6xl#hq{BDI(jvj5d!)fA`0CThR_iy z0a8UH!V+ZPm(}gNimAZGcY`*%8fgKk5yOmmIxUU0+d0IBa zSpW-b6w3yR!H>V!x3|34xV7t2CrDY?A`ix4JKW$Wl0q&>h3@qHcCTO3z5)po0~!q$ zS&&JVQ86VIje(ZNlL=E2gJPmcBWW?CVoif3go9G_pz$Ka_o7tyq(jRjM8@)n823pA z9?}l!5X2;d+BHSGOtq3Bf(mKu;yIqPldx-mII(CDTwzfF#}jObk80|pR@lxkF<51c zVQ^d+BC1JxmC`ElZktj`Nurplsa2*U4H%Od2__~QBp|7RBpZp3W4(ePyI&?tQxnXe zPw{mmMx7E9%?XN=Y{Nswec(hM!^V8MAocw%9~0&sd0SE-?-2)YmKiZ5C5A*n)>M<( z*hC&~@epDh;fUStWV31(YEd+J)J*81y|)y2hUR27hfGlfyo$PCdY zrpySXv{6Gn@sn08 zg9x#SBCv>3#4K4PSg|5fQba|9Pp~*yEkV=DgpTCl#6LrXw-GETLPRvcL=KOns<7<- z_h6Eh)mRkhu5`FcDxEix>2g*kJKdpvo?puj=4u@?x8P9)_*a|7%lJcXy$xhM!}qRR*u`+YFGF&%;204C zYJ7@;g&4|Iu%IDk8*|n>`ZH~n0pZUCWr!MVs|8veNs8|Pa2fJVb3z2)I`nvnwb)i{ zKr|imRW5=pH^#B7pt0T52Cj>9M&rUzT`g=TU6es@U0TAL+}}I4IOUu?I|W!Q-%|z> zQ+uKY!IqA!4SK4e!knhksiGzxfVLa!IPzO{5L%SI8CDJvrmABzCi7%*8ay41)I=8cWxubTw{8)T z&$+aSF5N~jv^V05NNBsj)!NCQtu;39Io5S%E2U&hh;@26is8!ggO%M8ZQ{3UAO*DJ zhaR%fBX>!=N~&@Jpvfa7w`NBQ!7D#H1RB-H(Y^@)oMRv>U5o%iv}#L!>wdeYH$W|R zpx`D#sD)DrfZ@0~9MvovBX;WUQ6pfJAYMrTAXn#8)%U z&ULqpYaw}?#A}?Z$XAVT9IM1u@mud+ccVvldI;B)uNRGZH#M&EK@b3dAxc9{;_cdI z1g0^LM5!TXqKkd!79WFrM4mc#{ca~{Quufn7_t0-Sq)Su*z>q!{t0KGUzhbR0FSc6 zVN%muAyn{!+4r{mXJeJi{wkEim>|c+cg>k8$iu_8#BA(3yLsQc<8^s_&n!;%T!6ce z7t=cmzPdzN6Z#(@$xwj5()3ww3M-3vv})?ZQy~|gz;XAqUJI%+99{|KbQ9BEJ6gE-7 zwCl==9G)s>nQX@o*GK!ES2#jJ9Mg(j;FJ101XhWaRzfF5Hz;0CO2n7#;f=tAu zOd>{&u&Yf7vsJNPwbC=`c06de#;*5kZ+116rJF@)g@$|G-0N*yWw`}Jn-zWX_ZL?1 zi37JNspB9$x`3$H(}E&+2#F&iR<#iT?2uTe-b%7 literal 0 HcmV?d00001 diff --git a/data/tplyr_adas.rda b/data/tplyr_adas.rda new file mode 100644 index 0000000000000000000000000000000000000000..789d372a4b10936d80ab186d49b5f529aba17515 GIT binary patch literal 15047 zcmaiabyO5y(CE@3Al$Gk@GOch0$UYg)k=DJ3Fr#I0)-@xD|Wdl>lPzyBX>Az05o$wCE5^X>rv zte21LTU&u`0Dv~YOuca)d(*AM=e^!5pFjZi(fne1Pls#|!2M@_6%g>$=PjO4Nt2z--Atj{^g6qfVLq;a{{>@8YMmGwjD4fyJAviLFis(=zA23riJX5HF!#l^# z$+wpUTG8TG=LTeyelJbIFPXKn<0}N<=uT&1`~dUT@~<>VkketrzVq`pBW2*};NUFW zX|RTHj6ZTfadidW&K7jOp1f|SC zYjCHr^5SRt!-8>m$^iJmUbKc(-W*EnR@S4A!O!8{%W6+seQ{+&ULYIu&9m3J6N?5Q>Y#}RppA8Z50(ICZ{ z#~Jx24k<~PdPqLFi$Bus#w+LwaXnudLt-Y3L@mXXO7nr6|VLSNXQ zUPF&o*IWCnydtQQG{`Ny+y2>VPfd_S=UlK}zMdg+Q6=HsM@2pEkBBA?+7wFFnAUpQ zLK>1HV`%SS$q%|`Z<<>@o!s}uW5sj6G_I3*?l^gj#cO)183^TUk2XVw?evA3RpQ3p zGC;m0XC@1w`y0mx4b`x##y{IUqvPslk4+yHA{;%i)<9N>WK66LLBKRS3juoJ62hhBNoTvytOl4G~1l-`;OgE;cFJ|pRnOCHo zu{@TnqpX^;$BxAFA=5HUs3A;7>0aa|^cN=f%FuZb$ zbd-<->M6zJ`^Z*W>AyU8tK~RiJENy~L$>#>q>r8iXJIyXqArhP9&W}vcNSg6ixmrF zxX`JMSC5~_@sc3@m+IRLzuym5|G4z%t^AZDqGEb95-5PhD5<_fII6*aIPy{8wSF%MkhHNJ2f+YWObV z&&%Z@?Z&D9vtgC7QQ_O1OO&3nci? zR{vYqC=Fs%^`dL+?<;fMlzF0L#+Z9IX82_z`$U zLGBqbiB*%Cw`e@Kf!dE$+skclub}{-kSQyK|VxleoNlaSaE%+>t1Jwnbq& zT>8sH^^ktIBgTv7IlpPE!`oP*B2v!}?2*z4{O=LQ#?5;luiwv<@$FSP3Jd%8bOO5I zfw!{{+dWuc0?;I*3{kVVY2vyu4y@I3QXngO$PUxet1s1!_myFY-r(LB^ty?Q(WZ3P zsS2Q++VrJoe~`@t2l6){o0%0Iqcx+0p6HnR&N(s=9I9+XV0EXBq-mZ0S8_3|%8ife8}VrK43-}2&S zt}HTDn#E!3N}0_Ng8Pj}Dmy(u+xTLRx6D@YjXRu)wj5q8+<-_2k!04EMJ|~sIEp<%XuJPIMO@_b^ zZTfGcIDV0z@FwQ}TN@yxYybVCcW(XHpMJ{Unr^exQPku1^X^rTx&~bUGe`CD@m0M~ zK}_MhWzj{^wK>k!vHd5X?I2{wZ)oU~X(I5;|v}%!V6VcdF^6C`C|9dq`uK<&aLnzX-sq#FF!F(y=a&T}lC`Z`Z1!cz#MgMuD`MuAtB>3up2fEzD zTM@c1*6r1hcq08xNTbNo{D8}oe%&ZX zIFkwmHo06K-OYK{)m^jjeA|3QXd_Te=w(S5VW)jDoJzked3fBZ7S)mMKRurw+y0`D zlGCo)r=(|0vCmph*#IN|*#Rjpd{J*q?Hb3a+CB-5yQK0%I_RyHHQHSzTv>m$^T|Q7 zv^c|DF_qJoLJL)v+D<@UomZr774!%{(*?Pbn9r{e76-UC;}q&^ihOkleq7`5hPpo= z|3Z>1^XR0B0V*BEX1dLQZE<2a?X#~3G=&3cgTGAcBj1tRCL4XU!JBj?prucZ)=7TF zZIm2>(6iZ9QdN z@0S*jcWvA8avj;c;;`wS_VV|+%ST@;Ur(5*V7wzLHNS0;-HMz`Os= zf=^XcdO0vh%g zOealsF>y!bWyKmWHI?Hy4s2W{mpZsdfX|DEJ~x+9hm7zRJVsUS@zmrGf%;L{Mc#=d z`r%Im7piWmJ6?-Ph#dtMDs4)n64~x^Yu4e2F&h~g=>KM~@&CQb&nqNN10iLvc_tBz zFOEMgqAk&GS@%AiBQ+DC{+YPCd|}YQL)eoq*_e7VkgV(d+FRP%G8(aW5IF$Ag_l15 zI{hj^6tJwIO_7!>^VVthZbQi|+q{N*6DWlP{k!jS$FJ*C^Cd-&M7jBb8VkP)99d$! zJEis+#)}Gxp~ME_<^!LS!`tTM9tz1cuYkH)-!#2=zGdsEPeXSP{97~yts;b+TjloSA+m$X1FIgR*{|6x* z|9KTz3mrNACjDNk@i#Mh6WH-M21M)(OcwpMfd5;cJ4#XL%M!iyY+-^=@%7;EYc*R` z`pD%lFi;*rbN=vrJBaM%nbg~x421!vCybjT%4g^9Q3cZHh zQL?uESOS@|_Vbr?eEr!Ex#HNS??MPa>Wla3ewJ$-p53z-pJ~fl?Gdhsxmu{^#YvKs zT*UvQH?`FDS8s2r&{GBhSig%kR{?RnQE)q4og0JT9I(G&r0sJhIS`U>@jQTTMeBsl zY5KY~#AKQg@@tz`I~ctw1j z2F%97vij_JgfLznVnQ{|tkKXAFdN7LO$kC*5|d|DW~ap9P+2nV{m5(m`dGIP77|m* zoOCLgR1veqi;vf%znK@A8W}QJXQ8q7U5QWHoO-kBkB#4)opl6k-*|)XQ$;0G8$!7! z;>`pun|{aNZ1m$3tYwOO|H_d2*Y__lTr5RT=H0hHi09o7>&r%Z`&{cOZ9wuGGwm>X zR$XU5FYXNeAx4R|fOZK#&ppIGJ9`3;5Snu0?d%`d72=2Z!7B2%_S3^aUCqL;4`2L* z7M}R0@7a*~wcj#z2#~C+Osse7?AYKQTZPhvig1LGip)@S_}C8EmfO|UIWg8-8!pr} zi_vh!*E_qwtG@r1;9a@P5#Z>Q2lz|29gZCxSA~^Jy`YDzhP)v>_c*F$-YJ(MT#>Bz z$~?hiEYxL<32r28NHLS(T5z9}#tk8cQ}`EFm-jm8tB$(e1sTzs8AS`)6Ya-eYzO%VH;aWWI7MB|yT zF=gN1X8H~`IJhWYZ?(KoFTg>GMJOsjSkFI9Z#mwT5L7ER_2bsfV6Oe%bBbx6DS6+W zd&NiW$eRLzh5(Yu*?B3*J){e`RAr!>mP%*!BIk(=;Si~Gyl{4BE)&%9<=uMox8~n^ z=B1;n?Z0Y|MT>FjLIqL5|FnYqpXssYoo3fll_FRtadB$c=%(@2#ixd;-N)cWfvr7n z>d?Ng!568jI3mX_%i!Pb3TQV$tv54T9 zIfM1S&@1NppkIfo*F1IXkzcB6$A7ERjz?K991f%wO(feF_Jz8v@u`}y&ZbHmJh4Y# z?p8csw0l^6be~H3fiJzuqD{LQe*N0p_0C9*U2^&4z@pdqc~JR)*G_uL9H}BxeMRhN zJz%P&oedU>-0Jh>Qo3+By=X1jQ8b>(Fv^M#I4>X!x#aI19sX=d)W>gEWGn5lSXEQu z`iq4zn=f&Aag14D#Cm_303JNVX?=6c*!{caBSQUnM!wt_7xli zSV9F)ivehrgk2o3ZuI$SOOBPBRt2WwyrbQ5y@@iKOU$tn(WItv(_;OWyvh4V(QsCZ ze=AyB!|NahXMzR;G`c)t~f3) z_Z1(ZC!9D_6v$_h&M5*jFxMhGQa(W1@JRbPi@h<3b+-tw~Zo;IiSwPz* zW>qM@Xf*{U=!Beyx_+yutUF@G>GRWE!`ivf=;c|Kc3L{c)e=&JyI__TR#&o}5h@jh zjGvM79O1DMX>vG%%=`B>8_wPjs`4N?!sa?X?`-2Gin>OZMwjLo0q68J*Z`)kxk9YT z&YPMPL~TO>f}0>O_o8hj`Jv(b?x|( zvb`Bm{TR8rmcA%r0wrf@yt|xCJRqz>E$*v68Z z`cHeET&*{O^1Z#=QZMo2z`hf#oOTIA{VZBoWqZPXVfMQDTe~aMTQk#zjT%gn;-1bY z?(RCNN4ii6W@g3m5skr#EGbDD=G=JZ+ypWWV$0>-Qbi@<14nUhap$dn%wAwm=autu<(JYzBB^#oc zKk<%>XNH1>OReixiM^!b_sM6pR35_0|R_-FzkS?4<$eG!z&GA-r4_3N}F zNwe955S3+!iY((<6$?(k)JEA7k)(#&qPcaH$JmKzY#^i23=r5MhnP*MXc1!pk=2To zidaTyI!C!SwwxXegiygH7gC|%uBx>bRpCa6t}@nLiyzG=FO^E*A5_QYO6f7ZL0~Uw zUK60v63QOhV~!#dR`e5g;huh%AT%UTPrmGWS0(h$JH^@Bk&{t*-h@wGJX707L8zV) zwFYy>41Q+d5665}*T8d0nywUMqM>OVTppa!adv{x6v7&fXPPLWR!?XLQtZUylX!VC zoU{T^6NC$TJXMScVj0HEE9}y|qHkigilMS8(QayT5-_pWb#a2$xfrfC>Mz8aK;x@E z)4-cP>y<6W>(4YfK~1dc^q`ec8YahBV@xxq$#^kFE;<`BLOy~Xhyd|LildYIwW0i+ zOcW$2PDnCEW{OK1T#lMWh4sr*SWmR%_p)u4`mA=%;9@#zRG>H*R}LZ?nqQewn<^)R zNM?`xfOpm;jvFBu4a!_{{R&yFgX_7_ST*W3#lL{fphL>^ycU{6*Us*K-$)>EnZigc z$}lK53$CqtP%M3!Dbs*-B`@HYFW+b|9bme3pegBCCj=L}%I^;oPx60){&)s@CgPZ& zHv9+(V0nB{ke^bG4I)x*WBQCfi$#J9p{#m|t@Qhis#j|z|WUs{> zMZ;)u^|N;iu3MDh#D74YIpLM%gS5lTBk}zgC0Oj(vDalHrs{F@T52%4vXtKA*S0B* z>GD&qgH5I-%gd_jaFTRnN>LJbyo2M~gVIHgvRn{WR>zQt;rHPnwU1{${Wr~B%8HZ` zV>_1j#2aqmN$3a$ZT>3$;+T|!KfC+7fv-v{Q7&EN8YEen0{4Uazg3%TJ~~K9HaPA1 zm{xa_eld+TrP1d{(epb@Jtk{7Soe646fM0OsZ={{(B0R1d0b#HaOLL1rb~qIU&dJt zWeB6=B?6*C*PgW;I?A4(-(4DAnRk8S!Fs(LY{-!c4Xx;x8;2?+0SS}z3=4lpeF>3W zqEyPi?(BLU`Pbej<+SG6AC9WVW)(pyLg7qw)@r{)M(AQD&^d#nF*CU+#YtzOF*+`8 z78ZtZg7YC4D9x&>yR}Tq6 zLV-Cl?`pWzZEgLvbY5AnR34c17;79Ie!1Fw%;dC*9%w8UD$LN3&2a8dU32^R>0O}U zrpPe7Y&Z^0)oo)S$g55r+Z}&YHLxCG8PV2R!~}Mrq?5H7{9-Zcde?ZK{Zf< z8adYdU!mmuers8L%FP+YRi9O!qR;8U1x){XY>m2Tq)rBiUWf#_MekgSq_A@-f5PH@ zDZoKCcC~eVni9BNzfgClk@ZXWhgL&s-v;D{I56Z?BZrwSOp31%Ho=^e&76AR9&o8y z*FYjo-IsA-I8&GcjVI03A}Ul;3?n1cjGQbPmlPF8?g^iGdhu=zTa@aSH<0$vj6^0x z#;5MCMCp1+=W1jLAMuUMmn3lHYLbyfj#?HJ<{x=_@imn9_7>Vr^zV8wNl?#(+2g|! z!gsf}cGqp(oxOw)S;#n3$cSw$BezF-`=#l1!)%2QkTVTrB@ASm>eAF(eIfIG)|_D} zO1fm4Wa?6UjdEM1JouBErHUa9=qzb^Pk3Q@q1{)UXb}6V3eM&q2=LX?;QibXTpoCr zcOH;<_QAfVWt)>Y4a%js_Q=Xqw5e>5tohYOyJ<*lqGqO(VLS{-dEd3ggaS}#gAmT; zHa6%YWkc*?G_g<09N0f{lFV}4d21dyb3#BdJ##{uE)^U=PW_#aXW(}?DE!?&GnJzP zWCn2_ZDW;bCC-dHN;3*aD6o+2gxPHq6Qij@M~ITSfX-#~e3D@If1sKSV_;@v!0D#= zmoBj9{!WFZLeZeaJy8VZ++f!tk% ztSc(v6NH&A`%(OfyIOfg$Er)NnYMBK&*!pD;kLt9HY00u%pKz5`_5NZ!ZJAO!JIl1 zS$OfPRaR96hbO{5JeM;xS#u^l!!p#7L%FZ6!GtYwrnk3I9c;r`!XQdT0!F5gGQKRC z)nZ?(pRFB6{UCH!3`@QkoHD%3@FOGBV3cMd8on4($WyGFAHJ}hH{?^*N!3X$=HsF+ z=aLj5;Es#t)52=NfyG6O>)ORNvvBnUt7O(+a&op(EFm0uzp{4;j@=Y zs6FAYIk`XLq+xMV(#+X1lLIfwPN^DI`QU=Qy5ZOvzBWmbESxJ94IwM2u0^PMIljK!u$&hwm>d6{{b+*8)Qw5nh{yC$G#U&&LHSiq_$tU{=D13eRXT#^~bHJJKU( z#;+Uh!u~wI9K9-577h0DM5&^3L7N~!<6 zxNRg7uA-_l@PxXUUBf}AK5eu4Tvr6QIk>STmZ*Xqw<641gPl-)5JTgbzF-Nghk=$k zgp*C2VWHf{{33N$Rb26ms|u+2TFtcOVu7j;3>u6wk@3tUz<+v(ON9x%fgQHKLyTH%xDc01K@~` zPAcI8&esdfG*=E0v9N+cWqf#RnIi|_7eCV=oqm$>L!v5w)h71y9#Y?88vyH}y%+#T zIVQ@&mnh9Lm6BC}E$J=aakqkELF6!1-WXyYC2lBMCcwo6vu4^}W6PXx%gj)s zZI<0XK^bkN_U%VLHSD(7m;(pmpH^V)oHe&tnUuA0-sfJ^t|}SgA&_X0B9hw9^)vHJ z`}Xhuu!D3%7S=~Aphx?|pBM0P)!`-ugD=De70$`WI=-K^}l5x{BQ#%w%Gj`$S4EE<=p1aH`vhr`+CLp?P>oho4RBF z<9d>2H8qzeN9BQ7=NOm}dOUbhSUq$#hEJpk##_hD5yKlty9S$0CZ`?%d+v*wpr7Sx zY9mnj?*fi&pdc(2o^GB9XLOrc=(y#__^#Zl-+DuYd$Dk&38jhSJn8=n4Z-U%wAw|5 zlnQ7uf2_hu=Wo}22r05VmU5RdKN6`0>V$O5wkJ~dX_!5+jbG1k@FXq}eLBg;F(o=0 zocMxh8%|ERMU}EJ;R3rg)O5DcxQP_;>dj~x(oCjNs>6V;IG4Yy1zIFh%{#st8eeY$ zwRU5gWU?5K*G`3_$%!Z-?gw?X4Dy~yWqOMA`yanIeEAfaw(zC%UG+!rT^_fzYVqWc zPB~8E8~APfbdGu;tMOuM#tWo?HAcPyjN3FG_okg!f-Mo(uW#ihPi&455K10Q89rOF zBvQmL2&0HV(25&Vy3DV0tuizfU)3(<-Wa)=Y~8U*l^rUvEXUKhV6LNcm#8GYlE6eQ z#W!4ej3Z6xqwMXN^Y+5XD{;5X=o3i1^t~Bpd6hhzNzTRJg_7JocwWhjer;tp2cfSZ zq@#Fn`V%*Kd&H;$TcY3~RmX%ozwU`8d)wF&$d>l&e4$IIc%gBjqY#rkku&;d-%|-m zy+fVZHUGe-+`rcn1aC(0AqI>ELgbB&?0ZhIFQ-4bdPU;5L}#tgid}`xwXXffarIjH z<*Yx~zhEOT9eR`TJW<2!4YU|i4H~)kBz$v>H{sU}bKAjhtw=tGbcSxeB-W60$<7&b zrJup!txSc@kT*NzjeQ9Nr45EP0M3f!yvx#uzbB+EcBxwYxRiAr5fBQ0sXD$ml1+!7eXRQ0}bfseP253pfa=2C% z3&$G-QW9~{_v$$gHpRq{#LV;4qUazX(c--^}0?uUDsFQ4>+14TLXDom|V70{2=` z{TnFx-P4&ygW$_9i5j!*){;=uzWDfdfh3Dr8(Y3&Cc@+G$N%C^1BU`0yKsCY-dc<# ze~hU%_#-peP?#xoYmjn91e?)`^Y%T1b!?6g3IfNal(YmQW~vK2T-=fE zrA8j!FYRTh3?feN6LO1}Q3V~GdTV3DZL=0%G2z(qATLFI+qsNqB5E0<{ts0@NTJDv zwu=Om1=w@ZWTk^WbcCnIj%&(@Y)UUZipCYW1uztU?F3C^LSH!}5eVXpD+_RJh!}S} zE^$iXmscEwL2<0{F!JJUXYZVn&>|B8cp@BcC(r|-ByjR6p_P-{!;vvOH7e~o{lTjB zFSV6hbQG@JZoG#R<<_(VLUUKo)z{3iJ-Dli7OgfDMi^AnW7YT_U~1|ck_O_opXb3% zA`L)HdE&|8oB;$jrw*@3$5vfI@;3Q#8gOSe&$tMsD5p~jnNg*^LEvRpF@ANHuVgHz zR1l^Q!-k;QX#i^xr+V#9;OI`y0i)>n4i+vIcI;wuV`>ZXZyQXQ(>o#c8vPL`sRoYE zPxRNopTE=a$D~1jR4mrBb5wE^ap0o4n5>`ZBa65fDokJ(GWsG;@QOkcSI;$wu2Br0 zZ;*lDlHXWn{kW*MO%;)4zM_*$rdA#c(c#l`&D)Me_cR($HJNrghGz3}49l4yCt;s{D*q$(+H6Dhc-E;%Dwj8g=i zbt={aDXX1L%~H{Ewz8xlUwFdLuD(1C=c}cmAJ59la>j^4)kh+&6_iWr5fiEXf(*@S z{POkjF-DfEsv?C}aK^VnU#ED2v5DMkw&B|gD&E%eT zM69T(XED0a77ZiiRgEIi5yXfYG$}(Go+z@IH=bJ^lR6-3%bhAT`DP&fU$a&H^0;9- zUtO}QxQIC@0&yK; zczo>pG~oU>kcKp=bb!okFovfrdt8njrwbrQyb{=**Ub5f(2brRqFRdWQ8X>cjBg9Jh zW-`7Z)|x#bxO2by;7$QqR)hmK*veI-{w1btw3RAQG2JeWq0foS5P}8X$f;KxM$=j4 z=1Y1M5@2JE1vr%vT=AXQaYC@<2Kgq2?rL>)r{WlYMhs+m^%`4eCCeGXW_XTe6Uw@n zMEB}eT==$q%6`eb5ULR}DI0>b3a=(1SWhWkRvnTcV>*q(oju^ihN=%i0GJItDp`8| z1ul+r4J`~mORxit?)=ZyX2|m)!lx7mXb_m3b^7)j0|=7p(Xw5=_x|;Uk%7fGF5vB- zPYRPO6#t#^$#G<>Vz~d%2)q&b+EY_&2q5Z}451KuH69>)fCihBB(tCV8K=~8Bxe|M zfl|R8Rz}@3qR%Y0lD>qyA ze*fkY9q!CE$bmTIudt!ivN^Y2?)lEWf!#q?Df`5Y!$ilsYk z`}*C#OP9zwlQECYrJ?%rFHyef7IfO)L$DNkt{p+h!uFRBvEI*1&5^9V3w)Y{)ZXZe zx!EkO$S#YxrO+*hDl^?sz4kymEGn1XAF!k9A-AD8*T1&QK@aAxvdfG4J+0} z+vB}oH;)}rZ>cQb4N%QRP=-*5OUM@?NY-BYdoz>BeK5Eq{WW`k$T_{dtYKk3Y!Qz` zE~(9fg9&xdk0ZS>36nM@y6Yr)Fi^d5Xf8{nKm^lLJSB)!q2P*F#_9b6B9_c#uPTjl zzj1A+IVXop7f`E}XK=3Y=f{5hg&yz_>mkRXe%`HB1f5q6Y@D~G|)>LA$ zY&k@swsXNi0)u_ObCv3LShKt0e_jzlpr`E8heS%d=Vz_YWCGIr^^D2kf)xNpYEtGm zztof9{Dc^@Ta1N;jSV{$2%#x|*g9!F$_sqOgC~!5^NVo{z(h<85<37NyRjkHPp>aY zY~f?Oi`*;an%A<+2@l+#rFn8;E!K{{pXyd5LvmQ9-8BG&Oo{(#1Q?mM_YqMX{bb=v zI|xU0(@TH>n+|iAb#&`3i%>GPAwo%RW3~T_Eglt8G6MZ= zjst7_CL9f;Oq1TbA__K1P1NXEnka@sx0B|b^5MvQj3q>~UOMQ=9VdGglF)`O|Sdh#mE@1B(L9M=LpX#l^na>iVhLRdQeb zA|`;pU~R1A@dh27P_jwdm5d8ml5YGGu=T5SdQ&r>@!e8Gs8h7pP;R+S1L)?4oONv# zmmom_;wblWMv5l+=&cErszWT+Ty~slIb-IeP~6fd3v=z6gO>~VAdyLm0x5#`E4O=j zEpMIxfdurI`;U_*8%zl+tqi-G1nuHkor^aa`NVQ{4+yYwc3?^+(3@-MHV0ac^M2la zzYOu?G&aT!)!FzWF@{t}E*SFOP!;V@OxdBu!1~aB?3;A=LU-oBoAswYOdJJ{6J^v-S7snL?MCG{(tv{i5rg4)K2 zh&_S#`(S?8*~C&$dy>lWvUO92E1FD8oaGZ)MAY2Qp+MW=s@v~pr2KIUj74GO9Z&Y& zRmh=L6*`34ZyYH>kn$UEtBq%0Lnv*{)|PdZKACU6BhnRh>2|tXv6-Fku)`lRG%Rba zur%i&kE-`t!j{;=yf$^eGRJDk^UX7!UZM0oPBm7nB5|3$7p;<(yh8Cp*?Q5Wdk!r1n4l+kok^KAb8PGQgKORavFm4u9^NjHUu znxBBaQL9Q0yxoF<)25l)JuMb}S=Jg2eZ@PhPT7CigtC2ZSPwp{LuJEp<-ajQHkMe4 z%yrj!L$2FPaL(oZKQDT0acp@pOI+I@2)IvKcvGdb!H=d_gNlC&&73nh<7al}I|?2dhDqNUp|m)~D@fBotoIbpDf#C1%!_t%YBoM&JRm}Y(2 ztEemWNPD_wBV3LfH35);EPYR9|9g3oOLz4gc&kn7Pv(wRartkD9MGuVS;n$UsWTPl z?>V+$FJHK|K4vEA(1p2o2l`Y}YkaYl@7k$)^2yy?v2ZpbOYu8f;;w;XrY#^_Ri^Or zs=zVue$df{N!SX*=y;E5eP!y^dAO)pD&;kmC>Xd1N|^ila^z40z|>FMf5YHs&$eribseQ6 z#5u2M{zH+f$h0+a_?%=XX#O`9&dNpxDmC+cK=+?LhNgma+x!}tL97NUkJjo(WTM*2O%htokKYL6O3V`8{ZvDxL*oic zF&RM3d?~Mg<@}zA@KEK`t|GzS)&Yd-n;rW?W#)&$|Hzqx{o<%0!M^x1 z8_Di7IObZh*3d5eyZQ6yKZgGRrbH)COOCKYssm$%fYcP0R@H|)dU95 zc8T>&LZY0zzs>D^yNr^p(dbt_3EH8FIgj=C^nL=Pb#%DS-gjXx%T?^$Do@5%>{YG_Z6 zCjtq50~$FvDf0s#KUIB?o4iujVcq1rs~F!-KZ=Xfp@^Nm0Zhznx7tZCXg`I%sjiTY6x*21(#{5_{d_wV_SD>Cxn&9*~@+uRdJ zQt|1bwL(*eCvk5OdG55%K1%Tx-jOXXOMQPg&lL|B`9Hq0J#T54v%ISMl}Sew zHBH+Q+`mS4e9mJA|8!0-^6)*j{k8(}ugXq+{`5+~MxAy=q;}w6tY<5M#h8M`eGVT* z22(ML_SZItk4_uK=w0+3A%*zSiv~m(sMnC$3jL3WI41d}hZQ?!E2cWq_@os7X{>Ns zrM*#HBXw1>Ve)Kn(b`Z+`QkL5@)M1>TV;ot!0jOoC!14UFAcYn2UBU!N&)~uIPVsg zGNirA%`OxdU%g24q{m(ZN8qqQ62O52nn-z0kTqA~OShE_AS<$5-pu^J+E_%^FZW?edxxoMUb>KgMzC4SsbGV+Hyxq3J(=7a3^>MN0A?#5lgo`-EgC>; zg^D}BQxBdMr_I0i{aPy5^*67eY(x-vG=O~PgS(P49VgMRbz>%Si`34oyrXTebll5f z_e%(*SE|e^?JrwHz`A*D9?k{tlXZS{p2ibxGwHDwsu;DbGAZWr>QfS0r6s+sVKFsp^C8AGKj z2-l)RBg#U|_*vxwZ?U|z(1ommV>j5zGeS1bE|{jP4)y7OOt}Lt?x14rGCd1l@-!) zE^(;x^Vg7GBnUEFKc~ev~dex_s_m^-Cn!cI3IF zQWUxNhRD{O7^R+tP5sAmb`u=JarJuB{kfBN^Ow>tNKLv>ZiNsY{S-g>;SPp*k`@v1B`cDgPJ z8QX!MTpeL* zFc8@IPL#w@p!reRku(hGRa(7fi-+Jvlhabb|08$2`xpEKy;W9a;ZFCtj)WmrFbu9UcqCnd^~3&XjjO$xB3=k9ntv>A^NI%!{w+`cDZ zukF5k-8+@9>$w*VjbHp~O+qMgtG1J92#%P3nvSXH?-A7&tNdDt1gn^EVMt>%T$*Q< zGcgcLN-9p+3?HWnV_8em@sG8|7NLNJjvHcQftxp>d+w4Q`vk3o^z3dQ45J4Bs0H=I zE-vLcq81Db9sbl5=!XY&KA*6njdJFIl4d0Od-q=qqx2fA|GV@7=|&I{8mztp{2zvh Bo+bbQ literal 0 HcmV?d00001 diff --git a/data/tplyr_adlb.rda b/data/tplyr_adlb.rda new file mode 100644 index 0000000000000000000000000000000000000000..d9e628c98736bea9e9d8351760a850c74c3bfcb0 GIT binary patch literal 15769 zcmV;KJ!Zl}T4*^jL0KkKS)_g!A^_)hfB*mg|NsC0|NsC0|NsC0|NsC0|NsC0|NsC0 z|NsC0|Nr1h_~L`@=p2}k@O!P?Jy1}=$>Y`Ui~waG24n()mJZ;P#Pk^eYyk8gLPuV5 z8`F@h2HY5RfCBF@dA7FQo!Q~rp09uf_uOA#Cb;hAYvegS?exvhue?3I)E;+py}Q8o z&;a|P(?&qh0GKAG(?*(^8$(Q{4NWsikv3{iMod%5rqw+Y)Y>whr-DyY)be^w zPfUYNr3{*4F^YJmj6*V+sp>I33F$HkKtUi(nIVKHk~2`J=}!|7%6Ow@siByo(mhYo zX*Z=ZGzY1&o~E8D=`{5olf;`SGJ0z@^)wn98ZsIh0Va}2 zLYqWW*+;22r8H#q1Hw(IfYNCFQ1t-yJrmUZQ`FPc4^Yh}BTX7TL7)TF0004@pa1{? zpa1~VKnJ7^0MkGKB=t&?B5I!XQ_U&ldYUGUG{k6NLq<&i(@ivJ0ia+A7=efl00Txq z0B8UJXaH%ZhJXM70MKG-pfmsxDiDK2z!OtU1lmTYg&DOpX^;&vm};MhX$F{N!8JWc zs(z{ZXj5P&jHY4_QK^|Q6V)>(skBpRh-EgDPe^U4rY35ir9Ck+Pbs6?h||hur=(~i zNeDqQ6G`OSfSX3Arjs&FQ}oRyj7BDy0%~n3lhpL_GHq1HkgUBn9)!11JRv7jFgmMmV#8R zm1VS}3u#iswjx5-wY8-RSe7!{47IIkL9nQyX;zln(w4-cF^YBBxj9bmNDh}>-LB2q zLAj?*+nIIF!yM(+(|1+dI+MGuX6@Ufb$3gbYq;RcWi1P8%Su|K3uSDzD_d>O;oYO0 z-4R_ou8nX;bqQV4Ze4ZN(RWu|;5(-~wbYY$OQ?)@U2;RWN)o!=xpeN`b{o35a#u~x zaz{zr?%jsuo!!cJJGI`7D5=<85S*miU%J|*`{!+I<;W5(PlZ9%g2@ZIfpc1X5|4tB%~3IgTm0I;#!4?WY4WHimo{W z7o{$dR%V(q!ivKxqNzwx>p~%2tfa|~a^k|YFkG$>_@4_a4ok6Dh_qvhOHnZ^Mm#Bw zm{TPdi%UAaVzDua(X7zMMSI1OsLo*ap^0jiWWyr2Vz8)fQq`BaiDYW4sf9EeVSv*J zaZF6{FCdkE^_RLtdN)%myEgyR-$UXZS{G{)>#;+yN?-IlO?woUpFst8{OsQu&SRJF zX{0)6#nLSF4)aLceb^H|Vusz_Ez>ZLdcc==ehT^3+f<<2tSkwbEG_bwh3%f^=pn+} z_p{{MZ|vK!0^i>V zmzuyv3`LAm5QGRx0!;n%^=7w6pP!?ks*JJHn?8)@G8m4OC=Kl>HNnW(i8}Dnmc6lj zWV>uc_47v?_h5g=8srorJa7O1BbUJKR#{o`-2|#&hsLuyxCqz z=Mc{aA1(J^aqqgDxqe%(?Ylma(cT|9bIk_C?CwDqddDQl=UOThI zNjxt&;m63;mbF$fTGq5$_Cd>xm_wP}-EjhUbjwO}j}6D@I^*2VXg zM;pkM>#j${-o|*Z58(03R#w!l22&F^>y+l4(L_1iyPe$0y6$&$>U8U|$3$hBzjM8= zC0rK~z@=ssa|BeviIAz5h?OyJIZ#zujV&sbw&r53akiKwqnS%-i)h;~N7wp?mEFH{ zQ+_QeT*A4QwwaNmGb%VLt2(*!M?G^%x3|2UGm*wb0PEC1I$uTXMzYGMFAO;lOCZcG z_uehjBrQEM;nY!-Gw^yVUv$mDGiotny%!{N(>T#Fn{MLRdr}EhNtJ8}Q4qS`&YJ5- z)j0L-r!IKPseD-=!Aj2%*4?IDH$9ihbjLSt3bx9+tE#*4;h=U=Svw9%;_CX07}*TM zi=H+%c>6Zs(RerN`h9H~4b0skylKqAjIl-(iU9cEpPQ{PO8fQdv^pHRD*>HM|yd&grics>XW zB6eHgZ*XH<$MT#C0E!@>LIfCNL3AG2iwG@MF=nibf&Fpi(0KpmRlyKOrnHf3WVe66gFTR+)=Uox7*ZQ3M$KOwU(Nx zQ(J7ZrTAZ6(nt~=w}IZzBc3-3E%+SIpSo|My83NChlgv$x!fyvT2ps-k+~H>dgAC( z3Qz!oE;bc_Z=weYDG?L`r4kFMf`YZLYh2aGR=U%f3jDmq)KkjlD3-m)4|ZIlii(wr z=qYj*tQiRylBm>d7^H|P3MwfyR!mWNbf~etJMN9@Hr`j0L5&&>jA+>nl8ja)uo^Zp zL8BIK*OP0^)pDq+yzQ;iYelL`q}v+U)wi8nma=VBR;$TwZK^G^%ZiBEFp&_Ul1LD+ zK|)z=uMS%q8y48uqb96al8VI%QBkOkv8pl~7NXe2XxQ6w*4m}q&x3usVzbywnWtK^ zYcm`(S~YCd&1kyJb293U0ad0pd&mpz8QyP_nqBzjHI zO9>*7;jSKQed4;8iPdyv!KE$6uC3M9T_$FklB$kfCaSrbqji|2$*k52I&$V_oN`@a zxZ86%4&|EP-Su6ka?_?@#%>Fr5b5LQm&MH z4zz}Fvm-F8N<6*dY{>)Aq?BtENN7n`DIqawn^bpt!VOYx#5h&%Gy|4)SVl&1s8T_S zUiWzlu=lOxwHb+}fl}6%9;8ea6qJfdS`QVV%q@l*>dx{~$rmX!X(V^8R^pU^j=z;` z+z}8&3b1e#0V**>Z&%fPFQT`hv8u(2Dk`Mdv1qhZV?}QBdVbk@9@oI|N#Mj(w^loh zj*5*EqoG}8OlF3zQjV?1Pz8Vr0I(-9l5T5a)LJ7&v>LYc`RU%GuSCYzt=+MDO|BY> zJT1zTTbr6qkc(qz)pKqYNwKkGXxQA==3ZW}!uP4_dpp}bZrKMqU9Mf)Il7kXrNwf( z?#b2Nc4>37op8a;$mcmbxzl%c$T`yOa_-U1)VEzOE0x!FPOj^-OP!qSh7M|rTGVZ= z9~aNzzl!p9{ck6%9mxbi1QDdHl9er%l&L8zB$X;svQm<=RF+F*vPoqrda~<#x3Ts< z!`SnT?hM16=T7Ug4qRly9M10Rh!eY}?z&xcNOQS&JGq{c%q?xBL8D6+t%%B7TCufO zVa{`>b=e0lGGPv9cXh-G-P3nnF1jQ++`FA?9BjhY+B6z8v1-_iyoY(apU!8UTkT+A zI|k6GaPfksqK6GFXB89}l8DwBIEhvqxJ(Y!1}wyuFD25Y;*Je^F(W!w61Et!LJ$Sj zEW{3#VMt*aE|p}2lw?wgHM%{CAat4~>N`~!sZda&Dk%W~sH!PcE}>F`m7vKXQPJUu zq@sw_rGhAys<{;uC9>io1YipS^hWf8!U9@ZERxccq?VGUD@kQ4>Q_=qO374~$yqAO zl36KA$x=yaB(hS=cZ+T0+OF5L_W*=RM22;E+f?q=Zq@aDd!ntNUl@p@hTIhaMhc3i zaUoPx1vCf{^g@C08B^cTAR3T}mDNp59kpApg2JnkRR#v*jy2Sk0};`NP&W;RFMKRRUF*a!9XObt+OEsp$%Mcn9N|I zj0%f$bfZzN`NgW$;t?Amt*zcVnHy_qK@BCDC9PWVlFMyx3v63jyaP;07D5FuOI`{g zqN}BGrEQ6@NvIfEwN>e&M-wRn^nL^F+T}(E$ygMkV4Gblz5rYWA}{9r^CgfJE{HC? zrKuulkgL}>i`MUPt!j%|DR378t%0e$fF^2dR4Af^N)$TVEMInmpwe$aoDZs7@RY{()YSxE~K4FWVD`s)F_ zxa^z9t1cUf2m*+1VpBj*q+a=dqq6I>uhC;w2)wd=@HliM=HqcT9b8=yUksj1M+fJK zRu;rnj=vBp0*--WUUQhz@qauoEJX=iQ)iEd>Qw(YKhGe2+EMCYWPoG>7^`{LO0gh@ z=*l#&vK)H=xluz4GGV(On~L2ltaCo1l{FZm+x^;3t?QAE1AOTh`1*P<>d45kmVh3{OTB zSU$%{c7CnxLUwKpGWl~No~9jYcM5HNS6lKnU1u+aba}>J;|$?bZD9~A+J^gSJ)I>> z#9P#ohsyzg7}vGC-^@-s#!?o_h#w+&!Ip(CS;P%F4+trsoPX?IG~mt%D-5I@QUTw9 z{6OOp8;;L{uAo~;=U3s=w80DluDq<>?`4s zKU&}vF%J@+jETH@;`_ln?g-#4zw9D13gb)?9O!r#KbBtjfPH|W#ja1q)BNUJuK9N$ za(#^<(GcX$(_`QhWOHq8x5>MJ#@%Or>nWywb;m{4sXfKnSEfUv(jcH~B)X4aR#!o5 zC@$1wf(D|a7=tLLK!!-zB`lJFMV+lz)P570N5(#aE~hX9?JJ0N42%{5=kVI%E?JdC6y&CrDT${m8nXUvQ(s$sY**y zRivttQnFN(lJh&|0Z}qnE z&bPL}_6punv|^_V0gUnmAa(obS0xs=bUJ@={A#}q%iWGF{=jk;bpcKnhK;yEi2gIYr9$(I9GaqqEujk~|4R!LJ@2&}6j2EXdZvcg z-?iNkhu+`|8ER@g55Appv}=Wz?Pu|X#($b4;DiD4Mg5jDO3#Z1<)O4gpMlPUgcbM` zPq<(QmF1eO=k0@|9^=enK}qz1LR64g8V66zCF)g3TEI&dOC>^C83Lgw%H@W%l?NFr z5`&crs#3v3asf(N21j(Tl8GqN+9w>69HtYP@}Rv5)>*zQ5jK@Y(U8=GrGbqp0kCXgF-44Q zCX+=LB#I&;qC`+4i85pYWQZ(Cq>UtIV-i#zUX6U8;;+H|Pt9e3X#`VOy3a-5n!{M% zCFUB^+S1AjU{PlgfqkgQh{hKP7{U(^^=ibSMGOTV=}|(#!o^Inmmon5g$mFxSQKVm zV4|a9!E{F8kSc{B0TrxcDYB@dW#N5#B7c%_{g2LgU}{c(T+C)NjingRtS-SZ6QS#? zzQDw?xwvAp44=@4(=Vj7(;&Y6ooiqNiLggZxRrfZCBK^iUSsxMx4#Io$2;8klr91 zNg=U;(ExyjE&=5<6adjklmmffqh%>fh{{Ex3TA0dAXC_{c;%VyQMb&gqb+AJq}AQ2 z(%pl7_!r(bF$Ng05l%S^8RTF{LP9Vh7zuqz3J|!0J7`dfQ3O+>&-Ky%JeSFnwEH|T zmvlbsH@dp?S40kZc?eLY1!shyu#nFfP=$nmTI)1Msjvq88QU|*d()N(+zre|8!MA% zB5q5gNw~{Y+??*Nzz7rx7$(V5!q!XBE=O3CHU(5v1yKbQ6;P03TpCQL9i_=A#7Iy{ z49qGeWdtmhO(jrV(8or9--&Iuq4W-zdJgn7$)->>3$BPJY}u1bG--!XwKigvT~jrg zYa%1s2Bc#!FEKK(u|b9_W9ziWA%h@5hERYsrvaGp!C_n!NtI|QDT>da4>~--5F!+o z#Oslh9N_DWQDF>-_9!aQu}Mc{DBjt@h2@G2O~yRHx(Y(U3(FRS@sw(c&TK#$iiQO& ztVmGO9H)oxi{emvZ))Bsf^2-raZwD*q0>t?jd;>7urZ)zt;I_gxDQ$+y#`B4SqTeX zO1(>$0?GAwr6I(Nf_Etpkzw>rG5x{gi%WiyG`4`D z)0quz28||tV31{mm=`!cx;0x$T^f;Qt)XEs5d;FGgP~AjXppQ{=s8Cu6(qpHEPCzk zca`HyMy71aZ(r>%-8GveBxH2M!$qul#+Sf+m9>0lM#eG#d+)$$^zMX3*3$lc;S_g^93+kRJ{p-gbJwy!D^&V{O=Xy*bVSvd&4f8OD_l`$OK=#7oijBqU> z5byT6npfdToEi~z_id`#QGZ)_q8xgg<93CwZB7zM1$y7R=>+>w;L`w(0N6&=yCF23 z3XlA>gXZK;dOWLF`}tFZ)|*lIF*;e48!*SU_kTtA8!5N0-FbQ1+kNAgpAuc2bnmg4 zh1x1XC5-yz@fT^8b6erW3uZ9GIc@Kk^!;{xT*3S#eC1NjZ|-RIlSi`f4R)twS|l zdZ;*$UE5!OzQ=#|wY8TE3e}fA7L+ZSGOJ-{?ki(d$s}^L4m*FNwdBU}`~GuYe8$av znUX6hraG@Im*i(-6>?qSAPaS%_j0QNIoc4y9eXN&N*#`YIR?%8eW_D0J zVddqO>B`+nUqpVV2+iJNoyE)^Wb7DwN(%||=M`xTw6(B7D(EzT$W4)axtYwoXSa~@ zv-b9Nte$12NQX-m*L2mRHM3pY*g0()8N~0eKi60J?eUu~VQgljtV zV6@@;%532ABE5+dK@DppaF?K(%R74{Rj5`5ansza(k-vaHRZ!g1+bO<_Vw-6O+ZuCRJ$1o8Ytj}yvvdUMh3+W0Hmpe;(DRpm^;(-lz) zHBz$*sEVqiGb=MH?eIG2$JJ@zJbOLfHm@6(TU(&zx6*mPt+&SeZ28{VMQm#3Twail zczje}IlG^60ek^6%DG&m>IU+zvAx}=V}JTGo$dS@>DP;Ixcsb00bFVthZNB!*IpO? zl)RHHU0t4Z4`j}TROD6X{`EOGCmO)Y7a3bqT<;Q$+j_51ipnb;12dDQfythOX1r<| zs~2?j8QnF%le&W2FBWRIp52Cy=u}ggJs0u%#nbv^+;6)R*PVZpBLig=oV@81>}Q6m z<0*t)ZO0p}>bs-cb@aq%^>vgI?-rdBHx4(U`@YS{5vs$mFTYUfp^^hd%IM;E>9yd* z=a2Mg-KjvLetZsZapq#l7XkoXRL85a1A#z0c|r9WAA!jSu-7>TtDTp(xSjUveC~j^ z=SEV$*Oo2*{v@khV`0MU!UB)6`xK_7wArw6SyQQhYiKGRbY!7oCSA^9^%(eTj~bC> zt;>tF-s1f}GcSl~?)}qz>G6IqADVL)lU#-XSwRZf&rykj6)?#P++ySlEo2FIWghMX zs5`=>*}#}&rW>?r0s(lnt#6yq+`-N)?@g6@Nq*MXz{i#OhDldt8y<^EE3~wwvJphD zBUsio^xoE8joW>dxtkmhSM62nUw8c&gl!x8{dS^?3}_4)BBaEd0GnjeP++wf(FW2+ zv69+dF{Sf9$T_t^AVMlAAql245Y9E$Rox;O2!M)waIiWD_yFp0{l}cy1XtVXURQL|w*n{tUHud=YGRHJ?3LjQ`BTqwAsl=(?d@t+{ zYCfc6sM_$H?ZrP3=?VHhv&twrti`kTXy>~g;rWw;tWzASay+4>G%y&=zUQjPVn%Hs z<9=iP%&r#4IELYHYc$6&hkt&^(0FlhAA>n~pY$qn=10PJmS6JN$L>B@w^)^1gz4pc z{^q&LewU_TwHMcU@*Wf9dygOCH*MuRA4KbSWECP>R7-16s;a031u(-1QkArvdV_ct zi@hym(y{PG6ssQ}w&KaUUp|WTc0EaO=tWS;nv+eHm8j6KO~O~v=X(yvrM%ekbjZjO zB$92=3LzrGNeIYB3?v~dD>KH>`ns%op5uwOl4* zZu!qslb)tAMYzXoILCGv@*I`W{KRY9?6A%meB=QL<&PKq#aYiC_9E#-l2|9ApiuV zM@tysfeX#^O(DF#)|*0jo(gSE6KM=Q*A8o|m8N-+lu1M=At4|~{BG{)-}0HR3uAY_ zHCJcJvKOzgX7+6{io?&@3YuVeAptby0Dy#SDW$tQB#~3=95o>=09s&+7AdpCI82|k zA83b$7+ZH+K*$|tS0Z%axF&^&Txih$pZ$|+G|^|QkaZbpeQOxLJ~-@$zDWLJ%TNL?sw9 zQIa)&66?w1V7-%Fl4DH8qgC~fcfG#xS3zMCK$1cbLqe;GGrsp!dp>8>6_<_w_Lhe( zS}bZYP++~HuW$7(yuJt4_U{+!J;S4etBZ`|aduCz%hjo4k+63c6!Sg-nGPM;89|j9 z6_r->3UkLMsH$5=Co|0E3|{FuaJ=KV!wL5#D3tL=7=B4Z+XR{Jfj~qmM06(M4IiFU z3SopaZDI(XaP?CRG$o7f9Z^g^RHYFRq6DMfdGA>@q>4cWSjZAGaD3iCr7D3S$OMSU zFG-lAS0Gy8W9v;ouViU>{P{JtoUqn3xqA) z!+tGHhTE$wHjId1L@DpO+G7;uwj#uO`bwyx!`+_}bbQVmF;rC{^qnrVaj6ZXJeOv5 zHKb7y5YgY{f%`%okdtN}F!BLIVGKWTvt}9-VGKbNw=M!;n~%~khXX|-Q3?e%ESMl3 zNJ%Jxf)q+6I0>W4ngbnQac#<(AjtclaTduKps2=7QLnJwaD_fE#p8H^QAOiWXbl4ivCa8D5xCbph){B?0R^w2;<0}(Nm^eWkybwj?`~$989c%&lNF>c(8dUX6V$|6ymVS zYYaE^IkItO_+w`rWtL*P>?4YGo|Vr)ru4TPm(f3JzX42Kma?0^shsOOtLkcSx(?RG z(u>xu7o(2LqNyn@!zrt(fTp_FcX39OyP`5lh^fvZo?{N7nX1D8Kz;URKNCh;6nIlu zd{Ptnx0r5}B1??mr>;^sNRh}-z53rFtL--R^rAFoMlqs|88$JjmJP8)St|-`k+jQ8 zGHA&L%u6B!lxWmj+of|fg$)$SG*P6JV^L{Lk+DpR5Cu^gn{xr#Q7TLq11$+XK9Qeuk{QKCYSFAio_OL*=gE?lY*EQYcrjZ5lU z{jF zfSb0zqYp1FEP?^pYOT6|7VhNYw{@vJ=_lp!&7ReAVVndFvL_rtAHKBbM|oYOV}0<> zp;w{7->`__ss|EZV{f!(3ZQ>_T_+@6(K>|qd!(nc#Q|{@T(1SpDkxx>YKj;31Ok;@ z#${1MU}b<@Etm#2jecA}I8GomU4$%#z&yn?4@IZf8u}~szth2Gc6)>>1{l>8H*e?E z?VF8n8hxvvub%)FHlW&r>L-~75s>qHb85l$2o7{c@&X~nz*XKscLLsS-?Y{J%8C_N zFjW*hr9}&Bt@D5eHjTr8U9H$)Ll~pfk==(_CK{(v`8ld4OFQx?t_OVC)Pf1|z}J<4 zyJimmzj)tUNygVz`&emg+^0CZ5u~NZWb+}qt!&{SIH)F!-4Gnn0q#z z>mc!=@VDhx?BnIK338~RQ+xC5DkyP5pe!mNLpNM67hF6TdoD0HvbF*oVq-$VkX?CL zc4OY{S+H`oZBh zpb!iM54*#muEei?e9+Z7d1~+k5i12Qj7u~isFz4K@dED$hNTv|I+!8m51qr(fE~D* zOu!pEfjz(o0mNm^tw96}>wukb8G%A^uA-mZdQ4ykq5%NG6+=ciAbaBE)JQ^k;zsL{ zvezBttRN&Qt_a=88?X$3R>A8c1!N#(N+h2bAO{2a_w_{!tG7+n^c_90s=J-HG4gl= zY!~ z@litS0}oA5Q-Sk7W2~{8y*wiylA`F%c^J%TmWBY=L6H*_Q$B?XmS!TiP(X$G@&hQS zp@VAJMMev#EQlB?AXZhiR~H(+({0-7t5JRWKo>}vs`8%>^OU#~P49k#j4oGg4lO}{ zaAY`p#0;NlEd;2`U|uQ(@*rg_ftUJ66Pv*d`XEI>y}JbMN-0>yE@pK$uu^T>ow~E8 z^@qU^J1{-BH<)0Tc!ZB64OJl^WybkFt5H*gq9#}r3$;WFQ4==6pk5chHGG!8XRp!k zc&|6hx-nl2*V}u#VBT>cAp2kuES#vs)Xr1|Rm$iWH22|oykFX{?%=O+6W%>~Esv-Z zH|Trd$#QKSyTJONWI3e`D%z1YaD}bZCwd^f*!HMUE8>Jo&1&-c?)g0k;Ozb(l!w|> z^BywH^$dGGh@T>|dr^1|Z6uyiruM6Z9|{G-#x8tRo?d2-_Z z$NYT!&2{yvefMaHh)MIMRZ0jFcY(GB!X#GYDuxOr{AdJ0teLE_lrjbQs=Bth@7RJD z)2fN-Bt8H@?txq)VOU;Q3G&OLWSn5B^CJ<0>9S`17yFgE`%f@ z1-5rJkDqtTjVC>zV-wd+UWq9@;b-OWX-kL)54`SqyVhZTs{OP9Qy7bmlosSbymk=C z0t|v8-d^)^pmg=^Y$ho8cKj9#vZ(>wpGoG;tagM=GoeLmd4)Sm zn|g>ahTfu20@-yHC@OMlfraljfZssrH1`Zo+x_|F z;y_~`PIG%JIbbe}QI9J21l^Dv4AT$-rmbyZ%Lst{jkep*Rpc-mOooFb1(3=lB#4a~ zB&5({pwdwZKqkRNcsyS?91t9bY3dJ}e3YG1Q)`?IvfphO_#&Q4(nZoADqyZ8}`P?)1-=*z)PfBcSJ(H3s zF}RCv(&R>S+cLV+1+#a7#1$Bi&K!YcDh!~(cE^5kr3grJM?`xt*DY1VkR%}xED5N9 z{D{1AOC(aT5(L%jsDB9a6!Zq1ap`d;#V`VdwJY%*K;+e9FQ6wAyZTV&5FE4zZA1*q zwMCT!ULY6_ZY;ShR7Zg5<21mRzC_NZ5vkb71mVav6#p$3aDW+(1?>`_9*2n3m z&)NP8=ok5P2c+k?N{~YunER%Y0FYW1ZEyyg;1K(%fLoThT1O)4UZHgaOCyynNMns0 z=5J}_Md3`9=nJrZ3Ls_Li)07QE=@;4@6*d_FsAuKf4P*^J;4n;S|6Gl^OXE;fvtD~ zCvFVj4HZRtnioDZD?LO$fOzC0(*Nkb5PV|Eu@5Q3a~qAsO#RZ&0b0E_Gk-vLG;uzX z{$IG-atH4*9q?!DyM4ywZ;Kw}hY1EWyO$(s)h=lN(_F>)?f# zIZU5$H{0E3NP`Pa4xi)6%ody!BHsSKV)xsAhA~&14G+f*P=keNN+_Tov`L1z z|3NdCddY>?N|uaXYH~XPw3H$kMZ76m>@KBPtWJwqBJ>lS|E0B8sBXWkgA8yG&MpAD(!o?vvrHtIVnvL>SkVElYQ)@|yGO0Geik-^~CBxDD9HS1^eKU2^lF`LMnCy*bi}wR(MP1>cH5VZQ{UX0VX&V z2?+-`qwNBXY0jdAJh1)?+JIXJ$9vmE^;~<+2M{#@`;#K^?yIbS0jFea0dh`#k_t`m zhh7f`59&D3+iwm>Pf2ZVId`HCxE_!6{?pF)m%rhYz5pz|zk0d{#2eGI1D{`g%#WS> z&-v9q!bvSHX#Poelr=0 zeuvP_0o#XrUR3x`P0TElmJ^&p2GAd-?p}Ca?0h(mRP@I4fL^G(Us=*o{$rADz{dFS zH<+*|7zGK&DV+xuJhaV0Jhk^vanMxzwdR9dgVz_Hw_IL@D0W2xaFGJ|v+_#v8G;e&BE_9#0R# z+5S+SoS_}h$k03&>4<$G!ztm4L!08~tw^|glZ7++|EL{`9|(!PG=B9C1|aujO}?3t z1K4>CwFd3GZy9~OP*FW2GsoaX>RfI7p3W_Y?o3`=eCK-iun^1OL+TAQNCcBW>%+MZ zczoak|7PhJbFh3?bkkkI)2804;V-8^^ojgVIp2Xd!;3(P(Sace2^|;*l<8rU?N6>A z=jgPK|x1%2U@@;{m1UWY%B$ zp|nHy4jljm0QWpbd-{8wosQ6UgFddPU0Jx^E(@bO$R>rbK_5$&ED zfyEv{$*)`82b>S=52`(&9Aa_2TkIftgSP;q2>YW%0#JMdNbbX-HN85A78&c6|AL79 z1Yf{Ii{L|J9(+Hd#V4V!{RdXMGc(qus3+3|{X3J9l(a!dFT?pBC6&+9hz=Xnz7pHL zH{RzpcBho9@249io$*x3BeX0-w+{1q3yyppC_R?dm*r=Y0PKz*%>5pQB@a})(2MkZ zpVy=`djWTSJmwCB#Z%G8(++J6^W>qiU$9c?!-_mpgf=1iM)2Ob-}aqZy8>UUG!KM; zci%sS5_8q+QskJIoPGMu@5Eu)xV~)*6^AO~>(8xcTCEh4F#c~roQ4aZ+EML|zUM@G zxyQh+FGJVAjqw5cxV9IqS{KyV{c~wrK4-x~uNRr>AGXqNwm&g4Hc`fGD@#0h^0Cd1 zMSEW=SFWia9eWK|qvK9z$64avBL#c%%hYOl1z3ns@}>ED56AoH&XRDdCOYprsP~`N zR&Hxc@%HlG4RLjyn{=3Z06ZOXjUHrsZ8}9$UR>c&pU>$U0Q+Yp-j;WeN6@jK)WC<}*>|6@n91b0NU&_;41AA8Y^YZw*icWhDmi?TduJY6^?6P^N!yq%FI01n2{EgCuK|6c< zrv^TWd9x20U0tm9WfgJ*C=)dyG}sF5g>(X&O|6qSw~hL~XG4=b_Pj%^e&2Q{&E(gU znz^AXn_QUm4T5;<;#*%IHxK_mM2_pWy< z@O>|7j~v;*D-q;Od)%%se#HjxBhOW|WIPRwFkKaL+Rfo=uYRN)tj{_+MAfZKOG@Kd zqq-{lZ4>Kw+9{$Ln-v!sCZGCg^y*>zr`mS_9_Ot@VG#9)C&TE@KiAq6ZG*fFr9XS` zu2x77C3N*7gXxyx81%(79IHYP(g%tc^K^Lb#0|I^5VR7K1?E{z(BbPi)Si)ld3GaZ z+%`@0==Z=XRW?t1&4$Z(cIWnc0rUY+o8atJHHdfx7Z2;k4*m+ExgBcMrQBl~1CcHc@ zSWgiS^hR-_^81G`RGUMk={j?&<14PlWFh^* zyOg_P3GlO*rMQ#CKHLbHNQdk>x&3zlYETYd-HJb)P>SquIdm^mN@7;KOU@o@`!C!z>^2k*1K=^Zn0{*_kU~SUXr}7rTm3l z=_-$IP@T!)ditpeDphZU8*Iz*2UK;-W482MejcT756nLrdNBHj*J8kgBHd!qxwMgz z(KZ-NnF}1FRn8;>z$c7`d0%pTJ*f{D%cdm|kdXIn>Uam&4A#$Hz9DX%A38~SM&>}T zFo(M^IX%V{+&Ji}prR4{!565aelKLaDBh>bb6xMV2CVQ~`s#K?Sh4Kc`Bi{=Vad^G ze6!@OAok~4AbQj3{wpJ{IeypKTGO`0e=o8y zsB)LwqBx%}i%(6#>Q0R$4qEw6Squqa2%Z}O3R?#3AN`9YE#C-p!F`|nu?$(F5<(iw zJn0ZQ9>GG4WKU@fWA{sSz;cz4qf#0kr%cqQ7@Z#`v-@sGd!np*|OJO{k^vxzK) z<>X#H3wM5HG*BC1d%W+%%Ja~@_`7}As*8-aJlE}~b5=1=RC0(|4Qkqf@o@m|kk?l& zi4UYSIvAd!T>BN$Jd;^ULOn?ry;@#pu%BfARlx6m#Bmk}+b@u&E=j+RDiQ;RlbfV$ zp69djI-EUtSh$J9(d-XR&<)|Rhvj(Z66&5%h3W2;K2^aED3F#=z%LWI1Af^{ zu0aIE9@doBgLcedYc5@;>=cV~pGA1`!sQ7QVi5-TLxel7ScQ-af%p`(1Ogj*?OIRy zTp!dsHsx&lF({|wn{&tkx_QWOL3x4v)~uJcdUH(efS!6E z6{7M!3c%jM*ooPiV_JtYA0P}_0~)Gp7hy#(K)T_De0vm}p>U{J*rjg7gZJn>aX3{9 z8d&vW>o_F~lH}cc1g;&6*t0Z0peYKTT!fMmBnpZhtEzhR3vdKeWpC}oO80|cyiL6c z(EVCZLF`&Xyu_Vw7AwCf5BRaO5V7n?l%HXbn|Q-K3Uw%4?gTGbkFf~tm=*nx2=}Fp zO3Fd)Qo>4oLHU%x9 X5bJc^9Z7F}|KjdQrwS4jkHX|YA-3Je literal 0 HcmV?d00001 diff --git a/data/tplyr_adsl.rda b/data/tplyr_adsl.rda new file mode 100644 index 0000000000000000000000000000000000000000..ab16e0559185f78feaca25bae41279aaa12b5b02 GIT binary patch literal 11980 zcmaL7WmFql^F16OxCM6_LeQciIP?;%xJ%KZY0%^wBBx;C21kuM?IwrzuRb;? zyEIibDk{IM;<%g~&deCD&4`8r$Z}8soDT&A;R*l%o&t&-K#&8#Q&pOU!2#rQDe90S zT{XbJD(c@L;6I@L$NwKO|DR1=)F6SU%a>LhSH#8y5f^F0M^kYawGu_i;SM8qFvh4E z0NPdr*psEIs;Z@$!vu$;;Pc$vL=HCG+<+`@ZXi*yf`S$iaGp3-BX_i!k;d6@wBkT+ zW&v4#lM`4WuXLxi5U95Tg5xQ$muACYC}w5=98L}gz-P$uRM7wc z^S@{CCiWJ$@aKIB7=6jl5BhnzR|`efR8sGmJMsULhNoq{lhSY%bMxIupX?}Xd}g(x zE;crrofksG9Wcscu@S`MLO?X7IlfM4r9)vm{ufJD)&iHcqE^X`sJ z!-8FTHUKh2O6Of^Yx8x?63iG+R6GGmp%IOkh;ZO*3p^)p-$J{%}N`7TJky$@Us4x zI|C!4=>@Bp%=|gWeb%t|`D2`ii=ajN4oP*Vnlx=0Dp8I|N_VZVz%W&R=9} zJ2{&sR}N%@TIX2rEse<&f2Vd=KPhqwu{cd%`!v1@sd^Rt^)-1&%FQoosa&fC7>ZF{ zY`=Nc`>N6U^#E+B7IowOf>LF;$9XVp{CTc4F_b~h2ecns>K7zX zV>wyjVjIb<2(f?vh4El=+Km-nhhi;{AH9si$P{%hj8*(f7`|0XDky5{{u-SW@}=c? z-S7qNBoDb)g*c^48#fB zzW}$=k?(57GBmQRIt1I}8~o+agl(R46+nAQh^M>&+Rlc7xbPdgSqxx2iUJ&tCG(QAK zrhW}gh&SLbE91b{_pB;Z?TfbSnA;>z*L6{NWwo(A3XCi|8d7oC+1T(V1e|lSR!k=G z<;zqA@n18n0Y(<@aF1}-hD!-U=HeNEUwhS`ce*d)2X4L9se|h26txt$;YWOeH&#<# zfnaX3%m#dYb>Psg4)H%H*S&YTM%+q$zZq<)S%Yp6+5sFE+r4#xpwNOIMu2EF6&jBK z_qTB&B)i3y3Re^gv{y%gV+2!b+y1(+5AN&zB(z4SHQ!G)uP=uhY-4z1s@wD5v>w)< zXIy%kuX$~g$=5?hviNoL1dt{L9SJs6#o-xOCtN=U{f7{{1-;7D5}Se%Rjn!FYso)U zrp)JLR9kjGy-D{L(+0oh{0;e)uf^GL%P`|xe=zwua_TIweLR*h`pG|B^8z9YeG>A7 zZ)jO-hJ?M#>Ea6t@u;i{K?>pGjqR^KcY%66or=|fiR+k6M4wCJa2t>*m}Qe0B_Ub zv90uu6kAz@GYxBLPTuKUU8sFxVab!0&u+mNZ;$D{(mqLwT?D&P1d$H8nO3wtHRYCX zocdV{du?gcc76~w$;K}Ed3(6^7t3ptJWD1Y_wS#!Jd_3_tzLY1iMPBq7esvaDSGB- z$J@tcf*p-bvpdmQaR0yf-NhH3ulM}fE{mSNVQARHT?#*w!&G0<8WjBOS|%wV|L466 zjfN`P1U+*(ElT}H?%{7lP?h|0x#!{5mu0W0z-i%4f9s~zSt?wS_SMA5CXi&kSQKpc z=}V`jgF_@t6D*eag`hnMUu6!?|WWkW9dt9YZn{)&)?%DZi;00IA{^} z2?eqpue811`@c$!tx2(O*0*ua-aN+N1&`*J{VtcQRpu}Eon0MLLr|j?OsBvkRbLRa zM)&J_jQ9Y%0!;8ZoCJWd0mYG2JuAjhD~wZCjzNRK<&iIfhm z9B{X!AF!)Ym6PqR$2bcl1}fv|!vm?rV|v11XA z)Zz^-M3tnWvQv>NYRL{o+{&Pt>@-(y2Ll3awUo3%J##I6Dr$ra(zVzS5?g90nynZs zqHIXRV>KQbjt{isiVRC|ii+oI#%GEbNXSA>=y8gwD?*jHd)=~C(`MCCAGn>fnFT=> zVyJj33u-5k*k^e9DA8uF`e)kZ3Hnv$@hZk2n}_fT5P>*w*gYWH0eoP5{;otif}J;3 zt!5?{Btg+5Y*$g|2iR~?V9GgbjqhuHTvJc$fXNnv0=bB(X;C5>V!Q*{qVSQ#eM>v) zSQ7>SCH!tWn8P)#gr`P8Jd@)^q-$)_K4fhk946?>Nl`;KfpB?*3%g08`gSm{b zRB1*vjpqatQ}*=IoTwBr7+DUD68nuccjOdLhpF;-WxS}kXO=fp{$i(wpRvuJjqp?M zd`}Y-vmm3ZAG{5{bS?rjxe{H@%V7cp^DD`LOv+&Eh&WV>0{m z%vw*M=EcNBguRJkoTh%0e!X&^+HFTL7n}Ia&dB9=UUj-;GrS;hI&iRXRYE+~nUq<) z$oR|8HMjZxKx;iJCW0P)7->-!rwHtP|EBv*f9kBv?YD04@ypeN!_IF%eu;}23R+vc zBaz4wq@xLP#jzp-S?Z#-&?uR`HMn>Cr(?M`)mrC|=icdj^CpW(Qxv&tL~r1Cx$b|2 z%T${Wnwv*EyuGAHj*u$}WaPnmO|}4lNGQd8pDy!NKFtXK6TIX#zjD8REUH~!CA+{; zI*=s7VYKIxNpF!-!i}-rXI22YS_WqFYc(nrI@=^IVIjpXU#!)FqqFaH!1mLr=jxOXnBYyJSfV7Sx|Dg{ulUI$F+_X7~&?eCcNxuz*B# zI?64^XN+mlk`2MJA98HB*PE^BGyVCoIOFz;9LnOQ@Owu+X@a_s?c*MX17vL)UWa|8 zIauR)adDQMHHYFB`-;}e?9SGX1YrtGF>CmC&SFgFL}l>6{WH4>Zw6u0MEy8NdE(FW z(Jh@T<#R*vl`1E@tpN~8r3kD>EwrNRE_AGC9qUe2Lu;E22x>6nfe1_doD@M6*I6K_0w{to}D_z7+N zFzGCuN}_=jow|&OWvLp2mU2jcbT%?NY_ME5hY{Hj^rO0EtNhm2ymN>tJcy8W_ejbt zmR{~s8cy+UJu}Zs#yci?cd?a<$n%3E?sbul3cC{!aRV|8?%P z#k7eDveYp^F}|wm2cuak%h0fGRb1r}97aw$(Pzn= zw6RP?0==HGRJb7JAt?;KsHc7y2czAt04utOpM)B0gs)GtWb@^OT_X2R+u<|7{u@5>f$y`|9QV9+7qpAv>@>@}RkPQfJ%lLsvz*s$O4-g7b zV-kZ}a}B06xEg!5?76YHdrql=F#Om;wG{rwnKbmTA2oMq+^z#FX2VGrx_WGRrMfd* zU5%Kdb2-3RkRxawk*$*h~! znyd2?Hr2(vnInq~9hn^qSBG-}si@82)MR`l5}!3qn!BU}^wt-!p|P>?#mNpF%Ebe8 zAUIf+7mZmtsSwnc`Q&~gXJwXfOafB4^W|K<^Nx$?;f+*L5p7HDRHhQAj--U1d;+RwQ=w zA=-W;h*JJ0Bq{HPU8(6@^y7;INo<2ppznOg3z>)0`r*W1?GI1#g4bJKjtR}mE&iw| z!GdH`luS=}L-N;KjGU!935!srxzI(+94@ypl4EtIj`tYJ@y&a$H@ha5w1O9vvdbOG zggb$u3&g|G=bNP?6ep!FEYYYgW2T3(L>=|5Yf(i6b;36lSlX;W7SWe1gnsT?|1Mccc zq5kP(K#69?cM-wUCvlDtd=^XXnyEZ_-o*T9XkPHc%I_}t_%uei9EY2aLk? ztuI1|`xC+M27MNh;0?#^cpa`#*##JW1Qet2-CA}zAjcs^hfvm6X0NDs>DBueA=P(X zrL7iX{+AnK4xD%pd-CPMt=8t-*7(}!_)jmMKa%ym4hZn;xR`}%Xek>_MqB?r4rp5& zUfH|c>Y9{e5EB(q2FFB4o4)SS>1I7Od4Vv45kk&?7VdiW#8HQw2;YQHoETvY6P2{}8q)>jb&)9MeD$yA;Yh z*;Js=o6( zt72-Hap$B>W1c}P^$o?fZ@^24anxXWKYUNFecA)8`TBl_-FZk^6CDTQ;L_~ucJz&T8fIxa zES=xORnaLM+Y2oml!IGZvkIN41tHs!MX)Txc41I;5pIxzriHTXPZ3z&Vn;|Q+aZn{)6*}W0pwn)G-~AdSm*FnY^ZWd;5_-VZN2c=-Bd1 zkrJX@feCwl9&Pcp__Y>SY*)i|D>IU$Qlb35ruFD8C98)Zz`IO4(K~iePIGs{tF5!k z(@3wfe?&_E84g6wfxd^}{`=_uae{qno{ObD^B!w8VuXJXPmOIxlnh47SZ||@!!qT& za2n`-CsutnFrzH(+z3Mig_q1ABmhG8MD5;Ln}LQN5x zm)WStWa`X_#*fkCfKUA~Ztt|Q{D2GP;Gjd{Mz9H}(-qrND`Vp51p!P=>Qtp53>cAs zrl&p5o!6$DwDwMeb3(X?RhF{oFV66&k_~!z5kr}!`l1Q;Buqw_FnSzCZWpZsJi36s zHZx+{6yBM4*1Vq2pKJ5FN%og5bi@!NWN7?fz4pA%-ZSxRsJXEgtI4{!Ol>-HzcS}G zP}KD5MWx$RYSGd&GhSHmO^TJkuUNmhm@l<}rDebvMa(Ss(4gwS7ac=X?+_`m<~FzX z;?1Mn>Zv>#xAt?cl%c-W^EWJLobh)6X>T-uwXNsh2_l8%HldKmf95}d!s_uS_YTV= zai3(mnjV1czv}8{jm}N5$AYEiW9NQn|A_#vqkpHKnNt7f{JU}J+;a0MI`(LUq&%2F#n1gG)fum{(6aCmf9co^VwiDfG;muFnHOMnsG&a`P!0l4%<>e>EARyQZ zU^wkyGAC88_O>7IxA{D}?z%ra6C3~l5w{a`k$cWrD`yU(q)DTQ&SI9^T-d$+imfAA ziQund0Yq*T7(bI0x(XG#U!jl$8;j-%;4k7aB#q#cBZgpL3H6ZH4U(>*6xMU}5a)_x6j6OTWD1buwl9I0a*saCCtP zMu#kT&{JU1JlV%v@JSSUsl_&k8JI|dT+&7@)thJ=87Ee0wV=(KLs4rlVO>9F^xXdbJBfKNLQI1T_(CGu z+Y6#N#?|J>!#8U)Hjs`|eC$9-T`yGaz2?LG$P;V)b6UJ^hWSHvwCY;exr}rB`-VnQ zra1O(u>LF`Dk8=ln4$+RM!@;7yLGB!r8x<$c|U75<*OzQ`A4zH`eyD%1b57Ap?J+Q z|6W;YWnR#oDVuBcL@cfjwQS)Ev}I6$6Oqn^tmk5~x-T%segPI6t-k#@Xm7c6*1g8{ zQF(GvMM(|tj2VbiF#IeG2vH;&^n6x9jIYKomN&k6zU(M-!M>dL+v?|ifZV%U=6Y^H zF2=<`{$`m}mlaJ2ucj*hlvtIXU^7Vb<7&sNzFH8HB{R0%{>afGspbN%io z-S(+c>X`4u&`}C6V!Tkk)XG;)v8;@-oT&oIETn=Q9vX(js(f3O>~emFR`NUNuQt5% zHvB&T&SKDH9KcvAqH=H;?}8?6VGYC?i!CtT-*W|`2?jv1q)z*L@5h^67JN}AB^Az- zX2$&4DdvqP=JV#K^EG$In<|#ro=_kJWYYr%;SqB)McKk^Q>7;fV|IxtKF{rb$rK^{R7Jjz}GYnKl@mnVBgP z9}iacdMiBUj6B>aSCQmj6al9Z@ltU@6k(!0v4pg_)_#(CYa24>{)u9`{%O}1O^hgj zjBmAbDV0uaA~*gF9}|DQzdva^m#ws=#)<4}_VxBl_CvmcJl!D!76W2NC`2^82h1Zv z3&Bxf`CNQRf>tO9v!#_om*bP?=J9mfdOrSiE68H+YTDK85-Sn*e=l?@)pF_a2n%W; z2h^6RJK*-!tLLKI0gu>Dt~a*4{1s{^18i1Ar*ib(Tc7@xC2XV22cSr;EThN;DnOEF_wBUFzWjIWehRw0Z_)J(v8;$}U`0cQ3#AR9oS@J*8LY zfVVm#)%Sg>k2^KCpels{z;C1{isR|S5p^*jL@X#2rno{iX$NX3;6gB% zniT#~Du9k-YYElZ*@omH+Vtca z`Y{7>u;NlLm7u+yDQ-%Ns2gl`4gR(fHPA3f-IvveFfU1P(!w{;BvXBk-WYSZX=_~a zj$$?N0!7%TnsNw<=2^F>y6!{k`m38|8q$2DcZIsL%M~X{h!mL_MQn%^R*+k*7jaM@t8EOtH;zyt+{4Qwn2z>VyaD=y&oLo0_?TB5 zdKuwOJ$?FvPJE1@aRL(q)zt;40$DK;T|#9RBkhC+tmQ4x7Oc=$Jp=?MLyR*DGN?fb zL@`fach-b^^eQ#%>bxB<9&qN)Et7s-GL+zRI?^r>Wka^ulb2M&fFjTf zd)WyaH6?LHl7e0};B_kNhvoiOozl~32F)~?8U&}cVO$E0n*EeiE#E*gw4a(O6*K^9 zm{1L6B8Lz=6r`k(*korZQo|I~O5wRs{a6?$lR8t3mJ>9Yg(EA%fGaGUIwCO@>X0u! zNvon-DxiemcGgM(MNFiq#i^u-sH#vmV0vL{I506sZgL2W38D(srxsC;a)=_)Lqw(6 z+KY083#7sv#vGIj?HHBm!48k#iY{l8je2@(5ywWTCo2@Gs&hqv`<~H53nzf#4rb7B zCMKBq!Q{l8sG@3r=mtW?kXd{zp$#HuQ|zY6#>kBQ_qM9lep~ zS=w>np78fX$AVmcqLamiS0+@vJqLQgV$z&o5M6Qkl^s~Wlk(0kIti-_l zo=7~q2|8(X`E17dl~MXA6;ACVhFZjEfw4GoC=Q{D5z#)7;6r=%4Y$*NcGs?N*Av`D z%}g)CK)fx!g~)0Wop;;{;U?Q2jFT=670vRR>4EE$)h86~54++lhWv$C5EP%7ikK=- zp`dkIM#vY9?eRFLzWJ;@{5sss*vezUShV9%N0|}dxWjpSh7M6U5+EzbQSTU(_mPO4|Gp=Zu8GV9Jl4eV1k~~F{ zNG%if8QXy*&BR@e!8Zv|CZLui+THGxG&gCrMi55J%sBMSKc%aY{For;uAkgSydSfc z)Lg79Hv?HkUUZ(f-w05u=Dm~`=x#F#Xz5BG!Pz7elAC@SXv`KC?zz*8E}$tQeuZ1W zovC9-J^i>xK}9RnZX40rTG&wIXosEQuU(FLtUw!94B!v}!cRTuKY&=TjqUX)q7*5L zmY4*MSrlEj%>jy;2xW?pi=H+ggc(U?sfbnW6I{CoC|SUdyD>by7_>-SW#2BH3EBvS zO)o|=DC$Zn;I{wSW8?8p;w(7$>?u_Z@fcJpZHS;G$;PXx!|;Yux?*aJ&pl7ezjQf$ z51fqDE>UZ1Yof{GU&SnKckKz^sNn7}sH^kKf`tu5UH$-OFotBc8Cz`=;{E}U5viU*lc$;-$NNX`pLq6Gv!&6)Kz-=Ps3n-QT996ukR7I6?4BX6Xh-0;gc`DUbzoFY$?W1!eNhM!tr;3 z00||TS8uuSYHjbiU%r2GS6F-vFn%@pS6_G9C$_ULUR2Y49XvT~*h}E)P$l&3U1kcK zJT1=?ir$$81w6U+0<}otpgskrlyR+nB7k<28pgx%uEwW4II!?#)QJGNoj}QpOp>=x zjW{I44^f-{+BtE$Umx|7ZILqU`zbTHP6}P@|IZ2Jw+e6Q^ z?1*F(&l{IkU8=}-Fb;>j&9!FT8y~eUf-=mylw;M6hcw#Qo|qFR78wJf<^aby*k*m! zW{ziJ7A;J1SS738UX@17^Sk0}l5KEb=(YSz>Tt0!?$;=X`2)dtOpOXyO5&}c2JqeH zvAV)63>Yf#w@@bVTq$DHyXuN_ut+Xd0u$LPC`@y;~uXD^<;P(sF>;9iYY1WWdB4eoldKd_aJS$*$z zf1g*`Z|9ks!&diect%r8?}^Cw8Z&qxC*?mU4g-{43@XMI+#J{1$?LD5P;3Va`bqW-Jx76OZXk|K6j#*0BYzJ6PZQ!MU&D70htctTMTVFyYcI#;p zkB5wb);!~7LrXMco<80J-*niDe7{g>Ihw#TdO7nX$c0$sBS|Hv-tNhKCRI$#oq5hr z_%o|sA;$6GVtiA5q?+jS7NRVCGS1;i%szY_-*{Q4R58NX!sr#R1)b^K7y`$}`sGOs z0L6`RqEzO{PPKDkss~`d^{P=)<7&u^Z?3YC7Pz*>y*72X(=jZz-1vl!Nje-ZB*{V;I%6s^ zMV;7c_WqUkTtV6rncLfi?w&jv>@e(?Ht8` z$Qj7O%oLRiprL$U_{ZSKo7}L`ZZgxm;8HqhZSLq_MUGRa-`3AO6F1EAi(*ajKM%be z$KLEbt@4BP8*7(lm;SH{mXnZ=KYYyd@nS>&sb)#~MM(Bn0aopY2q}wd|KRSU`>J){ zapM`$KXZ3HwEHH_N4vb9tB|{!XN=5j=dX?!@ybjiY>e&jKFb11flTz}nm-e=uU z$1TS5=wzJt#pBGKlcIZ9B~ZuNT*()T+ZWEK6on7N50;Hy>jJhv<*S)MzWMYh{?pa- zYoEr_WVuP~`LDQL8-XnY!np*7{af&k)>62C-uxdI-0#xAJaXpSK9^+Rnedr8{mADy zt<3DD(z=T-xva=34o%DHWUK!^#%&Q;XG~t^c4YqruOg1Ix$=i=1w@#&X3egs&*h+M z`rFx;Y+OU0)WROZXQzpc@RRqp79!?fT%Qka87J#~D>XfBC^u;i5pwc|;HJusboo~jw)LVsSAI8W#r%SPeYwt3GnKE5eKb;q^pTt;UPD@N_0vFgi<;#Zq%Jop z1$n+sZgb9I^Q5Q3$YHZlVipE=SAy5jq@+?)n9_(OZH=3!Rpw2IbBDVIw@gOEz~mJt z!W!v5pFZFJF{hbAv-9nR_r>rLv?9!REVp81MvCIyDFft)Izk=-bnSJhjYhqhNA&Ca z=f1gFTmAYV{G)cvHdkPOaYR{|NgNt z9AeaskbI)R>m+dPE|(&hy46MM{ql|2QOC~K>+j)Pzn+*0 z{&_R;W9q(Do~>o~MwiGwWn$Qu+i$p~uz%4#Tf=EZ+Ne8_gAa7Oc+@zQ)cjt3^2eh& zuUB&AFI-;y16v(`?ejGYbazH*9>UKvl-_y@X<$waRPS_sn85|(Ljg*4!oS*-rZ~)} zwOsowdly5iw7K723Qf+fng3Zz8G6#I z3vYjLt@}(bRMBki!1hHfUHft4WymAXT{*M0)$xD~>&HWnzt-8hyHWMqK%%txTHBPW ze69vJ>)6q1W_aM2yWC*3q85)nr^`zZoM2#<7GD}33k*REfe5g0;nRyVi*qaBa5^Wp zT6cwLW`6j3Aph!HNc%+t)x~37g1D93v#mhPHKFYRs&{EP`pmbrTmI#__MF?U+5Y`E z&o?!<;q$49@{;_wZ>gMjUStU!%xfEKz|5?b25O!#tVG8pIYnL1N$W*|-Qwn{=Xh#kd3^vxSYjX3g?%is^@#8!pIub7Yz+V~<)Tyg0J2f%C zR@fzDyq(_`juSJd`x+(vBSnf!v;YpT7UjnK?)5WzYPgD0?_xKmiN4;+DRX?K4SDPc zWE|jB!SS(*g(UD{O7Qls6M`(1X+%I^3UDG3;Eku0bU#KwuCtPz(n5nhC~fklH)MQ`rqINw++dowb>?O-`Dp z^i+UwIY%P&rN4T&85@XPnLzH!d_`3dM z&ClGwZSVMPaHrqehfm#&Q85bVih-}H6o%8jzs^~U-7jEZNr%hf;5=%*Ee_N13rBu^ z_=|ocxorDwD+a0lBcHAR;{%z}cq{f1OfPTKl9qfwTD>>*gTM!(m-u9fOh7qmSG4<* z(vhZCfhUzq#am{U$EE_uqk82WGk7I~DMp@nbypwRzg~JhqO7pIf7PUxWE1izo~Hb? z0Ij*O<8RZZph-}x0p~25JAV*bM~x@rv%NjYKEvPM_3V%Pev@F=ht;2gjuMFcKd*ZF(f|Me literal 0 HcmV?d00001 diff --git a/man/collapse_row_labels.Rd b/man/collapse_row_labels.Rd index aafba3a4..fd144a59 100644 --- a/man/collapse_row_labels.Rd +++ b/man/collapse_row_labels.Rd @@ -27,17 +27,17 @@ indentation level can be applied. \examples{ x <- tibble::tribble( ~row_label1, ~row_label2, ~row_label3, ~row_label4, ~var1, - "A", "C", "G", "M", 1L, - "A", "C", "G", "N", 2L, - "A", "C", "H", "O", 3L, - "A", "D", "H", "P", 4L, - "A", "D", "I", "Q", 5L, - "A", "D", "I", "R", 6L, - "B", "E", "J", "S", 7L, - "B", "E", "J", "T", 8L, - "B", "E", "K", "U", 9L, - "B", "F", "K", "V", 10L, - "B", "F", "L", "W", 11L + "A", "C", "G", "M", 1L, + "A", "C", "G", "N", 2L, + "A", "C", "H", "O", 3L, + "A", "D", "H", "P", 4L, + "A", "D", "I", "Q", 5L, + "A", "D", "I", "R", 6L, + "B", "E", "J", "S", 7L, + "B", "E", "J", "T", 8L, + "B", "E", "K", "U", 9L, + "B", "F", "K", "V", 10L, + "B", "F", "L", "W", 11L ) diff --git a/man/adae.Rd b/man/tplyr_adae.Rd similarity index 88% rename from man/adae.Rd rename to man/tplyr_adae.Rd index fd8d5558..409877da 100644 --- a/man/adae.Rd +++ b/man/tplyr_adae.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{adae} -\alias{adae} +\name{tplyr_adae} +\alias{tplyr_adae} \title{ADAE Data} \format{ A data.frame with 276 rows and 55 columns. @@ -11,7 +11,7 @@ A data.frame with 276 rows and 55 columns. https://github.com/phuse-org/TestDataFactory } \usage{ -adae +tplyr_adae } \description{ A subset of the PHUSE Test Data Factory ADAE data set. diff --git a/man/adas.Rd b/man/tplyr_adas.Rd similarity index 88% rename from man/adas.Rd rename to man/tplyr_adas.Rd index 35f6f6c3..1d6528bc 100644 --- a/man/adas.Rd +++ b/man/tplyr_adas.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{adas} -\alias{adas} +\name{tplyr_adas} +\alias{tplyr_adas} \title{ADAS Data} \format{ A data.frame with 1,040 rows and 40 columns. @@ -11,7 +11,7 @@ A data.frame with 1,040 rows and 40 columns. https://github.com/phuse-org/TestDataFactory } \usage{ -adas +tplyr_adas } \description{ A subset of the PHUSE Test Data Factory ADAS data set. diff --git a/man/adlb.Rd b/man/tplyr_adlb.Rd similarity index 88% rename from man/adlb.Rd rename to man/tplyr_adlb.Rd index 1dba9e1d..10863663 100644 --- a/man/adlb.Rd +++ b/man/tplyr_adlb.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{adlb} -\alias{adlb} +\name{tplyr_adlb} +\alias{tplyr_adlb} \title{ADLB Data} \format{ A data.frame with 311 rows and 46 columns. @@ -11,7 +11,7 @@ A data.frame with 311 rows and 46 columns. https://github.com/phuse-org/TestDataFactory } \usage{ -adlb +tplyr_adlb } \description{ A subset of the PHUSE Test Data Factory ADLB data set. diff --git a/man/adsl.Rd b/man/tplyr_adsl.Rd similarity index 88% rename from man/adsl.Rd rename to man/tplyr_adsl.Rd index 342b157f..2b17ae5e 100644 --- a/man/adsl.Rd +++ b/man/tplyr_adsl.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} -\name{adsl} -\alias{adsl} +\name{tplyr_adsl} +\alias{tplyr_adsl} \title{ADSL Data} \format{ A data.frame with 254 rows and 49 columns. @@ -11,7 +11,7 @@ A data.frame with 254 rows and 49 columns. https://github.com/phuse-org/TestDataFactory } \usage{ -adsl +tplyr_adsl } \description{ A subset of the PHUSE Test Data Factory ADSL data set. diff --git a/tests/testthat/_snaps/data.md b/tests/testthat/_snaps/data.md index 6c3d1c90..0c9a6d34 100644 --- a/tests/testthat/_snaps/data.md +++ b/tests/testthat/_snaps/data.md @@ -1,7 +1,7 @@ # get_data_labels Code - get_data_labels(adsl) + get_data_labels(tplyr_adsl) Output # A tibble: 49 x 2 name label @@ -21,7 +21,7 @@ --- Code - get_data_labels(adae) + get_data_labels(tplyr_adae) Output # A tibble: 55 x 2 name label @@ -41,7 +41,7 @@ --- Code - get_data_labels(adas) + get_data_labels(tplyr_adas) Output # A tibble: 40 x 2 name label @@ -61,7 +61,7 @@ --- Code - get_data_labels(adlb) + get_data_labels(tplyr_adlb) Output # A tibble: 46 x 2 name label diff --git a/tests/testthat/test-data.R b/tests/testthat/test-data.R index 90ea0cca..ea2b1ce3 100644 --- a/tests/testthat/test-data.R +++ b/tests/testthat/test-data.R @@ -1,6 +1,6 @@ test_that("get_data_labels", { - expect_snapshot(get_data_labels(adsl)) - expect_snapshot(get_data_labels(adae)) - expect_snapshot(get_data_labels(adas)) - expect_snapshot(get_data_labels(adlb)) + expect_snapshot(get_data_labels(tplyr_adsl)) + expect_snapshot(get_data_labels(tplyr_adae)) + expect_snapshot(get_data_labels(tplyr_adas)) + expect_snapshot(get_data_labels(tplyr_adlb)) }) diff --git a/vignettes/Tplyr.Rmd b/vignettes/Tplyr.Rmd index 4ebe4009..d22f99e8 100644 --- a/vignettes/Tplyr.Rmd +++ b/vignettes/Tplyr.Rmd @@ -53,7 +53,7 @@ When a `tplyr_table()` is created, it will contain the following bindings: The function `tplyr_table()` allows you a basic interface to instantiate the object. Modifier functions are available to change individual parameters catered to your analysis. ```{r tplyr_table} -t <- tplyr_table(adsl, TRT01P, where = SAFFL == "Y") +t <- tplyr_table(tplyr_adsl, TRT01P, where = SAFFL == "Y") t ``` @@ -87,7 +87,7 @@ Everyone has their own style of coding - so we've tried to be flexible to an ext There are two ways to add layers to a `tplyr_table()`: `add_layer()` and `add_layers()`. The difference is that `add_layer()` allows you to construct the layer within the call to `add_layer()`, whereas with `add_layers()` you can attach multiple layers that have already been constructed upfront: ```{r add_layer} -t <- tplyr_table(adsl, TRT01P) %>% +t <- tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(AGEGR1, by = "Age categories n (%)") ) @@ -97,7 +97,7 @@ t <- tplyr_table(adsl, TRT01P) %>% Within `add_layer()`, the syntax to constructing the count layer for Age Categories was written on the fly. `add_layer()` is special in that it also allows you to use piping to use modifier functions on the layer being constructed ```{r add_layer_with_piping} -t <- tplyr_table(adsl, TRT01P) %>% +t <- tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(AGEGR1, by = "Age categories n (%)") %>% set_format_strings(f_str("xx (xx.x%)", n, pct)) %>% @@ -109,7 +109,7 @@ t <- tplyr_table(adsl, TRT01P) %>% `add_layers()`, on the other hand, lets you isolate the code to construct a particular layer if you wanted to separate things out more. Some might find this cleaner to work with if you have a large number of layers being constructed. ```{r add_layers} -t <- tplyr_table(adsl, TRT01P) +t <- tplyr_table(tplyr_adsl, TRT01P) l1 <- group_count(t, AGEGR1, by = "Age categories n (%)") l2 <- group_desc(t, AGE, by = "Age (years)") @@ -126,7 +126,7 @@ Notice that when you construct a `tplyr_table()` or a `tplyr_layer()` that what To generate the data from a `tplyr_table()` object, you use the function `build()`: ```{r build} -t <- tplyr_table(adsl, TRT01P) %>% +t <- tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(AGEGR1, by = "Age categories n (%)") ) @@ -159,7 +159,7 @@ So - why is this object necessary. Consider this example: ```{r format_strings_1} -t <- tplyr_table(adsl, TRT01P) %>% +t <- tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(AGE, by = "Age (years)") %>% set_format_strings( @@ -196,7 +196,7 @@ This simple user input controls a significant amount of work in the back end of `f_str()` objects are also used with count layers as well to control the data presentation. Instead of specifying the summaries performed, you use `n`, `pct`, `distinct_n`, and `distinct_pct` for your parameters and specify how you would like the values displayed. Using `distinct_n` and `distinct_pct` should be combined with specifying a `distinct_by()` variable using `set_distinct_by()`. ```{r format_strings_2} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(AGEGR1, by = "Age categories") %>% set_format_strings(f_str('xx (xx.x)',n,pct)) @@ -204,7 +204,7 @@ tplyr_table(adsl, TRT01P) %>% build() %>% kable() -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(AGEGR1, by = "Age categories") %>% set_format_strings(f_str('xx',n)) @@ -217,7 +217,7 @@ tplyr_table(adsl, TRT01P) %>% Really - format strings allow you to present your data however you like. ```{r format_strings_3} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(AGEGR1, by = "Age categories") %>% set_format_strings(f_str('xx (•◡•) xx.x%',n,pct)) @@ -235,7 +235,7 @@ But should you? Probably not. As covered under string formatting, `set_format_strings()` controls a great deal of what happens within a descriptive statistics layer. Note that there are some built in defaults to what's output: ```{r desc1} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(AGE, by = "Age (years)") ) %>% @@ -246,7 +246,7 @@ tplyr_table(adsl, TRT01P) %>% To override these defaults, just specify the summaries that you want to be performed using `set_format_strings()` as described above. But what if **Tplyr** doesn't have a built in function to do the summary statistic that you want to see? Well - you can make your own! This is where `set_custom_summaries()` comes into play. Let's say you want to derive a geometric mean. ```{r custom_summaries} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(AGE, by = "Sepal Length") %>% set_custom_summaries( @@ -266,7 +266,7 @@ In `set_custom_summaries()`, first you name the summary being performed. This is Sometimes there's a need to present multiple variables summarized side by side. **Tplyr** allows you to do this as well. ```{r desc2} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(vars(AGE, AVGDD), by = "Age and Avg. Daily Dose") ) %>% @@ -282,7 +282,7 @@ tplyr_table(adsl, TRT01P) %>% Count layers generally allow you to create "n" and "n (%)" count type summaries. There are a few extra features here as well. Let's say that you want a total row within your counts. This can be done with `add_total_row()`: ```{r count_total1} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(AGEGR1, by = "Age categories") %>% add_total_row() @@ -295,7 +295,7 @@ tplyr_table(adsl, TRT01P) %>% Sometimes it's also necessary to count summaries based on distinct values. **Tplyr** allows you to do this as well with `set_distinct_by()`: ```{r count_distinct} -tplyr_table(adae, TRTA) %>% +tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count('Subjects with at least one adverse event') %>% set_distinct_by(USUBJID) %>% @@ -311,7 +311,7 @@ There's another trick going on here - to create a summary with row label text li Adverse event tables often call for counting AEs of something like a body system and counting actual events within that body system. **Tplyr** has means of making this simple for the user as well. ```{r count_nested} -tplyr_table(adae, TRTA) %>% +tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(vars(AEBODSYS, AEDECOD)) ) %>% @@ -328,10 +328,10 @@ Lastly, let's talk about shift layers. A common example of this would be looking ```{r shift1} # Tplyr can use factor orders to dummy values and order presentation -adlb$ANRIND <- factor(adlb$ANRIND, c("L", "N", "H")) -adlb$BNRIND <- factor(adlb$BNRIND, c("L", "N", "H")) +tplyr_adlb$ANRIND <- factor(tplyr_adlb$ANRIND, c("L", "N", "H")) +tplyr_adlb$BNRIND <- factor(tplyr_adlb$BNRIND, c("L", "N", "H")) -tplyr_table(adlb, TRTA, where = PARAMCD == "CK") %>% +tplyr_table(tplyr_adlb, TRTA, where = PARAMCD == "CK") %>% add_layer( group_shift(vars(row=BNRIND, column=ANRIND), by=PARAM) %>% set_format_strings(f_str("xx (xxx%)", n, pct)) diff --git a/vignettes/count.Rmd b/vignettes/count.Rmd index 5cf01cd8..969d31eb 100644 --- a/vignettes/count.Rmd +++ b/vignettes/count.Rmd @@ -29,7 +29,7 @@ At the surface, counting sounds pretty simple, right? You just want to know how Let's start with a basic example. This table demonstrates the distribution of subject disposition across treatment groups. Additionally, we're sorting by descending total occurrences using the "Total" group. ```{r} -t <- tplyr_table(adsl, TRT01P, where = SAFFL == "Y") %>% +t <- tplyr_table(tplyr_adsl, TRT01P, where = SAFFL == "Y") %>% add_total_group() %>% add_treat_grps(Treated = c("Xanomeline Low Dose", "Xanomeline High Dose")) %>% add_layer( @@ -52,7 +52,7 @@ Another exceptionally important consideration within count layers is whether you **Tplyr** allows you to focus on these distinct counts and distinct percents within some grouping variable, like subject. Additionally, you can mix and match with the distinct counts with non-distinct counts in the same row too. The `set_distinct_by()` function sets the variables used to calculate the distinct occurrences of some value using the specified `distinct_by` variables. ```{r} -t <- tplyr_table(adae, TRTA) %>% +t <- tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(AEDECOD) %>% set_distinct_by(USUBJID) %>% @@ -69,7 +69,7 @@ You may have seen tables before like the one above. This display shows the numbe An additional option for formatting the numbers above would be using 'parenthesis hugging'. To trigger this, on the integer side of a number use a capital 'X' or a capital 'A'. For example: ```{r} -t <- tplyr_table(adae, TRTA) %>% +t <- tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(AEDECOD) %>% set_distinct_by(USUBJID) %>% @@ -93,7 +93,7 @@ One way to approach this would be creating two summaries. One summarizing the bo The example below demonstrates how to do a nested summary. Look at the first row - here `row_label1` and `row_label2` are both "CARDIAC DISORDERS". This line is the summary for `AEBODSYS.` In the rows below that, `row_label1` continues on with the value "CARDIAC DISORDERS", but `row_label2` changes. These are the summaries for `AEDECOD`. ```{r} -tplyr_table(adae, TRTA) %>% +tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(vars(AEBODSYS, AEDECOD)) ) %>% @@ -105,7 +105,7 @@ tplyr_table(adae, TRTA) %>% This accomplishes what we needed, but it's not exactly the presentation you might hope for. We have a solution for this as well. ```{r} -tplyr_table(adae, TRTA) %>% +tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(vars(AEBODSYS, AEDECOD)) %>% set_nest_count(TRUE) %>% diff --git a/vignettes/custom-metadata.Rmd b/vignettes/custom-metadata.Rmd index 55f5e9f2..6e9f2fd2 100644 --- a/vignettes/custom-metadata.Rmd +++ b/vignettes/custom-metadata.Rmd @@ -26,8 +26,8 @@ library(knitr) ```{r data prep, echo=FALSE} -t <- tplyr_table(adas, TRTP, where=EFFFL == "Y" & ITTFL == "Y" & PARAMCD == "ACTOT" & ANL01FL == "Y") %>% - set_pop_data(adsl) %>% +t <- tplyr_table(tplyr_adas, TRTP, where=EFFFL == "Y" & ITTFL == "Y" & PARAMCD == "ACTOT" & ANL01FL == "Y") %>% + set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01P) %>% set_pop_where(EFFFL == "Y" & ITTFL == "Y") %>% set_distinct_by(USUBJID) %>% @@ -186,7 +186,7 @@ get_meta_subset(t, 'x4_1', "var1_Xanomeline High Dose") %>% You very well may have a scenario where you want to use these metadata functions outside of **Tplyr** in general. As such, there are S3 methods available to query metadata from a dataframe instead of a **Tplyr** table, and parameters to provide your own target data frame: ```{r metadata without Tplyr} -get_meta_subset(eff_meta, 'x4_1', "var1_Xanomeline High Dose", target=adas) %>% +get_meta_subset(eff_meta, 'x4_1', "var1_Xanomeline High Dose", target=tplyr_adas) %>% head() %>% kable() ``` diff --git a/vignettes/denom.Rmd b/vignettes/denom.Rmd index a65d2674..af221fa5 100644 --- a/vignettes/denom.Rmd +++ b/vignettes/denom.Rmd @@ -37,7 +37,7 @@ For this reason,**Tplyr** allows lets you set a separate population dataset - bu Consider these two examples. ```{r} -tplyr_table(adae, TRTA) %>% +tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(AEDECOD) %>% set_distinct_by(USUBJID) %>% @@ -49,8 +49,8 @@ tplyr_table(adae, TRTA) %>% ``` ```{r} -tplyr_table(adae, TRTA) %>% - set_pop_data(adsl) %>% +tplyr_table(tplyr_adae, TRTA) %>% + set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01A) %>% add_layer( group_count(AEDECOD) %>% @@ -81,10 +81,10 @@ When you're looking within a single dataset, there are a couple factors that you Most of the complexity of denominators comes from nuanced situations. A solid 80% of the time, defaults will work. For example, in a frequency table, you will typically want data within a column to sum to 100%. For example: ```{r} -adsl <- adsl %>% +tplyr_adsl <- tplyr_adsl %>% mutate(DCSREAS = ifelse(DCSREAS == '', 'Completed', DCSREAS)) -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(DCSREAS) ) %>% @@ -94,7 +94,7 @@ tplyr_table(adsl, TRT01P) %>% By default, when not using the population data strategy shown above, a count layer assumes that you want columns to sum to 100%. But that's not always the case. Perhaps you'd like to break this summary down by sex presented row-wise. ```{r} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(DCSREAS, by=SEX) ) %>% @@ -105,7 +105,7 @@ tplyr_table(adsl, TRT01P) %>% Ok - so, now this is a little bit off. By breaking sex down as a row group, the denominators are still the total treatment group. Does that make sense? 34 female Placebo group subjects completed, but that calculated 39.5% also includes male subjects in the denominator. Let's fix this using `set_denoms_by()`. ```{r} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(DCSREAS, by=SEX) %>% set_denoms_by(SEX, TRT01P) @@ -127,7 +127,7 @@ Depending on your presentation, what you require may change - but the flexibilit A major part of the shift API is the control of the denominators used in the calculation of the percentages. In shift tables, most percentages are relative to the "box" that is formed from the "from" and "to" groups of the shift for each treatment group. Just like the count layers, the `set_denoms_by()` functions any variable name from the treatment variable, `cols` argument, `by` variables. The difference with shift layers is that now you can also include your target variables used for the row or column. ```{r} -tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% +tplyr_table(tplyr_adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) %>% set_format_strings(f_str("xx (xxx.x%)", n, pct)) %>% @@ -143,7 +143,7 @@ In the example above, the denominators were based on the by and treatment variab In the next example, the percentage denominators are calculated row-wise, each row percentage sums to 100%. ```{r} -tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% +tplyr_table(tplyr_adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) %>% set_format_strings(f_str("xx (xxx.x%)", n, pct)) %>% @@ -158,7 +158,7 @@ tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% While not practical, in this last example the denominators are changed to be based on the entire column instead of the 3 x 3 box. By passing the column variables, `TRTA` and `ANRIND` the layer will use those denominators when determining the percentages. ```{r} -tplyr_table(adlb, TRTA, where = PARAMCD == "CK") %>% +tplyr_table(tplyr_adlb, TRTA, where = PARAMCD == "CK") %>% add_layer( group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) %>% set_format_strings(f_str("xx (xx.xx%)", n, pct)) %>% @@ -185,10 +185,10 @@ So let's take the example shown below. The first layer has no layer level filter The third layer has a layer level filter applied, but additionally uses `set_denom_where()`. The `set_denom_where()` in this example is actually *removing* the layer level filter for the denominators. This is because in R, when you filter using `TRUE`, the filter returns all records. So by using `TRUE` in `set_denom_where()`, the layer level filter is effectively removed. This causes the denominator to include all values available from the table and not just those selected for that layer - so for this layer, the percentages will *not add up to 100%*. This is important - this allows the percentages from Layer 3 to sum to the total percentage of "DISCONTINUED" from Layer 1. ```{r} -adsl2 <- adsl %>% +tplyr_adsl2 <- tplyr_adsl %>% mutate(DISCONTEXT = if_else(DISCONFL == 'Y', 'DISCONTINUED', 'COMPLETED')) -t <- tplyr_table(adsl2, TRT01P, where = SAFFL == 'Y') %>% +t <- tplyr_table(tplyr_adsl2, TRT01P, where = SAFFL == 'Y') %>% add_layer( group_count(DISCONTEXT) ) %>% @@ -215,10 +215,10 @@ The `set_missing_count()` function can take a new `f_str()` object to set the di In the example below 50 random values are removed and NA is specified as the missing string. This leads us to another parameter - `denom_ignore`. By default, if you specify missing values they will still be considered within the denominator, but when you have missing counts, you may wish to exclude them from the totals being summarized. By setting `denom_ignore` to TRUE, your denominators will ignore any groups of missing values that you've specified. ```{r} -adae2 <- adae -adae2[sample(nrow(adae2), 50), "AESEV"] <- NA +tplyr_adae2 <- tplyr_adae +tplyr_adae2[sample(nrow(tplyr_adae2), 50), "AESEV"] <- NA -t <- tplyr_table(adae2, TRTA) %>% +t <- tplyr_table(tplyr_adae2, TRTA) %>% add_layer( group_count(AESEV) %>% set_format_strings(f_str("xxx (xx.xx%)", n, pct)) %>% @@ -247,10 +247,10 @@ More nuance comes in two places: In the example below, we summarize age groups by sex. The denominators are determined by treatment group and sex, and since we are not excluding any values from the denominator, the total row ends up matching the denominator that was used. The 'Missing' row tells us the number of missing values, but because `count_missings` is set to `TRUE`, the missing counts are included in the total row. This probably isn't how you would choose to display things, but here we're trying to show the flexibility built into **Tplyr**. ```{r} -adsl2 <- adsl -adsl2[sample(nrow(adsl2), 50), "AGEGR1"] <- NA +tplyr_adsl2 <- tplyr_adsl +tplyr_adsl2[sample(nrow(tplyr_adsl2), 50), "AGEGR1"] <- NA -tplyr_table(adsl2, TRT01P) %>% +tplyr_table(tplyr_adsl2, TRT01P) %>% add_layer( group_count(AGEGR1, by=SEX) %>% set_denoms_by(TRT01P, SEX) %>% # This gives me a Total row each group @@ -267,7 +267,7 @@ The default text for the Total row is "Total", but we provide `set_total_row_lab Let's look at a more practical version of the table above. If you display missings, you probably want to exclude them from the total. Here we do that using `set_missing_count()`. So more commonly, you'll see this: ```{r} -tplyr_table(adsl2, TRT01P) %>% +tplyr_table(tplyr_adsl2, TRT01P) %>% add_layer( group_count(AGEGR1, by=SEX) %>% set_denoms_by(TRT01P, SEX) %>% # This gives me a Total row each group diff --git a/vignettes/desc.Rmd b/vignettes/desc.Rmd index 180f6012..542db35e 100644 --- a/vignettes/desc.Rmd +++ b/vignettes/desc.Rmd @@ -26,7 +26,7 @@ library(knitr) Descriptive statistics in **Tplyr** are created using `group_desc()` function when creating a layer. While `group_desc()` allows you to set your target, by variables, and filter criteria, a great deal of the control of the layer comes from `set_format_strings()` where the actual summaries are declared. ```{r intro} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(AGE, by = "Age (years)", where= SAFFL=="Y") %>% set_format_strings( @@ -87,7 +87,7 @@ That said, we still want to offer some flexibility here, so you can change the q The example below demonstrates using the default quantile algorithm in R. ```{r quantile_types_default} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(CUMDOSE) %>% set_format_strings("Q1, Q3" = f_str('xxxxx, xxxxx', q1, q3)) @@ -105,7 +105,7 @@ $$ ```{r quantile_types_sas} options(tplyr.quantile_type = 3) -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(CUMDOSE) %>% set_format_strings("Q1, Q3" = f_str('xxxxx, xxxxx', q1, q3)) @@ -137,7 +137,7 @@ As with any other setting in **Tplyr**, the layer setting will always take prece Let's look at an example. ```{r multi-custom} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(vars(AGE, HEIGHTBL), by = "Sepal Length") %>% set_custom_summaries( @@ -163,7 +163,7 @@ Another note about custom summaries is that you're able to overwrite the default For example, here we use the **Tplyr** default mean. ```{r custom_options} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(AGE) %>% set_format_strings("Mean" = f_str('xx.xx', mean)) @@ -181,7 +181,7 @@ options(tplyr.custom_summaries = ) ) -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(AGE) %>% set_format_strings("Mean" = f_str('xx.xx', mean)) diff --git a/vignettes/desc_layer_formatting.Rmd b/vignettes/desc_layer_formatting.Rmd index 75a17b30..18e9af53 100644 --- a/vignettes/desc_layer_formatting.Rmd +++ b/vignettes/desc_layer_formatting.Rmd @@ -32,14 +32,14 @@ By default, if there is no available value for a summary in a particular observa _Note: **Tplyr** generally respects factor levels - so in instances of a missing row or column group, if the factor level is present, then the variable or row will still generate)_ ```{r missing} -adsl$TRT01P <- as.factor(adsl$TRT01P) -adlb$TRTA <- as.factor(adlb$TRTA) +tplyr_adsl$TRT01P <- as.factor(tplyr_adsl$TRT01P) +tplyr_adlb$TRTA <- as.factor(tplyr_adlb$TRTA) -adlb_2 <- adlb %>% +tplyr_adlb_2 <- tplyr_adlb %>% filter(TRTA != "Placebo") -tplyr_table(adlb_2, TRTA) %>% - set_pop_data(adsl) %>% +tplyr_table(tplyr_adlb_2, TRTA) %>% + set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01P) %>% add_layer( group_desc(AVAL, by=PARAMCD) %>% @@ -54,8 +54,8 @@ tplyr_table(adlb_2, TRTA) %>% Note how the entire example above has all records in `var1_Placebo` missing. **Tplyr** gives you control over how you fill this space. Let's say that we wanted instead to make that space say "Missing". You can control this with the `f_str()` object using the `empty` parameter. ```{r missing1} -tplyr_table(adlb_2, TRTA) %>% - set_pop_data(adsl) %>% +tplyr_table(tplyr_adlb_2, TRTA) %>% + set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01P) %>% add_layer( group_desc(AVAL, by=PARAMCD) %>% @@ -70,8 +70,8 @@ tplyr_table(adlb_2, TRTA) %>% Look at the `empty` parameter above. Here, we use a named character vector, where the name is `.overall`. When this name is used, if all elements within the cell are missing, they will be filled with the specified text. Otherwise, the provided string will fill just the missing parameter. In some cases, this may not be what you'd like to see. Perhaps we want a string that fills each missing space. ```{r missing2} -tplyr_table(adlb_2, TRTA) %>% - set_pop_data(adsl) %>% +tplyr_table(tplyr_adlb_2, TRTA) %>% + set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01P) %>% add_layer( group_desc(AVAL, by=PARAMCD) %>% @@ -92,7 +92,7 @@ You may have noticed that the approach to formatting covered so far leaves a lot **Tplyr** has this covered using auto-precision. Auto-precision allows you to format your numeric summaries based on the precision of the data collected. This has all been built into the format strings, because a natural place to specify your desired format is where you specify how you want your data presented. If you wish to use auto-precision, use `a` instead of `x` when creating your summaries. Note that only one `a` is needed on each side of a decimal. To use increased precision, use `a+n` where `n` is the number of additional spaces you wish to add. ```{r autoprecision1} -tplyr_table(adlb, TRTA) %>% +tplyr_table(tplyr_adlb, TRTA) %>% add_layer( group_desc(AVAL, by = PARAMCD) %>% set_format_strings( @@ -110,7 +110,7 @@ As you can see, the decimal precision is now varying depending on the test being But - this is kind of ugly, isn't it? Do we really need all 6 decimal places collected for CA? For this reason, you're able to set a cap on the precision that's displayed: ```{r autoprecision2} -tplyr_table(adlb, TRTA) %>% +tplyr_table(tplyr_adlb, TRTA) %>% add_layer( group_desc(AVAL, by = PARAMCD) %>% set_format_strings( @@ -129,7 +129,7 @@ Now that looks better. The `cap` argument is part of `set_format_strings()`. You This was a basic situation, but if you're paying close attention, you may have some questions. What if you have more by variables, like by visit AND test. Do we then calculate precision by visit and test? What if collected precision is different per visit and we don't want that? What about multiple summary variables? How do we determine precision then? We have modifier functions for this: ```{r precision3} -tplyr_table(adlb, TRTA) %>% +tplyr_table(tplyr_adlb, TRTA) %>% add_layer( group_desc(vars(AVAL, CHG, BASE), by = PARAMCD) %>% set_format_strings( @@ -164,7 +164,7 @@ prec_data <- tibble::tribble( "URATE", 3, 1, ) -tplyr_table(adlb, TRTA) %>% +tplyr_table(tplyr_adlb, TRTA) %>% add_layer( group_desc(AVAL, by = PARAMCD) %>% set_format_strings( @@ -192,7 +192,7 @@ prec_data <- tibble::tribble( "GGT", 3, 0, ) -tplyr_table(adlb, TRTA) %>% +tplyr_table(tplyr_adlb, TRTA) %>% add_layer( group_desc(AVAL, by = PARAMCD) %>% set_format_strings( @@ -213,7 +213,7 @@ tplyr_table(adlb, TRTA) %>% By default, when using 'x' or 'a', any other character within a format string will stay stationary. Consider the standard example from the descriptive statistic layer vignette. ```{r standard} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(AGE, by = "Age (years)", where= SAFFL=="Y") %>% set_format_strings( @@ -232,7 +232,7 @@ tplyr_table(adsl, TRT01P) %>% Note that if a certain number of integers are alotted, space will be left for the numbers that fill that space, but the position of the parenthesis stays fixed. In some displays, you may want the parenthesis to 'hug' your number - the "format group" width should stay fixed, the parenthesis should move to the right along with the numbers consuming less integer space. Within your `f_str()`, you can achieve this by using a capital 'X'. For example, focusing on the mean and standard deviation line: ```{r manual_hugging} -tplyr_table(adlb, TRTA, PARAMCD == "CK") %>% +tplyr_table(tplyr_adlb, TRTA, PARAMCD == "CK") %>% add_layer( group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% set_format_strings( @@ -248,7 +248,7 @@ tplyr_table(adlb, TRTA, PARAMCD == "CK") %>% Similarly, the same functionality works with auto precision by using a capital A. ```{r auto_hugging} -tplyr_table(adlb, TRTA, PARAMCD == "CK") %>% +tplyr_table(tplyr_adlb, TRTA, PARAMCD == "CK") %>% add_layer( group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% set_format_strings( diff --git a/vignettes/general_string_formatting.Rmd b/vignettes/general_string_formatting.Rmd index 3e14338d..28bdcdc1 100644 --- a/vignettes/general_string_formatting.Rmd +++ b/vignettes/general_string_formatting.Rmd @@ -31,7 +31,7 @@ _Note: We've still focused on R's interactive capabilities, so be sure to check Regardless of what layer type you use within **Tplyr**, control of formatting is handled by using format strings. Consider the following example. ```{r example_1} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(RACE) %>% set_format_strings( @@ -109,7 +109,7 @@ Note in the format string, the result numbers to be formatted fill the spaces of As detailed in the first example, when using a lower case 'x', the exact width of space allotted by the x's will be preserved. Note the `var1_Placebo` row below. ```{r example_3} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(RACE) %>% set_format_strings( @@ -123,7 +123,7 @@ tplyr_table(adsl, TRT01P) %>% Both the integer width for the `n` counts and the space to the right of the opening parenthesis of the `pct` field are preserved. This guarentees that (when using a monospace font) the non-numeric characters within the format strings will remain in the same place. Given that integers don't truncate, if these spaces are undesired, integers will automatically increase width. In the example below, if the `n` or `pct` result exceeds 10, the width of the output string automatically expands. You can trigger this behaivor by using a single 'x' in the integer side of a format group. ```{r example_4} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(RACE) %>% set_format_strings( @@ -140,7 +140,7 @@ The downside of the last example is that alignment between format groups is comp ```{r example_5} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(RACE) %>% set_format_strings( @@ -166,7 +166,7 @@ Lastly, **Tplyr** also has the capability to automatically determine some widths Consider the following example. ```{r example_6} -tplyr_table(adlb, TRTA, where=PARAMCD %in% c("CA", "URATE")) %>% +tplyr_table(tplyr_adlb, TRTA, where=PARAMCD %in% c("CA", "URATE")) %>% add_layer( group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% set_format_strings( @@ -183,7 +183,7 @@ Note that the decimal precision varies between different lab test results. This For count layers, auto-precision can also be used surrounding the `n` counts. For example, the default format string for counts layers in **Tplyr** is set as `a (xxx.x%)`. This will auto-format the `n` result based on the maximum summarized value of `n` within the data. For example: ```{r example_7} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(RACE) %>% set_format_strings(f_str("a (xxx.x%)", n, pct)) @@ -197,8 +197,8 @@ Given that the maximum count was >=10 and <100, the integer width for `n` was as For both layer types, a capital `A` follows the same logic as `X`, but is triggered using auto-precision. Take this example of an adverse event table: ```{r example_8} -tplyr_table(adae, TRTA) %>% - set_pop_data(adsl) %>% +tplyr_table(tplyr_adae, TRTA) %>% + set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01A) %>% add_layer( group_count(AEDECOD) %>% diff --git a/vignettes/layer_templates.Rmd b/vignettes/layer_templates.Rmd index ab0f3ea7..021fc0b6 100644 --- a/vignettes/layer_templates.Rmd +++ b/vignettes/layer_templates.Rmd @@ -40,7 +40,7 @@ new_layer_template( In this example, we've created a basic layer template. The template is named "example_template", and this is the name we'll use to reference the template when we want to use it. When the template is created, we start with the function `group_count(...)`. Note the use of the ellipsis (i.e. `...`). This is a required part of a layer template. Templates must start with a **Tplyr** layer constructor, which is one of the function `group_count()`, `group_desc()`, or `group_shift()`. The ellipsis is necessary because when the template is used, we are able to pass arguments directly into the layer constructor. For example: ```{r using a template} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( use_template("example_template", RACE, by=ETHNIC) ) %>% @@ -53,7 +53,7 @@ Within `use_template()`, the first parameter is the template name. After that, w An additional feature of layer templates is that they act just as any other function would in a **Tplyr** layer. This means that they're also extensible and can be expanded on directly within a **Tplyr** table. For example: ```{r extending a template} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( use_template("example_template", RACE) %>% add_total_row() @@ -82,7 +82,7 @@ In this example, we create a template similar to the first example. But now we a To specify these arguments when using the templater, we use the `use_template()` argument `add_params`. For example: ```{r using params} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( use_template('example_params', RACE, add_params = list( diff --git a/vignettes/metadata.Rmd b/vignettes/metadata.Rmd index a553b1d8..f68f1a69 100644 --- a/vignettes/metadata.Rmd +++ b/vignettes/metadata.Rmd @@ -33,7 +33,7 @@ The purpose of the `tplyr_table()` object is to let **Tplyr** do more than just Consider the following example: ```{r table_creation} -t <- tplyr_table(adsl, TRT01P, where = SAFFL == "Y") %>% +t <- tplyr_table(tplyr_adsl, TRT01P, where = SAFFL == "Y") %>% add_layer( group_count(RACE) ) %>% @@ -99,7 +99,7 @@ The results are provided this was so that they can be unpacked directly into `dp ```{r unpack} m <- get_meta_result(t, 'd1_2', 'var1_Xanomeline High Dose') -adsl %>% +tplyr_adsl %>% filter(!!!m$filters) %>% select(!!!m$names) %>% head(10) %>% @@ -111,7 +111,7 @@ _Note: Trimmed for space_ But - who says you can't let your imagination run wild? ```{r to string print, eval=FALSE} -cat(c("adsl %>%\n", +cat(c("tplyr_adsl %>%\n", " filter(\n ", paste(purrr::map_chr(m$filters, ~ rlang::as_label(.)), collpase=",\n "), ") %>%\n", @@ -121,7 +121,7 @@ cat(c("adsl %>%\n", ``` ```{r to string content, results='asis', echo=FALSE} -cat(c("adsl %>%\n", +cat(c("tplyr_adsl %>%\n", " filter(\n ", paste(purrr::map_chr(m$filters, ~ rlang::as_label(.)), collpase=",\n "), ") %>%\n", diff --git a/vignettes/options.Rmd b/vignettes/options.Rmd index f2201995..e89c0b18 100644 --- a/vignettes/options.Rmd +++ b/vignettes/options.Rmd @@ -64,7 +64,7 @@ options( Here you can see that **Tplyr** picks up these option changes. In the table below, we didn't use `set_format_strings()` anywhere - instead we let **Tplyr** pick up the default formats from the options. ```{r default_formats2} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(AGE, by = "Age (years)") ) %>% @@ -85,7 +85,7 @@ One important thing to understand about how these options work in particular is To demonstrate, consider the following. The **Tplyr** options remain set from the block above. ```{r scoping1} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% set_count_layer_formats(n_counts = f_str("xx (xxx%)", n, pct)) %>% set_desc_layer_formats("Mean (SD)" = f_str("a.a+1 (a.a+2)", mean, sd)) %>% add_layer( @@ -121,7 +121,7 @@ options(tplyr.precision_cap = c('int'=2, 'dec'=2)) Similar to the layer defaults, setting a precision cap at the layer level will override the `tplyr.precision_cap` option. ```{r precision_cap2} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(HEIGHTBL, by = "Height at Baseline") %>% set_format_strings( @@ -163,7 +163,7 @@ Note that the table code used to produce the output is the same. Now **Tplyr** u Now that geometric mean is set within the **Tplyr** options, you can use it within your descriptive statistics layers, just like it was one of the built-in summaries. ```{r custom_summaries2} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(AGE) %>% set_format_strings('Geometric Mean' = f_str('xx.xx', geometric_mean)) @@ -200,7 +200,7 @@ options(op) ```{r scipen2} options(tplyr.scipen = -3) -t <- tplyr_table(adae, TRTA) %>% +t <- tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(AEDECOD) %>% add_risk_diff(c('Xanomeline Low Dose', 'Placebo')) @@ -229,7 +229,7 @@ $$ The example below demonstrates using the default quantile algorithm in R ```{r quantile1} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(CUMDOSE) %>% set_format_strings("Q1, Q3" = f_str('xxxxx, xxxxx', q1, q3)) @@ -248,7 +248,7 @@ $$ ```{r quantile2} options(tplyr.quantile_type = 3) -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_desc(CUMDOSE) %>% set_format_strings("Q1, Q3" = f_str('xxxxx, xxxxx', q1, q3)) diff --git a/vignettes/post_processing.Rmd b/vignettes/post_processing.Rmd index 372a492e..55bafa1d 100644 --- a/vignettes/post_processing.Rmd +++ b/vignettes/post_processing.Rmd @@ -56,7 +56,7 @@ _Note: We're viewing the data frame output here because HTML based outputs elimi Row masking is the process blanking of repeat row values within a data frame to give the appearance of grouping variables. Some table packages, such as [**gt**](https://gt.rstudio.com/), will handle this for you. Other packages, like [**huxtable**](https://hughjonesd.github.io/huxtable/), have options like merging cells, but this may be a more simplistic approach. Furthermore, this is a common approach in clinical tables when data validation is done on an output dataframe. ```{r row_mask1} -dat <- tplyr_table(adsl, TRT01P) %>% +dat <- tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(RACE, by = "Race n (%)") ) %>% @@ -77,7 +77,7 @@ dat %>% A second feature of `apply_row_masks()` is the ability to apply row breaks between different groups of data, for example, different layers of a table. ```{r row_masks3} -dat <- tplyr_table(adsl, TRT01P) %>% +dat <- tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(RACE, by = "Race n (%)") ) %>% @@ -207,7 +207,7 @@ In the first call to `str_extract_fmt_group()`, we target the n counts. The firs In practice, `str_extract_fmt_group()` can then be used to separate format groups into their own columns. ```{r fmt_group2} -dat <- tplyr_table(adsl, TRT01P) %>% +dat <- tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(RACE) ) %>% @@ -234,8 +234,8 @@ In very much the same vein as `str_extract_fmt_group()`, the function `str_extra Consider an adverse event table. In `vignette("sort")` we go over circumstances where you may want to sort by the descending occurrence of a result. We've received questions about how to establish tie breakers in this scenario, where ties should be broken sorting descending occurrence of an adverse event within the high dose group, then the low dose group, and finally the placebo group. **Tplyr** doesn't allow you to output these order variables by default, but getting these numbers is quite simple with `str_extract_num()`. Let's consider a simplified scenario ```{r num1} -dat <- tplyr_table(adae, TRTA) %>% - set_pop_data(adsl) %>% +dat <- tplyr_table(tplyr_adae, TRTA) %>% + set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01A) %>% add_layer( group_count(AEDECOD) %>% diff --git a/vignettes/riskdiff.Rmd b/vignettes/riskdiff.Rmd index b5805d0e..ba443534 100644 --- a/vignettes/riskdiff.Rmd +++ b/vignettes/riskdiff.Rmd @@ -32,7 +32,7 @@ Our current implementation of risk difference is solely built on top of the base Risk difference is built on top of count layers, as it's a comparison of proportions. To add a risk difference calculation into a count layer, you simply use the function `add_risk_diff()`. We made a large effort to make this flow very naturally with the count layer construction, so let's walk through it step by step. ```{r riskdiff1} -t <- tplyr_table(adae, TRTA) %>% +t <- tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(AEDECOD) %>% set_distinct_by(USUBJID) %>% @@ -66,7 +66,7 @@ The default values presented within formatted strings in the built table will be You have a good bit of control over these values though, and this can be controlled in the same way you format the count summaries - using `set_format_strings()`. ```{r riskdiff2} -t <- tplyr_table(adae, TRTA) %>% +t <- tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(AEDECOD) %>% set_distinct_by(USUBJID) %>% @@ -98,7 +98,7 @@ Take a look at the `rdiff` columns now - you'll see they have 5 values. These ar You have the same control over the formatting of the display of these values here as you do with the count summaries. Taking things a step further, you can also pass forward arguments to `stats::prop.test()` using a named list and the `args` argument in `add_risk_diff()`. This wasn't done using the ellipsis (i.e. `...`) like typical R functions because it's already used to capture a varying number of comparisons, but it's not much more difficult to use: ```{r riskdiff3} -t <- tplyr_table(adae, TRTA) %>% +t <- tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(AEDECOD) %>% set_distinct_by(USUBJID) %>% @@ -133,8 +133,8 @@ For more information on these parameters, see the documentation for `stats::prop The default of `add_risk_diff()` works on the distinct counts available within the count summary. ```{r riskdiff4} -t <- tplyr_table(adae, TRTA, where= AEBODSYS == "SKIN AND SUBCUTANEOUS TISSUE DISORDERS") %>% - set_pop_data(adsl) %>% +t <- tplyr_table(tplyr_adae, TRTA, where= AEBODSYS == "SKIN AND SUBCUTANEOUS TISSUE DISORDERS") %>% + set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01A) %>% set_pop_where(TRUE) %>% add_layer( @@ -155,7 +155,7 @@ suppressWarnings(build(t)) %>% If for whatever reason you'd like to run risk difference on the non-distinct counts, switch the `distinct` argument to FALSE. `add_risk_diff()` also will function on multi-level summaries no different than single level, so no concerns there either. ```{r riskdiff5} -t <- tplyr_table(adae, TRTA, where= AEBODSYS == "SKIN AND SUBCUTANEOUS TISSUE DISORDERS") %>% +t <- tplyr_table(tplyr_adae, TRTA, where= AEBODSYS == "SKIN AND SUBCUTANEOUS TISSUE DISORDERS") %>% add_layer( group_count(AEDECOD) %>% set_distinct_by(USUBJID) %>% @@ -176,7 +176,7 @@ suppressWarnings(build(t)) %>% Risk difference also works with the `cols` argument, but it's important to understand how the comparisons work in these situation. Here, it's still the treatment groups that are compared - but the column argument is used as a "by" variable. For example: ```{r riskdiff6} -t <- tplyr_table(adae, TRTA, where= AEBODSYS == "SKIN AND SUBCUTANEOUS TISSUE DISORDERS", cols=SEX) %>% +t <- tplyr_table(tplyr_adae, TRTA, where= AEBODSYS == "SKIN AND SUBCUTANEOUS TISSUE DISORDERS", cols=SEX) %>% add_layer( group_count(AEDECOD) %>% set_distinct_by(USUBJID) %>% @@ -206,7 +206,7 @@ The output of `get_stats_data()` depends on what parameters have been used: This works best when layers are named, as it makes the output much clearer. ```{r riskdiff7} -t <- tplyr_table(adae, TRTA) %>% +t <- tplyr_table(tplyr_adae, TRTA) %>% add_layer(name="PreferredTerm", group_count(AEDECOD) %>% set_distinct_by(USUBJID) %>% diff --git a/vignettes/shift.Rmd b/vignettes/shift.Rmd index 6cd7b091..43a30e8d 100644 --- a/vignettes/shift.Rmd +++ b/vignettes/shift.Rmd @@ -38,7 +38,7 @@ One thing to note - the `group_shift()` API is intended to be used on shift tabl Let's look at an example. ```{r} -tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% +tplyr_table(tplyr_adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) ) %>% @@ -54,9 +54,9 @@ For the most part, the last example gets us where we want to go - but there's st ## Filling Missing Groups Using Factors ```{r} -adlb$ANRIND <- factor(adlb$ANRIND, levels=c("L", "N", "H")) -adlb$BNRIND <- factor(adlb$BNRIND, levels=c("L", "N", "H")) -tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% +tplyr_adlb$ANRIND <- factor(tplyr_adlb$ANRIND, levels=c("L", "N", "H")) +tplyr_adlb$BNRIND <- factor(tplyr_adlb$BNRIND, levels=c("L", "N", "H")) +tplyr_table(tplyr_adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) ) %>% diff --git a/vignettes/sort.Rmd b/vignettes/sort.Rmd index 437b8db8..7405a8c7 100644 --- a/vignettes/sort.Rmd +++ b/vignettes/sort.Rmd @@ -27,7 +27,7 @@ At surface level - sorting a table may seem easy, and in many cases it is. But i Let's start by looking at an example. ```{r} -t <- tplyr_table(adsl, TRT01A) %>% +t <- tplyr_table(tplyr_adsl, TRT01A) %>% add_total_group() %>% add_treat_grps(Treated = c("Xanomeline Low Dose", "Xanomeline High Dose")) %>% add_layer( @@ -121,8 +121,8 @@ These order variables will calculate based on the first applicable method below. If there's no `VARN` variable in the target dataset, **Tplyr** will then check if the variable you provided is a factor. If you're new to R, spending some time trying to understand factor variables is quite worthwhile. Let's look at example using the variable `ETHNIC` and see some of the advantages in practice. ```{r} -adsl$ETHNIC <- factor(adsl$ETHNIC, levels=c("HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "DUMMMY")) -tplyr_table(adsl, TRT01A) %>% +tplyr_adsl$ETHNIC <- factor(tplyr_adsl$ETHNIC, levels=c("HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "DUMMMY")) +tplyr_table(tplyr_adsl, TRT01A) %>% add_layer( group_count(EOSSTT, by = ETHNIC) ) %>% @@ -136,7 +136,7 @@ Factor variables have 'levels'. These levels are essentially what the `VARN` var A highly advantageous aspect of using factor variables in **Tplyr** is that factor variables can be used to insert dummy values into your table. Consider this line of code from above: ``` -adsl$ETHNIC <- factor(adsl$ETHNIC, levels=c("HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "DUMMMY")) +tplyr_adsl$ETHNIC <- factor(tplyr_adsl$ETHNIC, levels=c("HISPANIC OR LATINO", "NOT HISPANIC OR LATINO", "DUMMMY")) ``` This is converting the variable `ETHNIC` to a factor, then setting the factor levels. But it doesn't _change_ any of the values in the dataset - there are no values of "dummy" within `ETHNIC` in ADSL. Yet in the output built above, you see rows for "DUMMY". By using factors, you can insert rows into your **Tplyr** table that don't exist in the data. This is particularly helpful if you're working with data early on in a study, where certain values are expected, yet do not currently exist in the data. This will help you prepare tables that are complete even when your data are not. @@ -146,7 +146,7 @@ This is converting the variable `ETHNIC` to a factor, then setting the factor le To demonstrate the use of `VARN` sorting, consider the variable `RACE.` In `ADSL`, `RACE` also has `RACEN`: ```{r} -adsl %>% +tplyr_adsl %>% distinct(RACEN, RACE) %>% kable() ``` @@ -154,7 +154,7 @@ adsl %>% **Tplyr** will automatically figure this out for you, and pull the `RACEN` values into the variable `ord_layer_1`. ```{r} -tplyr_table(adsl, TRT01A) %>% +tplyr_table(tplyr_adsl, TRT01A) %>% add_layer( group_count(EOSSTT, by = RACE) ) %>% @@ -173,7 +173,7 @@ Lastly, If the target doesn't have a `VARN` variable in the target dataset and i After the `by` variables, each layer will sort results slightly differently. We'll start with the most simple case - descriptive statistic layers. As the user, you have full control over the order in which results present using `set_format_strings()`. Results will be ordered based on the order in which you create your `f_str()` objects. ```{r} -tplyr_table(adsl, TRT01A) %>% +tplyr_table(tplyr_adsl, TRT01A) %>% add_layer( group_desc(HEIGHTBL) %>% set_format_strings( @@ -203,10 +203,10 @@ The order in which results appear on a frequency table can be deceptively comple "byfactor" is the default ordering method of results for count layers. Both "byfactor" and "byvarn" behave exactly like the order variables associated with `by` variables in a **Tplyr** table. For "byvarn", you must set the sort method using `set_order_count_method()`. ```{r} -adsl$AGEGR1 <- factor(adsl$AGEGR1, c("<65", "65-80", ">80")) +tplyr_adsl$AGEGR1 <- factor(tplyr_adsl$AGEGR1, c("<65", "65-80", ">80")) # Warnings suppressed to remove 'forcats' implicit NA warning suppressWarnings({ - tplyr_table(adsl, TRT01A) %>% + tplyr_table(tplyr_adsl, TRT01A) %>% add_layer( group_count(AGEGR1) %>% # This is the default and not needed @@ -219,7 +219,7 @@ suppressWarnings({ ``` ```{r} -tplyr_table(adsl, TRT01A) %>% +tplyr_table(tplyr_adsl, TRT01A) %>% add_layer( group_count(RACE) %>% set_order_count_method("byvarn") @@ -239,7 +239,7 @@ Using count-based sorting is where things get more complicated. There are multip We've created helper functions to aid in making this step more intuitive from a user perspective, and to maintain the flexibility that you need. The two functions that you need here are `set_ordering_cols()` and `set_result_order_var()`. ```{r} -tplyr_table(adae, TRTA) %>% +tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(AEDECOD) %>% # This will present 3 numbers in a cell @@ -267,7 +267,7 @@ The next question that we need to answer when sorting by counts is which result But what if you have an additional column variable on top of the treatment groups? ```{r} -tplyr_table(adae, TRTA, cols=SEX) %>% +tplyr_table(tplyr_adae, TRTA, cols=SEX) %>% add_layer( group_count(AEDECOD) %>% # This will present 3 numbers in a cell @@ -295,7 +295,7 @@ Here we're ordering on the female subjects in the "Xanomeline High Dose" cohort. Nested count layers add one more piece to the puzzle. As a reminder, nested count layers are count summaries that are summarizing both a grouping variable, and a variable that's being grouped. The best example is probably Adverse Event tables, where we want to see adverse events that occurred within different body systems. ```{r} -tplyr_table(adae, TRTA) %>% +tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(vars(AEBODSYS, AEDECOD)) ) %>% @@ -310,7 +310,7 @@ In a layer that uses nesting, we need one more order variable - as we're now con These result variables will always be the last two order variables output by **Tplyr**. In the above example, `ord_layer_1` is for `AEBODSYS` and `ord_layer_2` is for `AEDECOD`. Note that `ord_layer_2` has `Inf` where `row_label1` and `row_label2` are both equal. This is the row that summarizes the `AEBODSYS` counts. By default, **Tplyr** is set to assume that you will use **descending** sort on the order variable associated with the inside count variable (i.e. `AEDECOD`). This is because in nested count layer you will often want to sort by descending occurrence of the inside target variable. If you'd like to use ascending sorting instead, we offer the function `set_outer_sort_position()`. ```{r} -tplyr_table(adae, TRTA) %>% +tplyr_table(tplyr_adae, TRTA) %>% add_layer( group_count(vars(AEBODSYS, AEDECOD)) %>% set_outer_sort_position("asc") @@ -327,7 +327,7 @@ Notice that the `Inf` has now switched to `-Inf` to ensure that the `AEBODSYS` r Another consideration of nested sorting is whether or not you want to sort both result variables the same way. Do you want to sort both by counts? Or do you want to sort one alphabetically and the other by count? Or maybe one has a `VARN` variable associated with it? For this reason, `set_order_count_method()` can take in a 2-element character vector, where the first element specifies the outside variable and the second the inside variable. ```{r} -tplyr_table(adsl, TRT01A) %>% +tplyr_table(tplyr_adsl, TRT01A) %>% add_layer( group_count(vars(EOSSTT, DCDECOD)) %>% set_order_count_method(c("byfactor", "bycount")) @@ -342,7 +342,7 @@ In the example above, `EOSTT` is ordered alphabetically (recall that using "byfa If only one method is provided, that method will automatically be applied to both variables. So in the example below, "bycount" is applied to both `EOSTT` and `DSDECOD`. ```{r} -tplyr_table(adsl, TRT01A) %>% +tplyr_table(tplyr_adsl, TRT01A) %>% add_total_group() %>% add_layer( group_count(vars(EOSSTT, DCDECOD)) %>% @@ -361,7 +361,7 @@ tplyr_table(adsl, TRT01A) %>% Shift tables keep things relatively simple when it comes to sorting and use the "byfactor" method seen above. We encourage this primarily because you likely want the benefits of factor variables on a shift layer. For example, consider this table: ```{r} -tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% +tplyr_table(tplyr_adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) ) %>% @@ -379,10 +379,10 @@ There are a few problems here: Using factor variables cleans this right up for us: ```{r} -adlb$BNRIND <- factor(adlb$BNRIND, levels=c("L", "N", "H")) -adlb$ANRIND <- factor(adlb$ANRIND, levels=c("L", "N", "H")) +tplyr_adlb$BNRIND <- factor(tplyr_adlb$BNRIND, levels=c("L", "N", "H")) +tplyr_adlb$ANRIND <- factor(tplyr_adlb$ANRIND, levels=c("L", "N", "H")) -tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% +tplyr_table(tplyr_adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) ) %>% diff --git a/vignettes/styled-table.Rmd b/vignettes/styled-table.Rmd index 16c50869..9dea9a6e 100644 --- a/vignettes/styled-table.Rmd +++ b/vignettes/styled-table.Rmd @@ -42,7 +42,7 @@ Let's build a demographics table to see how this all works. ## Preparing the data ```{r demog_table} -adsl <- adsl %>% +tplyr_adsl <- tplyr_adsl %>% mutate( SEX = recode(SEX, M = "Male", F = "Female"), RACE = factor(RACE, c("AMERICAN INDIAN OR ALASKA NATIVE", "ASIAN", "BLACK OR AFRICAN AMERICAN", diff --git a/vignettes/table.Rmd b/vignettes/table.Rmd index c8da37f9..ae9c9a82 100644 --- a/vignettes/table.Rmd +++ b/vignettes/table.Rmd @@ -37,7 +37,7 @@ The `tplyr_table()` function has 4 parameters: Let's look at an example: ```{r table_params1} -tplyr_table(adsl, TRT01P, where= SAFFL =="Y", cols = SEX) %>% +tplyr_table(tplyr_adsl, TRT01P, where= SAFFL =="Y", cols = SEX) %>% add_layer( group_count(RACE, by = "Race") ) %>% @@ -53,7 +53,7 @@ In the example above, the `where` parameter is passed forward into both the `RAC _Note: Treatment groups and additional column variables presented in the final output are always taken from the **pre-filtered** population data. This means that if a filter completed excludes a treatment group or group within a column variable, columns will still be created for those groups and will be empty/zero filled._ ```{r table_params2} -tplyr_table(adsl, TRT01P, where= SAFFL =="Y", cols = vars(SEX, RACE)) %>% +tplyr_table(tplyr_adsl, TRT01P, where= SAFFL =="Y", cols = vars(SEX, RACE)) %>% add_layer( group_desc(AGE, by = "Age (Years)") ) %>% @@ -71,7 +71,7 @@ Another important feature that works at the table level is the addition of treat We've added the function `add_treat_grps()` to do this work for you. With this function, you can create new treatment groups by combining existing treatment groups from values within `treat_var`. Additionally, to simplify the process we added an abstraction of `add_treat_grps()` named `add_total_group()` to simplify the process of creating a "Total" group. ```{r treat_grps} -tplyr_table(adsl, TRT01P) %>% +tplyr_table(tplyr_adsl, TRT01P) %>% add_treat_grps('Treated' = c("Xanomeline High Dose", "Xanomeline Low Dose")) %>% add_total_group() %>% add_layer( @@ -90,8 +90,8 @@ A last and very important aspect of table level properties in **Tplyr** is the a **Tplyr** allows you to provide a separate population dataset to overcome this. Furthermore, you are also able to provide a separate population dataset `where` parameter and a population treatment variable named `pop_treat_var`, as variable names may differ between the datasets. ```{r pop_data1} -t <- tplyr_table(adae, TRTA, where = AEREL != "NONE") %>% - set_pop_data(adsl) %>% +t <- tplyr_table(tplyr_adae, TRTA, where = AEREL != "NONE") %>% + set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01A) %>% set_pop_where(TRUE) %>% add_layer( From bda673faf594fe9a05d92966c437e00b9b76888c Mon Sep 17 00:00:00 2001 From: Andrew Bates Date: Mon, 18 Dec 2023 18:31:35 +0000 Subject: [PATCH 25/83] fix dataset name in vignette --- vignettes/post_processing.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/post_processing.Rmd b/vignettes/post_processing.Rmd index 55bafa1d..1c6ba1f9 100644 --- a/vignettes/post_processing.Rmd +++ b/vignettes/post_processing.Rmd @@ -103,7 +103,7 @@ There are a few considerations when using `apply_row_masks()`: Different table formats call for different handling of row labels, depending on the preferences of an individual organization and the specifics of the table at hand. **Tplyr** inherently creates row labels as separate columns, but similar to the way that count layers nest the inner and the outer layer, we also offer the `collapse_row_labels()` function to pull multiple row labels into a single column. ```{r collapse_row_labels} -dat <- tplyr_table(adsl, TRT01P) %>% +dat <- tplyr_table(tplyr_adsl, TRT01P) %>% add_layer( group_count(RACE, by = vars("Race n (%)", SEX)) ) %>% From f079b7bfcc509aeb6f590e1527df8f1f0b9ee225 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 18 Dec 2023 19:35:51 +0000 Subject: [PATCH 26/83] Fix README and add note on data --- README.Rmd | 4 +-- README.md | 85 +++++++++++++++++++++++++++--------------------------- 2 files changed, 44 insertions(+), 45 deletions(-) diff --git a/README.Rmd b/README.Rmd index b86086fa..10e66238 100644 --- a/README.Rmd +++ b/README.Rmd @@ -74,10 +74,9 @@ When you look at this table, you can begin breaking this output down into smalle So we have one table, with 6 summaries (7 including the next page, not shown) - but only 2 different approaches to summaries being performed. In the same way that [dplyr](https://dplyr.tidyverse.org/) is a grammar of data manipulation, **Tplyr** aims to be a grammar of data summary. The goal of **Tplyr** is to allow you to program a summary table like you see it on the page, by breaking a larger problem into smaller 'layers', and combining them together like you see on the page. -Enough talking - let's see some code. In these examples, we will be using data from the [PHUSE Test Data Factory]( https://advance.phuse.global/display/WEL/Test+Dataset+Factory) based on the [original pilot project submission package](https://github.com/atorus-research/CDISC_pilot_replication). Note: You can see our replication of the CDISC pilot using the PHUSE Test Data Factory data [here](https://github.com/atorus-research/CDISC_pilot_replication). +Enough talking - let's see some code. In these examples, we will be using data from the [PHUSE Test Data Factory]( https://advance.phuse.global/display/WEL/Test+Dataset+Factory) based on the [original pilot project submission package](https://github.com/atorus-research/CDISC_pilot_replication). We've packaged some subsets of that data into **Tplyr**, which you can use to replicate our examples and run our vignette code yourself. Note: You can see our replication of the CDISC pilot using the PHUSE Test Data Factory data [here](https://github.com/atorus-research/CDISC_pilot_replication). ```{r initial_demo} - tplyr_table(tplyr_adsl, TRT01P, where = SAFFL == "Y") %>% add_layer( group_desc(AGE, by = "Age (years)") @@ -87,7 +86,6 @@ tplyr_table(tplyr_adsl, TRT01P, where = SAFFL == "Y") %>% ) %>% build() %>% kable() - ``` ## *Tplyr* is Qualified diff --git a/README.md b/README.md index 98d0c81a..a92c34f1 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ -# Tplyr +# *Tplyr* @@ -42,7 +42,7 @@ install.packages("Tplyr") devtools::install_github("https://github.com/atorus-research/Tplyr.git", ref="devel") ``` -# What is Tplyr? +# What is *Tplyr*? [dplyr](https://dplyr.tidyverse.org/) from tidyverse is a grammar of data manipulation. So what does that allow you to do? It gives you, as a @@ -58,10 +58,10 @@ pharmaceutical industry, a great deal of the data presented in the outputs we create are very similar. For the most part, most of these tables can be broken down into a few categories: -- Counting for event based variables or categories -- Shifting, which is just counting a change in state with a ‘from’ and - a ‘to’ -- Generating descriptive statistics around some continuous variable. +- Counting for event based variables or categories +- Shifting, which is just counting a change in state with a ‘from’ and a + ‘to’ +- Generating descriptive statistics around some continuous variable. For many of the tables that go into a clinical submission, the tables are made up of a combination of these approaches. Consider a @@ -81,15 +81,15 @@ into smaller, redundant, components. These components can be viewed as layers. The boxes in the image above represent how you can begin to conceptualize this. -- First we have Sex, which is made up of n (%) counts. -- Next we have Age as a continuous variable, where we have a number of - descriptive statistics, including n, mean, standard deviation, - median, quartile 1, quartile 3, min, max, and missing values. -- After that we have age, but broken into categories - so this is once - again n (%) values. -- Race - more counting, -- Ethnicity - more counting -- Weight - and we’re back to descriptive statistics. +- First we have Sex, which is made up of n (%) counts. +- Next we have Age as a continuous variable, where we have a number of + descriptive statistics, including n, mean, standard deviation, median, + quartile 1, quartile 3, min, max, and missing values. +- After that we have age, but broken into categories - so this is once + again n (%) values. +- Race - more counting, +- Ethnicity - more counting +- Weight - and we’re back to descriptive statistics. So we have one table, with 6 summaries (7 including the next page, not shown) - but only 2 different approaches to summaries being performed. @@ -104,13 +104,14 @@ using data from the [PHUSE Test Data Factory](https://advance.phuse.global/display/WEL/Test+Dataset+Factory) based on the [original pilot project submission package](https://github.com/atorus-research/CDISC_pilot_replication). -Note: You can see our replication of the CDISC pilot using the PHUSE -Test Data Factory data +We’ve packaged some subsets of that data into **Tplyr**, which you can +use to replicate our examples and run our vignette code yourself. Note: +You can see our replication of the CDISC pilot using the PHUSE Test Data +Factory data [here](https://github.com/atorus-research/CDISC_pilot_replication). ``` r - -tplyr_table(adsl, TRT01P, where = SAFFL == "Y") %>% +tplyr_table(tplyr_adsl, TRT01P, where = SAFFL == "Y") %>% add_layer( group_desc(AGE, by = "Age (years)") ) %>% @@ -133,7 +134,7 @@ tplyr_table(adsl, TRT01P, where = SAFFL == "Y") %>% | Age Categories n (%) | \>80 | 30 ( 34.9%) | 18 ( 21.4%) | 29 ( 34.5%) | 2 | 1 | 2 | | Age Categories n (%) | 65-80 | 42 ( 48.8%) | 55 ( 65.5%) | 47 ( 56.0%) | 2 | 1 | 3 | -## Tplyr is Qualified +## *Tplyr* is Qualified We understand how important documentation and testing is within the pharmaceutical world. This is why outside of unit testing **Tplyr** @@ -153,38 +154,38 @@ this report. Here are some of the high level benefits of using **Tplyr**: -- Easy construction of table data using an intuitive syntax -- Smart string formatting for your numbers that’s easily specified by - the user -- A great deal of flexibility in what is performed and how it’s - presented, without specifying hundreds of parameters +- Easy construction of table data using an intuitive syntax +- Smart string formatting for your numbers that’s easily specified by + the user +- A great deal of flexibility in what is performed and how it’s + presented, without specifying hundreds of parameters # Where to go from here? There’s quite a bit more to learn! And we’ve prepared a number of other vignettes to help you get what you need out of **Tplyr**. -- The best place to start is with our Getting Started vignette at - `vignette("Tplyr")` -- Learn more about table level settings in `vignette("table")` -- Learn more about descriptive statistics layers in `vignette("desc")` -- Learn more about count layers in `vignette("count")` -- Learn more about shift layers in `vignette("shift")` -- Learn more about percentages in `vignette("denom")` -- Learn more about calculating risk differences in - `vignette("riskdiff")` -- Learn more about sorting **Tplyr** tables in `vignette("sort")` -- Learn more about using **Tplyr** options in `vignette("options")` -- And finally, learn more about producing and outputting styled tables - using **Tplyr** in `vignette("styled-table")` +- The best place to start is with our Getting Started vignette at + `vignette("Tplyr")` +- Learn more about table level settings in `vignette("table")` +- Learn more about descriptive statistics layers in `vignette("desc")` +- Learn more about count layers in `vignette("count")` +- Learn more about shift layers in `vignette("shift")` +- Learn more about percentages in `vignette("denom")` +- Learn more about calculating risk differences in + `vignette("riskdiff")` +- Learn more about sorting **Tplyr** tables in `vignette("sort")` +- Learn more about using **Tplyr** options in `vignette("options")` +- And finally, learn more about producing and outputting styled tables + using **Tplyr** in `vignette("styled-table")` In the **Tplyr** version 1.0.0, we’ve packed a number of new features in. For deeper dives on the largest new additions: -- Learn about **Tplyr’s** traceability metadata in - `vignette("metadata")` and about how it can be extended in - `vignette("custom-metadata")` -- Learn about layer templates in `vignette("layer_templates")` +- Learn about **Tplyr**’s traceability metadata in + `vignette("metadata")` and about how it can be extended in + `vignette("custom-metadata")` +- Learn about layer templates in `vignette("layer_templates")` # References From 9f5699756efcb8c4d93822f27e1048771985b596 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 18 Dec 2023 19:36:08 +0000 Subject: [PATCH 27/83] Update pkgdown entries --- _pkgdown.yml | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index b638c118..8218614e 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -105,12 +105,13 @@ reference: - title: Post-pocessing desc: Post-pocessing functions - contents: - - str_indent_wrap - - apply_row_masks - apply_conditional_format + - apply_formats + - apply_row_masks + - collapse_row_labels - str_extract_fmt_group - str_extract_num - - apply_formats + - str_indent_wrap - title: Helper functions desc: General helper functions - contents: @@ -122,6 +123,14 @@ reference: - get_where.tplyr_layer - Tplyr - get_tplyr_regex +- title: Data + desc: Tplyr Built-in Datasets +- contents: + - tplyr_adae + - tplyr_adas + - tplyr_adlb + - tplyr_adsl + - get_data_labels articles: - title: Table Basics From 7cf5e60df3ac0de0f933d8ba3e98e5d0dcbcdbdb Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 18 Dec 2023 19:36:23 +0000 Subject: [PATCH 28/83] Fix vignette example --- vignettes/styled-table.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/styled-table.Rmd b/vignettes/styled-table.Rmd index 9dea9a6e..3d1a73df 100644 --- a/vignettes/styled-table.Rmd +++ b/vignettes/styled-table.Rmd @@ -49,7 +49,7 @@ tplyr_adsl <- tplyr_adsl %>% "NATIVE HAWAIIN OR OTHER PACIFIC ISLANDER", "WHITE", "MULTIPLE")) ) -t <- tplyr_table(adsl, TRT01P) %>% +t <- tplyr_table(tplyr_adsl, TRT01P) %>% add_total_group() %>% add_layer(name = 'Sex', group_count(SEX, by = "Sex n (%)") %>% From 8829b8f58ab0c094d638efd7dbca5b566e08c404 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 18 Dec 2023 20:43:26 +0000 Subject: [PATCH 29/83] Remove code and functions that are unused/obsolete --- R/layer.R | 10 +--------- R/table.R | 9 --------- R/utils.R | 36 ++---------------------------------- 3 files changed, 3 insertions(+), 52 deletions(-) diff --git a/R/layer.R b/R/layer.R index abaea5a9..be165ac5 100644 --- a/R/layer.R +++ b/R/layer.R @@ -101,18 +101,10 @@ as_tplyr_layer.tplyr_layer <- function(parent, target_var, by, where, type, ...) layer } -#' S3 method for tplyr layer creation of \code{tplyr_subgroup_layer} object as parent -#' @noRd -as_tplyr_layer.tplyr_subgroup_layer <- function(parent, target_var, by, where, type, ...) { - layer <- new_tplyr_layer(parent, target_var, by, where, type, ...) - class(layer) <- unique(append('tplyr_subgroup_layer', class(layer))) - layer -} - #' S3 method to produce error for unsupported objects as parent #' @noRd as_tplyr_layer.default <- function(parent, target_var, by, where, type, ...) { - stop('Must provide `tplyr_table`, `tplyr_layer`, or `tplyr_subgroup_layer` object from the `tplyr` package.') + stop('Must provide `tplyr_table` object from the `Tplyr` package.', call.=FALSE) } #' Create a new tplyr layer diff --git a/R/table.R b/R/table.R index a2441b3a..f9c79f6c 100644 --- a/R/table.R +++ b/R/table.R @@ -41,16 +41,7 @@ #' tab <- tplyr_table(iris, Species, where = Sepal.Length < 5.8) #' tplyr_table <- function(target, treat_var, where = TRUE, cols = vars()) { - - if(missing(target)){ - # return a blank environment if no table information is passed. This can be - # used as a placeholder when creating a table if the dataset is not available. - return(structure(rlang::env(), - class = c("tplyr_table", "environment"))) - } - target_name <- enexpr(target) - new_tplyr_table(target, enquo(treat_var), enquo(where), enquos(cols), target_name) } diff --git a/R/utils.R b/R/utils.R index 1187d100..f4c31c8d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -154,22 +154,6 @@ replace_by_string_names <- function(dat, by, treat_var = NULL) { mutate_at(row_labels, ~ as.character(.x)) # Coerce all row labels into character } -#' Get the unique levels/factors of a dataset -#' -#' @param e An environment, generally a table or a layer object -#' @param x A target variable to get the levels/unique values of -#' -#' @return Unique target values -#' @noRd -get_target_levels <- function(e, x) { - # If its a factor just return the levels - if(is.factor(env_get(e, "target", inherit = TRUE)[, as_name(x)])) levels(env_get(e, "built_target", inherit = TRUE)[, as_name(x)]) - # Otherwise return the unique values - else { - unique(env_get(e, "built_target", inherit = TRUE)[, as_name(x)]) - } -} - #' Replace repeating row label variables with blanks in preparation for display. #' #' Depending on the display package being used, row label values may need to be @@ -267,22 +251,6 @@ extract_character_from_quo <- function(var_list) { var_list[!is_symbol_] } -#' Get maximum string format recursivly -#' -#' @param lay A layer object -#' -#' @return Maximum length of sub layers -#' @noRd -get_max_length <- function(lay) { - # Initalize max_ to -1 - max_ <- -1L - # Get maximum length of all sub layers - if(length(lay$layers) > 0) max_ <- max(map_int(lay$layers, get_max_length)) - - # return greatest between sub layers and current layer - max(max_, lay$format_strings$size) -} - #' Clean variable attributes #' #' @param dat Dataframe to strip of variable attributes @@ -314,8 +282,8 @@ ut_round <- function(x, n=0) { # x is the value to be rounded # n is the precision of the rounding - posneg <- sign(x) - e <- abs(x) * 10^n + posneg <- sign(x) + e <- abs(x) * 10^n e <- e + 0.5 + sqrt(.Machine$double.eps) e <- trunc(e) e <- e / 10^n From d82b791f6c95c5edc7015d7e224e2613fa9af492 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 18 Dec 2023 20:43:37 +0000 Subject: [PATCH 30/83] Unnecessary test --- tests/testthat/test-table.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/tests/testthat/test-table.R b/tests/testthat/test-table.R index 0ad6340b..cb7cc564 100644 --- a/tests/testthat/test-table.R +++ b/tests/testthat/test-table.R @@ -1,9 +1,3 @@ -test_that("tplyr_table returns an empty envrionment of class 'tplyr_table' when passed no arguemnts", { - st <- tplyr_table() - expect_true(is.environment(st)) - expect_equal(length(rlang::env_names(st)), 0) -}) - test_that("tplyr_table returns a class of tplyr_table and environment", { tab <- tplyr_table(data.frame(a = 1:10, b = 11:20), a) expect_s3_class(tab, "tplyr_table") From dc10e6e79773ff8d8a61b4285ea31da64e05fe38 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 18 Dec 2023 20:43:49 +0000 Subject: [PATCH 31/83] Error message update --- tests/testthat/_snaps/layer.md | 2 +- tests/testthat/_snaps/layering.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/_snaps/layer.md b/tests/testthat/_snaps/layer.md index 6d6e847c..25bb92df 100644 --- a/tests/testthat/_snaps/layer.md +++ b/tests/testthat/_snaps/layer.md @@ -20,7 +20,7 @@ # Parent must be a `tplyr_table`, `tplyr_layer`, or `tplyr_subgroup_layer` - Must provide `tplyr_table`, `tplyr_layer`, or `tplyr_subgroup_layer` object from the `tplyr` package. + Must provide `tplyr_table` object from the `Tplyr` package. # `by` must me a string, a variable name, or multiple variables submitted using `dplyr::vars` diff --git a/tests/testthat/_snaps/layering.md b/tests/testthat/_snaps/layering.md index 4ce7816b..b2a93ce4 100644 --- a/tests/testthat/_snaps/layering.md +++ b/tests/testthat/_snaps/layering.md @@ -8,7 +8,7 @@ # Parent argument is a valid class (pass through to `tplyr_layer`) - Must provide `tplyr_table`, `tplyr_layer`, or `tplyr_subgroup_layer` object from the `tplyr` package. + Must provide `tplyr_table` object from the `Tplyr` package. # Only `Tplyr` methods are allowed in the `layer` parameter From 46456b709bb635c9655a603706f0e8a6659abe8b Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 19 Dec 2023 12:55:57 +0000 Subject: [PATCH 32/83] update to dev version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 77a85792..305e4678 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: Tplyr Title: A Traceability Focused Grammar of Clinical Data Summary -Version: 1.1.0 +Version: 1.1.0.9000 Authors@R: c( person(given = "Eli", From 791ef79470d88bea418055a9075dd364f0c04837 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 19 Dec 2023 19:36:51 +0000 Subject: [PATCH 33/83] fix bolding --- README.Rmd | 6 +++--- README.md | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/README.Rmd b/README.Rmd index 10e66238..e7d0eee2 100644 --- a/README.Rmd +++ b/README.Rmd @@ -19,7 +19,7 @@ library(Tplyr) library(knitr) ``` -# *Tplyr* +# **Tplyr** [](https://pharmaverse.org) @@ -48,7 +48,7 @@ install.packages("Tplyr") devtools::install_github("https://github.com/atorus-research/Tplyr.git", ref="devel") ``` -# What is *Tplyr*? +# What is **Tplyr**? [dplyr](https://dplyr.tidyverse.org/) from tidyverse is a grammar of data manipulation. So what does that allow you to do? It gives you, as a data analyst, the capability to easily and intuitively approach the problem of manipulating your data into an analysis ready form. [dplyr](https://dplyr.tidyverse.org/) conceptually breaks things down into verbs that allow you to focus on _what_ you want to do more than _how_ you have to do it. @@ -88,7 +88,7 @@ tplyr_table(tplyr_adsl, TRT01P, where = SAFFL == "Y") %>% kable() ``` -## *Tplyr* is Qualified +## **Tplyr** is Qualified We understand how important documentation and testing is within the pharmaceutical world. This is why outside of unit testing **Tplyr** includes an entire user-acceptance testing document, where requirements were established, test-cases were written, and tests were independently programmed and executed. We do this in the hope that you can leverage our work within a qualified programming environment, and that we save you a substantial amount of trouble in getting it there. diff --git a/README.md b/README.md index a92c34f1..31fcf75a 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ -# *Tplyr* +# **Tplyr** @@ -42,7 +42,7 @@ install.packages("Tplyr") devtools::install_github("https://github.com/atorus-research/Tplyr.git", ref="devel") ``` -# What is *Tplyr*? +# What is **Tplyr**? [dplyr](https://dplyr.tidyverse.org/) from tidyverse is a grammar of data manipulation. So what does that allow you to do? It gives you, as a @@ -134,7 +134,7 @@ tplyr_table(tplyr_adsl, TRT01P, where = SAFFL == "Y") %>% | Age Categories n (%) | \>80 | 30 ( 34.9%) | 18 ( 21.4%) | 29 ( 34.5%) | 2 | 1 | 2 | | Age Categories n (%) | 65-80 | 42 ( 48.8%) | 55 ( 65.5%) | 47 ( 56.0%) | 2 | 1 | 3 | -## *Tplyr* is Qualified +## **Tplyr** is Qualified We understand how important documentation and testing is within the pharmaceutical world. This is why outside of unit testing **Tplyr** From 57cbe56911d2063b335fa45bd05140cc76274b91 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 19 Dec 2023 19:39:49 +0000 Subject: [PATCH 34/83] Add new contributors to description --- DESCRIPTION | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 77a85792..ed5fb71c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,6 +26,14 @@ Authors@R: family = "Mascary", email = "sadchla.mascary@atorusresearch.com", role = "ctb"), + person(given = "Andrew", + family = "Bates", + email = "andrew.bates@atorusresearch.com", + role = "ctb"), + person(given = "Shiyu", + family = "Chen", + email = "shiyu.chen@atorusresearch.com", + role = "ctb"), person(given = "Atorus Research LLC", role = "cph") ) From 268a623e62c5083f26c0b41d12193cdbf0d9e95f Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 19 Dec 2023 19:46:17 +0000 Subject: [PATCH 35/83] Add replace_leading_whitespace function --- R/replace_leading_whitespace.R | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 R/replace_leading_whitespace.R diff --git a/R/replace_leading_whitespace.R b/R/replace_leading_whitespace.R new file mode 100644 index 00000000..a75ecc09 --- /dev/null +++ b/R/replace_leading_whitespace.R @@ -0,0 +1,28 @@ +#' Reformat strings with leading whitespace for HTML +#' +#' @param x Target string +#' @param tab_width Number of spaces to compensate for tabs +#' +#' @return String with   replaced for leading whitespace +#' @export +#' +#' @examples +#' x <- c(" Hello there", " Goodbye Friend ", "\tNice to meet you", " \t What are you up to? \t \t ") +#' replace_leading_whitespace(x) +#' +#' replace_leading_whitespace(x, tab=2) +#' +replace_leading_whitespace <- function(x, tab_width=4) { + # Pull out the leading whitespace chunk + leading_spaces <- stringr::str_match(x, "^([ \\t])+")[,1] + # Count spaces and tabs, factor in tab width + spaces <- stringr::str_count(leading_spaces, pattern = " ") + tabs <- stringr::str_count(leading_spaces, pattern = "\\t") * tab_width + leading_length <- as.integer(spaces + tabs) + + # Build the   string and combine with the trimmed string + nbsp_string <- map_chr(leading_length, \(.x) paste(rep(" ", .x), collapse="")) + minus_whitespace <- stringr::str_trim(x, side=left) + paste(nbsp_string, minus_whitespace, sep="") +} + From 4a94429f18436238494b1d6a8c66002d2bfff191 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 19 Dec 2023 20:56:13 +0000 Subject: [PATCH 36/83] Updated for #170 --- NAMESPACE | 2 ++ R/replace_leading_whitespace.R | 18 +++++++++----- R/zzz.R | 4 ++-- vignettes/post_processing.Rmd | 44 ++++++++++++++++++++++++++++++++++ 4 files changed, 60 insertions(+), 8 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 85bb70fb..d2b779eb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,6 +89,7 @@ export(process_statistic_data) export(process_statistic_formatting) export(process_summaries) export(remove_layer_template) +export(replace_leading_whitespace) export(set_by) export(set_count_layer_formats) export(set_custom_summaries) @@ -252,6 +253,7 @@ importFrom(stringr,str_detect) importFrom(stringr,str_extract) importFrom(stringr,str_extract_all) importFrom(stringr,str_locate_all) +importFrom(stringr,str_match) importFrom(stringr,str_match_all) importFrom(stringr,str_pad) importFrom(stringr,str_remove_all) diff --git a/R/replace_leading_whitespace.R b/R/replace_leading_whitespace.R index a75ecc09..94907755 100644 --- a/R/replace_leading_whitespace.R +++ b/R/replace_leading_whitespace.R @@ -7,22 +7,28 @@ #' @export #' #' @examples -#' x <- c(" Hello there", " Goodbye Friend ", "\tNice to meet you", " \t What are you up to? \t \t ") +#' x <- c(" Hello there", " Goodbye Friend ", "\tNice to meet you", +#' " \t What are you up to? \t \t ") #' replace_leading_whitespace(x) #' #' replace_leading_whitespace(x, tab=2) #' replace_leading_whitespace <- function(x, tab_width=4) { # Pull out the leading whitespace chunk - leading_spaces <- stringr::str_match(x, "^([ \\t])+")[,1] + leading_spaces <- str_match(x, "^([ \\t])+")[,1] # Count spaces and tabs, factor in tab width - spaces <- stringr::str_count(leading_spaces, pattern = " ") - tabs <- stringr::str_count(leading_spaces, pattern = "\\t") * tab_width + spaces <- str_count(leading_spaces, pattern = " ") + tabs <- str_count(leading_spaces, pattern = "\\t") * tab_width leading_length <- as.integer(spaces + tabs) # Build the   string and combine with the trimmed string - nbsp_string <- map_chr(leading_length, \(.x) paste(rep(" ", .x), collapse="")) - minus_whitespace <- stringr::str_trim(x, side=left) + nbsp_string <- map_chr(leading_length, \(.x) { + if (!is.na(.x)) { + paste(rep(" ", .x), collapse="") + } else { + "" + }}) + minus_whitespace <- str_trim(x, side='left') paste(nbsp_string, minus_whitespace, sep="") } diff --git a/R/zzz.R b/R/zzz.R index c111ad2a..70df2747 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -2,9 +2,9 @@ #' @importFrom rlang call_modify call_name call_args is_call current_env quo_name trace_back is_function list2 #' @importFrom rlang expr exprs enexprs enexpr is_named env_parent env_label is_logical is_empty is_quosures quo_is_symbol sym syms := as_name #' @importFrom rlang quos quo env_names env_bind_active as_label eval_tidy warn quo_is_call -#' @importFrom stringr str_split str_extract_all regex str_detect str_replace_all str_replace str_locate_all fixed str_count str_trim str_wrap +#' @importFrom stringr str_split str_extract_all regex str_detect str_replace_all str_replace str_locate_all fixed str_count str_trim str_wrap str_count #' @importFrom purrr flatten map map_lgl pmap_chr imap reduce map_chr map_int map_dbl map_dfr pmap_dfr walk2 map2 map2_dfr map2_chr walk -#' @importFrom stringr str_sub str_sub<- str_extract str_pad str_starts str_remove_all str_match_all +#' @importFrom stringr str_sub str_sub<- str_extract str_pad str_starts str_remove_all str_match_all str_match #' @importFrom tidyr pivot_longer pivot_wider replace_na #' @importFrom magrittr %>% extract extract2 #' @importFrom assertthat assert_that diff --git a/vignettes/post_processing.Rmd b/vignettes/post_processing.Rmd index 1c6ba1f9..ca676397 100644 --- a/vignettes/post_processing.Rmd +++ b/vignettes/post_processing.Rmd @@ -127,6 +127,50 @@ You also have control over which columns you collapse, allowing you to keep sepa ```{r collapse_row_labels3} collapse_row_labels(dat, row_label1, row_label2, indent = "  ") %>% select(row_label, row_label3, var1_Placebo) %>% + head() %>% + kable() +``` + +## Leading Spaces in HTML Files + +Another helper function we've made available is `replace_leading_whitespace()`. In the table created above, note that the `indent` parameter was set using ` `, which is a non-breaking space. This can be used in HTML files to preserve leading white spaces instead of automatically stripping them in the display, as viewing utilities usually do. Ever noticed that in your data viewers you typically don't see leading spaces? Yeah - that's why! + +Let's take the example from above and not change the `indent` parameter. + +```{r replace_leading_whitespace1} +collapse_row_labels(dat, row_label1, row_label2) %>% + select(row_label, row_label3, var1_Placebo) %>% + kable() +``` + +In indented rows, the spaces still exist, and we can see that in the dataframe output itself. + +```{r replace_leading_whitespace2} +collapse_row_labels(dat, row_label1, row_label2) %>% + select(row_label, row_label3, var1_Placebo) %>% + head() +``` + +But the HTML view strips them off when we pass it into the `kable()` function. `replace_leading_whitespace()` will take care of this for us by converting the spaces. Note that you'll see the ` ` in the raw data itself. + +```{r replace_leading_whitespace3} +collapse_row_labels(dat, row_label1, row_label2) %>% + select(row_label, row_label3, var1_Placebo) %>% + mutate( + across(where(is.character), ~ replace_leading_whitespace(.)) + ) %>% + head() +``` + +But now when we want to use this in a display, the ` ` characters will show as leading whitespace within our HTML table. Note that you'll need to prevent escaping special characters for this to work, or the raw text will display. In `kable()` you can use `escape=FALSE` do this. + +```{r replace_leading_whitespace4} +collapse_row_labels(dat, row_label1, row_label2) %>% + select(row_label, row_label3, var1_Placebo) %>% + mutate( + across(where(is.character), ~ replace_leading_whitespace(.)) + ) %>% + head() %>% kable(escape=FALSE) ``` From 7e6732dfa6997631814af1b5da87c92c8635bf74 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 19 Dec 2023 20:58:44 +0000 Subject: [PATCH 37/83] test file --- tests/testthat/test-replace_leading_whitespace.R | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 tests/testthat/test-replace_leading_whitespace.R diff --git a/tests/testthat/test-replace_leading_whitespace.R b/tests/testthat/test-replace_leading_whitespace.R new file mode 100644 index 00000000..d8ad0098 --- /dev/null +++ b/tests/testthat/test-replace_leading_whitespace.R @@ -0,0 +1,15 @@ +test_that("Test replacement of leading whitespace", { + x <- c("Hello there", " Goodbye Friend ", "\tNice to meet you", " \t What are you up to? \t \t ") + + expect_equal( + replace_leading_whitespace(x), + c("Hello there", "  Goodbye Friend ", + "    Nice to meet you", "       What are you up to? \t \t ") + ) + + expect_equal( + replace_leading_whitespace(x, tab=2), + c("Hello there", "  Goodbye Friend ", + "  Nice to meet you", "     What are you up to? \t \t ") + ) +}) From 48f133cb6078d2a09d612d2679640fb54b4cbb70 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 19 Dec 2023 20:59:31 +0000 Subject: [PATCH 38/83] old files --- .travis.yml | 12 ------------ azure-pipelines.yml | 44 -------------------------------------------- 2 files changed, 56 deletions(-) delete mode 100644 .travis.yml delete mode 100644 azure-pipelines.yml diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index c2c05e47..00000000 --- a/.travis.yml +++ /dev/null @@ -1,12 +0,0 @@ -language: r - -sudo: required - -env: _R_CHECK_CRAN_INCOMING_=FALSE - -r_packages: -- covr -- devtools - -after_success: - - Rscript -e 'library(covr); codecov()' diff --git a/azure-pipelines.yml b/azure-pipelines.yml deleted file mode 100644 index d0a7458e..00000000 --- a/azure-pipelines.yml +++ /dev/null @@ -1,44 +0,0 @@ -# Starter pipeline -# Start with a minimal pipeline that you can customize to build and deploy your code. -# Add steps that build, run tests, deploy, and more: -# https://aka.ms/yaml - -# parameters: -# - name: tidyverse_version -# displayName: Tidyverse Version -# type: string -# default: 'rocker/tidyverse:latest' -# values: -# - 'rocker/tidyverse:latest' -# - rocker/tidyverse:3.6.3 -# - rocker/tidyverse:3.6.2 -# - rocker/tidyverse:3.6.1 -# - rocker/tidyverse:3.6.0 -# - rocker/tidyverse:3.5.3 -# - rocker/tidyverse:3.5.2 -# - rocker/tidyverse:3.5.1 -# - rocker/tidyverse:3.5.0 -# - rocker/tidyverse:3.4.4 -# - rocker/tidyverse:3.4.3 -# - rocker/tidyverse:3.4.2 -# - rocker/tidyverse:3.4.1 -# - rocker/tidyverse:3.4.0 -# - rocker/tidyverse:3.3.3 -# - rocker/tidyverse:3.3.2 -# - rocker/tidyverse:3.3.1 - -trigger: none - -pool: - vmImage: 'ubuntu-latest' - -container: 'rocker/tidyverse:latest' - -steps: - -- script: sudo Rscript -e 'install.packages("huxtable"); devtools::check(cran = FALSE)' - displayName: 'Package Check' - continueOnError: true - -- script: Rscript -e 'sessionInfo()' - displayName: 'R Version' From a5516fae2afa5d7ae0a75d3142d90060eca13133 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 19 Dec 2023 21:00:02 +0000 Subject: [PATCH 39/83] allow a scratch file --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 3c628ab0..83d4b60f 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,4 @@ inst/doc Tplyr.Rproj docs/ +scratch.R From 83141753cd076b4dd6e6eaa41aab0f20cb2988f4 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 19 Dec 2023 21:00:23 +0000 Subject: [PATCH 40/83] can't seem to remember to include all the files I need to include. --- man/replace_leading_whitespace.Rd | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 man/replace_leading_whitespace.Rd diff --git a/man/replace_leading_whitespace.Rd b/man/replace_leading_whitespace.Rd new file mode 100644 index 00000000..cde36c59 --- /dev/null +++ b/man/replace_leading_whitespace.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/replace_leading_whitespace.R +\name{replace_leading_whitespace} +\alias{replace_leading_whitespace} +\title{Reformat strings with leading whitespace for HTML} +\usage{ +replace_leading_whitespace(x, tab_width = 4) +} +\arguments{ +\item{x}{Target string} + +\item{tab_width}{Number of spaces to compensate for tabs} +} +\value{ +String with   replaced for leading whitespace +} +\description{ +Reformat strings with leading whitespace for HTML +} +\examples{ +x <- c(" Hello there", " Goodbye Friend ", "\tNice to meet you", +" \t What are you up to? \t \t ") +replace_leading_whitespace(x) + +replace_leading_whitespace(x, tab=2) + +} From 81e489fe7df6f9d5aafd9e7b03800729294e665a Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 11 Jan 2024 15:11:46 +0000 Subject: [PATCH 41/83] I'm ashamed. --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index f4c31c8d..fa47cc17 100644 --- a/R/utils.R +++ b/R/utils.R @@ -12,7 +12,7 @@ modify_nested_call <- function(c, examine_only=FALSE, ...) { # Get exports from Tplyr - allowable_calls = getNamespaceExports("Tplyr") + allowable_calls <- getNamespaceExports("Tplyr") # Only allow the user to use `Tplyr` functions assert_that( From 1c3a3a156de052bfeca47c152f86c5958ecabef9 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 26 Jan 2024 19:31:33 +0000 Subject: [PATCH 42/83] Resolve #146 --- R/sort.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/sort.R b/R/sort.R index d4638fde..1409f713 100644 --- a/R/sort.R +++ b/R/sort.R @@ -207,7 +207,7 @@ add_order_columns.count_layer <- function(x) { # Add the ordering of the pieces in the layer formatted_data <- formatted_data %>% - group_by(.data[[paste0("ord_layer_", formatted_col_index - 1)]]) %>% + group_by(.data[[paste0("row_label", formatted_col_index - 1)]]) %>% do(add_data_order_nested(., formatted_col_index - 1, numeric_data, indentation_length = indentation_length, ordering_cols = ordering_cols, @@ -724,10 +724,11 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { } present_vars <- unlist(group_data[-1, row_label_vec[length(row_label_vec)]]) + ##### Inner nest values ##### filtered_numeric_data <- numeric_data %>% # Only include the parts of the numeric data that is in the current label - filter(numeric_data$summary_var %in% present_vars, !is.na(!!by[[1]])) %>% + filter(numeric_data$summary_var %in% present_vars, !!by[[1]] == outer_value) %>% # Remove nesting prefix to prepare numeric data. mutate(summary_var := str_sub(summary_var, indentation_length)) From ce21427cbc14228a25f8ca2838b66a5f20be3996 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 26 Jan 2024 19:44:37 +0000 Subject: [PATCH 43/83] Resolve #166 --- R/nested.R | 14 +++++++------- tests/testthat/_snaps/count.md | 18 ++++++++++++++---- tests/testthat/test-count.R | 21 ++++++++++++++------- 3 files changed, 35 insertions(+), 18 deletions(-) diff --git a/R/nested.R b/R/nested.R index 322b1588..a6c8fcdd 100644 --- a/R/nested.R +++ b/R/nested.R @@ -8,13 +8,13 @@ process_nested_count_target <- function(x) { assert_that(quo_is_symbol(target_var[[2]]), msg = "Inner layers must be data driven variables") - if(quo_is_symbol(target_var[[1]])){ - first_var_length <- length(unique(target[[as_name(target_var[[1]])]])) - second_var_length <- length(unique(target[[as_name(target_var[[2]])]])) - - assert_that(second_var_length >= first_var_length, - msg = "The number of values of your second variable must be greater than the number of levels in your first variable") - } + # if(quo_is_symbol(target_var[[1]])){ + # first_var_length <- length(unique(target[[as_name(target_var[[1]])]])) + # second_var_length <- length(unique(target[[as_name(target_var[[2]])]])) + # + # assert_that(second_var_length >= first_var_length, + # msg = "The number of values of your second variable must be greater than the number of levels in your first variable") + # } if(is.factor(target[[as_name(target_var[[1]])]])) { warning(paste0("Factors are not currently supported in nested count layers", diff --git a/tests/testthat/_snaps/count.md b/tests/testthat/_snaps/count.md index 3e73875e..6045b796 100644 --- a/tests/testthat/_snaps/count.md +++ b/tests/testthat/_snaps/count.md @@ -209,11 +209,21 @@ 8 2 ( 50.0%) 0 ( 0.0%) 1 3 1 9 0 ( 0.0%) 0 ( 0.0%) 1 3 2 -# nested count layers will error out if second variable is bigger than the first +# nested count can accept data if second variable is bigger than the first - i In index: 1. - Caused by error: - ! The number of values of your second variable must be greater than the number of levels in your first variable + Code + x + Output + row_label1 row_label2 var1_TRT1 + 1 Antiemetics and antinauseants Antiemetics and antinauseants 1 ( 50.0%) + 2 Antiemetics and antinauseants Promethazine hydrochloride 1 ( 50.0%) + 3 Psycholeptics Psycholeptics 1 ( 50.0%) + 4 Psycholeptics Promethazine hydrochloride 1 ( 50.0%) + var1_TRT2 ord_layer_index ord_layer_1 ord_layer_2 + 1 0 ( 0.0%) 1 1 Inf + 2 0 ( 0.0%) 1 1 1 + 3 1 (100.0%) 1 2 Inf + 4 1 (100.0%) 1 2 1 # set_numeric_threshold works as expected diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index e1fc3ccb..9c84dd4d 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -722,16 +722,23 @@ test_that("test specific rounding proplem #124", { options(tplyr.IBMRounding = FALSE) }) -test_that("nested count layers will error out if second variable is bigger than the first", { - mtcars <- mtcars2 - mtcars$grp <- paste0("grp.", as.numeric(mtcars$cyl) + rep(c(0, 0.5), 16)) +test_that("nested count can accept data if second variable is bigger than the first", { + test_adcm <- data.frame( + SUBJID = c("1", "2", "3"), + ATC2 = c("Antiemetics and antinauseants", "Psycholeptics", "Psycholeptics"), + CMDECOD = c("Promethazine hydrochloride", "Promethazine hydrochloride", "Promethazine hydrochloride"), + TRT101A = c("TRT1", "TRT2", "TRT1") + ) - t <- tplyr_table(mtcars, gear) %>% + x <- test_adcm %>% + tplyr_table(TRT101A) %>% add_layer( - group_count(vars(grp, cyl)) - ) + group_count(vars(ATC2, CMDECOD)) + ) %>% + build() %>% + as.data.frame() - expect_snapshot_error(build(t)) + expect_snapshot(x) }) test_that("Posix columns don't cause the build to error out.", { From 4d39052e2f1289ec2f03668048ab1bde6da050a1 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 26 Jan 2024 19:57:41 +0000 Subject: [PATCH 44/83] Dead code and small test fix --- R/nested.R | 8 -------- tests/testthat/test-count.R | 3 +++ 2 files changed, 3 insertions(+), 8 deletions(-) diff --git a/R/nested.R b/R/nested.R index a6c8fcdd..e05e854c 100644 --- a/R/nested.R +++ b/R/nested.R @@ -8,14 +8,6 @@ process_nested_count_target <- function(x) { assert_that(quo_is_symbol(target_var[[2]]), msg = "Inner layers must be data driven variables") - # if(quo_is_symbol(target_var[[1]])){ - # first_var_length <- length(unique(target[[as_name(target_var[[1]])]])) - # second_var_length <- length(unique(target[[as_name(target_var[[2]])]])) - # - # assert_that(second_var_length >= first_var_length, - # msg = "The number of values of your second variable must be greater than the number of levels in your first variable") - # } - if(is.factor(target[[as_name(target_var[[1]])]])) { warning(paste0("Factors are not currently supported in nested count layers", " that have two data driven variables. Factors will be coerced into character vectors"), diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index 9c84dd4d..b4d929f2 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -905,6 +905,9 @@ test_that("nested count layers error out when you try to add a total row", { ) expect_snapshot_error(build(tab)) + + # The weird use of mtcars2 makes us have to overwrite this again + mtcars <- mtcars2 }) test_that("Tables with pop_data can accept a layer level where", { From d277c9c5da155ee3204ca65a29d4a6fb4c2ec447 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 26 Jan 2024 21:10:30 +0000 Subject: [PATCH 45/83] Update documentation to add note relavent to #160 --- R/count_bindings.R | 4 ++++ R/pop_data.R | 36 +++++++++++++++++++++--------------- man/add_total_row.Rd | 4 ++++ man/treat_grps.Rd | 36 +++++++++++++++++++++--------------- 4 files changed, 50 insertions(+), 30 deletions(-) diff --git a/R/count_bindings.R b/R/count_bindings.R index 291779e3..197c6757 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -12,6 +12,10 @@ #' use \code{set_denoms_by()}, and the grouping of \code{add_total_row()} will #' be updated accordingly. #' +#' Note that when using \code{add_total_row()} with \code{set_pop_data()}, you +#' should call \code{add_total_row()} AFTER calling \code{set_pop_data()}, +#' otherwise there is potential for unexpected behaivior with treatment groups. +#' #' @param e A \code{count_layer} object #' @param fmt An f_str object used to format the total row. If none is provided, #' display is based on the layer formatting. diff --git a/R/pop_data.R b/R/pop_data.R index ee98174e..9e79f1d0 100644 --- a/R/pop_data.R +++ b/R/pop_data.R @@ -36,27 +36,33 @@ build_header_n <- function(table) { #' Combine existing treatment groups for summary #' -#' Summary tables often present individual treatment groups, -#' but may additionally have a "Treatment vs. Placebo" or "Total" group added -#' to show grouped summary statistics or counts. This set of functions offers -#' an interface to add these groups at a table level and be consumed by -#' subsequent layers. +#' Summary tables often present individual treatment groups, but may +#' additionally have a "Treatment vs. Placebo" or "Total" group added to show +#' grouped summary statistics or counts. This set of functions offers an +#' interface to add these groups at a table level and be consumed by subsequent +#' layers. #' #' \code{add_treat_grps} allows you to specify specific groupings. This is done -#' by supplying named arguments, where the name becomes the new treatment group's -#' name, and those treatment groups are made up of the argument's values. +#' by supplying named arguments, where the name becomes the new treatment +#' group's name, and those treatment groups are made up of the argument's +#' values. #' -#' \code{add_total_group} is a simple wrapper around \code{add_treat_grps}. Instead of -#' producing custom groupings, it produces a "Total" group by the supplied name, which -#' defaults to "Total". This "Total" group is made up of all existing treatment -#' groups within the population dataset. +#' \code{add_total_group} is a simple wrapper around \code{add_treat_grps}. +#' Instead of producing custom groupings, it produces a "Total" group by the +#' supplied name, which defaults to "Total". This "Total" group is made up of +#' all existing treatment groups within the population dataset. #' -#' The function \code{treat_grps} allows you to see the custom treatment groups available -#' in your \code{tplyr_table} object +#' Note that when using \code{add_treat_grps} or \code{add_total_row()} with +#' \code{set_pop_data()}, you should call \code{add_total_row()} AFTER calling +#' \code{set_pop_data()}, otherwise there is potential for unexpected behaivior +#' with treatment groups. +#' +#' The function \code{treat_grps} allows you to see the custom treatment groups +#' available in your \code{tplyr_table} object #' #' @param table A \code{tplyr_table} object -#' @param ... A named vector where names will become the new treatment group names, -#' and values will be used to construct those treatment groups +#' @param ... A named vector where names will become the new treatment group +#' names, and values will be used to construct those treatment groups #' #' @return The modified table object #' @export diff --git a/man/add_total_row.Rd b/man/add_total_row.Rd index c9ca5f97..102423db 100644 --- a/man/add_total_row.Rd +++ b/man/add_total_row.Rd @@ -33,6 +33,10 @@ total and the application of denominators becomes ambiguous. You will be warned specifically if a percent is included in the format. To rectify this, use \code{set_denoms_by()}, and the grouping of \code{add_total_row()} will be updated accordingly. + +Note that when using \code{add_total_row()} with \code{set_pop_data()}, you +should call \code{add_total_row()} AFTER calling \code{set_pop_data()}, +otherwise there is potential for unexpected behaivior with treatment groups. } \examples{ # Load in Pipe diff --git a/man/treat_grps.Rd b/man/treat_grps.Rd index 1ed42a3e..d133bb87 100644 --- a/man/treat_grps.Rd +++ b/man/treat_grps.Rd @@ -15,8 +15,8 @@ treat_grps(table) \arguments{ \item{table}{A \code{tplyr_table} object} -\item{...}{A named vector where names will become the new treatment group names, -and values will be used to construct those treatment groups} +\item{...}{A named vector where names will become the new treatment group +names, and values will be used to construct those treatment groups} \item{group_name}{The treatment group name used for the constructed 'Total' group} } @@ -24,24 +24,30 @@ and values will be used to construct those treatment groups} The modified table object } \description{ -Summary tables often present individual treatment groups, -but may additionally have a "Treatment vs. Placebo" or "Total" group added -to show grouped summary statistics or counts. This set of functions offers -an interface to add these groups at a table level and be consumed by -subsequent layers. +Summary tables often present individual treatment groups, but may +additionally have a "Treatment vs. Placebo" or "Total" group added to show +grouped summary statistics or counts. This set of functions offers an +interface to add these groups at a table level and be consumed by subsequent +layers. } \details{ \code{add_treat_grps} allows you to specify specific groupings. This is done -by supplying named arguments, where the name becomes the new treatment group's -name, and those treatment groups are made up of the argument's values. +by supplying named arguments, where the name becomes the new treatment +group's name, and those treatment groups are made up of the argument's +values. -\code{add_total_group} is a simple wrapper around \code{add_treat_grps}. Instead of -producing custom groupings, it produces a "Total" group by the supplied name, which -defaults to "Total". This "Total" group is made up of all existing treatment -groups within the population dataset. +\code{add_total_group} is a simple wrapper around \code{add_treat_grps}. +Instead of producing custom groupings, it produces a "Total" group by the +supplied name, which defaults to "Total". This "Total" group is made up of +all existing treatment groups within the population dataset. -The function \code{treat_grps} allows you to see the custom treatment groups available -in your \code{tplyr_table} object +Note that when using \code{add_treat_grps} or \code{add_total_row()} with +\code{set_pop_data()}, you should call \code{add_total_row()} AFTER calling +\code{set_pop_data()}, otherwise there is potential for unexpected behaivior +with treatment groups. + +The function \code{treat_grps} allows you to see the custom treatment groups +available in your \code{tplyr_table} object } \examples{ tab <- tplyr_table(iris, Species) From eb248e0b3309062b69d2c4846b03de71c098bb02 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 1 Feb 2024 19:44:17 +0000 Subject: [PATCH 46/83] Initial addition of data limiting function --- NAMESPACE | 1 + R/count.R | 20 +++++++++++++++++--- R/count_bindings.R | 24 ++++++++++++++++++++++++ man/set_limit_data_by.Rd | 18 ++++++++++++++++++ 4 files changed, 60 insertions(+), 3 deletions(-) create mode 100644 man/set_limit_data_by.Rd diff --git a/NAMESPACE b/NAMESPACE index d2b779eb..4e901e36 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -101,6 +101,7 @@ export(set_distinct_by) export(set_format_strings) export(set_header_n) export(set_indentation) +export(set_limit_data_by) export(set_missing_count) export(set_nest_count) export(set_numeric_threshold) diff --git a/R/count.R b/R/count.R index 030db51d..ae5ff2de 100644 --- a/R/count.R +++ b/R/count.R @@ -121,7 +121,7 @@ process_summaries.count_layer <- function(x, ...) { #' If include_total_row is true a row will be added with a total row labeled #' with total_row_label. #' -#' Complete is used to complete the combinaions of by, treat_var, and target_var +#' Complete is used to complete the combinations of by, treat_var, and target_var #' #' @noRd process_single_count_target <- function(x) { @@ -256,11 +256,25 @@ process_count_n <- function(x) { names(missing_count_list))) } - summary_stat <- summary_stat %>% + complete_levels <- summary_stat %>% # complete all combinations of factors to include combinations that don't exist. # add 0 for combinations that don't exist complete(!!treat_var, !!!by, !!!target_var, !!!cols, - fill = list(n = 0, total = 0, distinct_n = 0, distinct_total = 0)) %>% + fill = list(n = 0, total = 0, distinct_n = 0, distinct_total = 0)) + + # Apply data limits specified by setter + if (exists("limit_data_by")) { + # Find the combinations actually in the data + groups_in_data <- summary_stat %>% + distinct(!!!limit_data_by) + + # Join back to limit the completed levels based on the preferred + # data driven ones + complete_levels <- groups_in_data %>% + left_join(complete_levels, by = map_chr(limit_data_by, as_name)) + } + + summary_stat <- complete_levels %>% # Change the treat_var and first target_var to characters to resolve any # issues if there are total rows and the original column is numeric mutate(!!treat_var := as.character(!!treat_var)) %>% diff --git a/R/count_bindings.R b/R/count_bindings.R index 197c6757..32d08e3e 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -711,3 +711,27 @@ set_numeric_threshold <- function(e, numeric_cutoff, stat, column = NULL) { e } + +#' Set variables to limit to data values only rather than fully completing all +#' possible levels +#' +#' @param e A tplyr_layer +#' @param ... Subset of variables within by or target variables +#' +#' @return +#' @export +set_limit_data_by <- function(e, ...) { + dots <- enquos(...) + dots_chr <- map_chr(dots, as_name) + + # Pull these variables to make sure the denoms used make sense + by_ <- map_chr(env_get(e, "by"), as_name) + tv_ <- map_chr(env_get(e, "target_var"), as_name) + + if (!all(dots_chr %in% c(by_, tv_))) { + stop("Complete by variables must be included in by variables set on layer", call.=FALSE) + } + + env_bind(e, limit_data_by = dots) + e +} diff --git a/man/set_limit_data_by.Rd b/man/set_limit_data_by.Rd new file mode 100644 index 00000000..76fb14e0 --- /dev/null +++ b/man/set_limit_data_by.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/count_bindings.R +\name{set_limit_data_by} +\alias{set_limit_data_by} +\title{Set variables to limit to data values only rather than fully completing all +possible levels} +\usage{ +set_limit_data_by(e, ...) +} +\arguments{ +\item{e}{A tplyr_layer} + +\item{...}{Subset of variables within by or target variables} +} +\description{ +Set variables to limit to data values only rather than fully completing all +possible levels +} From 9e15574265a3f7576cbe22282e924b444c88db74 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 2 Feb 2024 21:51:10 +0000 Subject: [PATCH 47/83] Separate to genericized function, add test file --- NAMESPACE | 2 + R/count.R | 19 +----- R/count_bindings.R | 24 -------- R/desc.R | 24 ++++++-- R/set_limit_data_by.R | 82 +++++++++++++++++++++++++ R/zzz.R | 1 + man/set_limit_data_by.Rd | 2 +- tests/testthat/test-set_limit_data_by.R | 64 +++++++++++++++++++ 8 files changed, 173 insertions(+), 45 deletions(-) create mode 100644 R/set_limit_data_by.R create mode 100644 tests/testthat/test-set_limit_data_by.R diff --git a/NAMESPACE b/NAMESPACE index 4e901e36..fe7924b1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -33,6 +33,8 @@ S3method(set_denoms_by,shift_layer) S3method(set_format_strings,count_layer) S3method(set_format_strings,desc_layer) S3method(set_format_strings,shift_layer) +S3method(set_limit_data_by,count_layer) +S3method(set_limit_data_by,desc_layer) S3method(set_where,tplyr_layer) S3method(set_where,tplyr_table) S3method(str,f_str) diff --git a/R/count.R b/R/count.R index ae5ff2de..8a876513 100644 --- a/R/count.R +++ b/R/count.R @@ -257,22 +257,9 @@ process_count_n <- function(x) { } complete_levels <- summary_stat %>% - # complete all combinations of factors to include combinations that don't exist. - # add 0 for combinations that don't exist - complete(!!treat_var, !!!by, !!!target_var, !!!cols, - fill = list(n = 0, total = 0, distinct_n = 0, distinct_total = 0)) - - # Apply data limits specified by setter - if (exists("limit_data_by")) { - # Find the combinations actually in the data - groups_in_data <- summary_stat %>% - distinct(!!!limit_data_by) - - # Join back to limit the completed levels based on the preferred - # data driven ones - complete_levels <- groups_in_data %>% - left_join(complete_levels, by = map_chr(limit_data_by, as_name)) - } + complete_and_limit(treat_var, by, target_var, cols, + limit = exists("limit_data_by"), + .fill = list(n = 0, total = 0, distinct_n = 0, distinct_total = 0)) summary_stat <- complete_levels %>% # Change the treat_var and first target_var to characters to resolve any diff --git a/R/count_bindings.R b/R/count_bindings.R index 32d08e3e..197c6757 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -711,27 +711,3 @@ set_numeric_threshold <- function(e, numeric_cutoff, stat, column = NULL) { e } - -#' Set variables to limit to data values only rather than fully completing all -#' possible levels -#' -#' @param e A tplyr_layer -#' @param ... Subset of variables within by or target variables -#' -#' @return -#' @export -set_limit_data_by <- function(e, ...) { - dots <- enquos(...) - dots_chr <- map_chr(dots, as_name) - - # Pull these variables to make sure the denoms used make sense - by_ <- map_chr(env_get(e, "by"), as_name) - tv_ <- map_chr(env_get(e, "target_var"), as_name) - - if (!all(dots_chr %in% c(by_, tv_))) { - stop("Complete by variables must be included in by variables set on layer", call.=FALSE) - } - - env_bind(e, limit_data_by = dots) - e -} diff --git a/R/desc.R b/R/desc.R index 00922c6a..829da546 100644 --- a/R/desc.R +++ b/R/desc.R @@ -49,16 +49,32 @@ process_summaries.desc_layer <- function(x, ...) { summaries <- get_summaries()[match_exact(summary_vars)] # Create the numeric summary data - num_sums_raw[[i]] <- built_target %>% + cmplt1 <- built_target %>% # Rename the current variable to make each iteration use a generic name rename(.var = !!cur_var) %>% # Group by treatment, provided by variable, and provided column variables group_by(!!treat_var, !!!by, !!!cols) %>% # Execute the summaries summarize(!!!summaries) %>% - ungroup() %>% - # Fill in any missing treat/col combinations - complete(!!treat_var, !!!by, !!!cols) + ungroup() + + num_sums_raw[[i]] <- complete_and_limit(cmplt1, treat_var, by, cols, limit_data_by=limit_data_by) + # num_sums_raw[[i]] <- cmplt1 %>% + # # complete all combinations of factors to include combinations that don't exist. + # # add 0 for combinations that don't exist + # complete(!!treat_var, !!!by, !!!cols) + # + # # Apply data limits specified by setter + # if (exists("limit_data_by")) { + # # Find the combinations actually in the data + # groups_in_data <- cmplt1 %>% + # distinct(!!!limit_data_by) + # + # # Join back to limit the completed levels based on the preferred + # # data driven ones + # num_sums_raw[[i]] <- groups_in_data %>% + # left_join(num_sums_raw[[i]], by = map_chr(limit_data_by, as_name)) + # } # Create the transposed summary data to prepare for formatting trans_sums[[i]] <- num_sums_raw[[i]] %>% diff --git a/R/set_limit_data_by.R b/R/set_limit_data_by.R new file mode 100644 index 00000000..ac08047e --- /dev/null +++ b/R/set_limit_data_by.R @@ -0,0 +1,82 @@ +#' Set variables to limit to data values only rather than fully completing all +#' possible levels +#' +#' @param e A tplyr_layer +#' @param ... Subset of variables within by or target variables +#' +#' @return +#' @export +set_limit_data_by <- function(e, ...) { + UseMethod("set_limit_data_by") +} + +#' @export +#' @noRd +set_limit_data_by.count_layer <- function(e, ...) { + dots <- enquos(...) + dots_chr <- map_chr(dots, as_name) + + # Pull these variables to make sure the denoms used make sense + by_ <- map_chr(env_get(e, "by"), as_name) + tv_ <- map_chr(env_get(e, "target_var"), as_name) + + if (!all(dots_chr %in% c(by_, tv_))) { + stop("Limit data by variables must be included in by variables or target variable set on layer", call.=FALSE) + } + + env_bind(e, limit_data_by = dots) + e +} + +#' @export +#' @noRd +set_limit_data_by.desc_layer <- function(e, ...) { + dots <- enquos(...) + dots_chr <- map_chr(dots, as_name) + + # Pull these variables to make sure the denoms used make sense + by_ <- map_chr(env_get(e, "by"), as_name) + + if (!all(dots_chr %in% by_)) { + stop("Limit data by variables must be included in by variables set on layer", call.=FALSE) + } + + env_bind(e, limit_data_by = dots) + e +} + +#' General function used to process the steps to pad levels in data, or limit to +#' combinations available in the data itself +#' +#' @param dat +#' @param treat_var +#' @param by +#' @param cols +#' @param target_var +#' @param limit +#' @param .fill +#' TODO: Figure out best way to pass the data limiting into this function, because it doesn't exist unless distinctly set. +complete_and_limit <- function(dat, treat_var, by, cols, target_var=quos(), limit_data_by, .fill=list()) { + + complete_levels <- dat %>% + # complete all combinations of factors to include combinations that don't exist. + # add 0 for combinations that don't exist + complete(!!treat_var, !!!by, !!!unname(target_var), !!!cols, + fill = .fill) + + # Apply data limits specified by setter + if (!is.null(limit_data_by)) { + # Find the combinations actually in the data + groups_in_data <- dat %>% + distinct(!!!limit_data_by) + + # Join back to limit the completed levels based on the preferred + # data driven ones + limited_data <- groups_in_data %>% + left_join(complete_levels, by = map_chr(limit_data_by, as_name)) + + return(limited_data) + } + + complete_levels +} diff --git a/R/zzz.R b/R/zzz.R index 70df2747..cf00b115 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -307,4 +307,5 @@ og_row <- NULL desc <- NULL id <- NULL stub_sort <- NULL +limit_data_by <- NULL diff --git a/man/set_limit_data_by.Rd b/man/set_limit_data_by.Rd index 76fb14e0..49203e21 100644 --- a/man/set_limit_data_by.Rd +++ b/man/set_limit_data_by.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/count_bindings.R +% Please edit documentation in R/set_limit_data_by.R \name{set_limit_data_by} \alias{set_limit_data_by} \title{Set variables to limit to data values only rather than fully completing all diff --git a/tests/testthat/test-set_limit_data_by.R b/tests/testthat/test-set_limit_data_by.R new file mode 100644 index 00000000..792e4389 --- /dev/null +++ b/tests/testthat/test-set_limit_data_by.R @@ -0,0 +1,64 @@ +library(dplyr) + +adpe <- tibble::tribble(~USUBJID, ~AVISIT, ~PECAT, ~PARAM, ~TRT01A, ~AVALC, ~AVAL, + "101-001", "Screening", "A", "Head", "TRT A", "Normal", 1, + "101-001", "Screening", "A", "Lungs", "TRT A", "Normal", 2, + "101-001", "Day -1", "A", "Lungs", "TRT A", "Normal", 3, + "101-001", "Day 5", "A", "Lungs", "TRT A", "Normal", 4, + "101-002", "Screening", "A", "Head", "TRT B", "Semi-Normal", 5, + "101-002", "Screening", "A", "Lungs", "TRT B", "Normal", 6, + "101-002", "Day -1", "A", "Lungs", "TRT B", "Normal", 7, + "101-002", "Day 5", "A", "Lungs", "TRT B", "Normal", 8, + "101-003", "Screening", "A", "Head", "TRT A", "Normal", 9, + "101-003", "Screening", "A", "Lungs", "TRT A", "Abnormal", 10, + "101-003", "Day -1", "A", "Lungs", "TRT A", "Normal", 11, + "101-003", "Day 5", "A", "Lungs", "TRT A", "Abnormal", 12, + + "101-001", "Screening", "B", "Lungs", "TRT A", "Normal", 13, + "101-001", "Day -1", "B", "Lungs", "TRT A", "Normal", 14, + "101-001", "Day 5", "B", "Lungs", "TRT A", "Normal", 15, + "101-002", "Screening", "B", "Lungs", "TRT B", "Normal", 16, + "101-002", "Day -1", "B", "Lungs", "TRT B", "Normal", 17, + "101-002", "Day 5", "B", "Lungs", "TRT B", "Normal", 18, + "101-003", "Screening", "B", "Lungs", "TRT A", "Abnormal", 19, + "101-003", "Day -1", "B", "Lungs", "TRT A", "Normal", 20, + "101-003", "Day 5", "B", "Lungs", "TRT A", "Abnormal", 21 +) + +adpe$AVALC <- factor(adpe$AVALC, levels = c("Normal", "Semi-Normal", "Abnormal")) + +test_that("Descriptive statistics data limiting works properly", { + t1 <- tplyr_table(adpe, TRT01A) %>% + add_layer( + group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) + ) + + x1 <- build(t1) + + cnts1 <- count(x1, row_label1, row_label2) + expect_equal(cnts1$n, c(18, 18, 18, 18)) + + t2 <- tplyr_table(adpe, TRT01A) %>% + add_layer( + group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) %>% + set_limit_data_by(PARAM, AVISIT) + ) + + x2 <- build(t2) + + cnts2 <- count(x2, row_label1, row_label2) + expect_equal(cnts2$n, c(6, 18, 6, 18)) + + + t3 <- tplyr_table(adpe, TRT01A) %>% + add_layer( + group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) %>% + set_limit_data_by(PECAT, PARAM, AVISIT) + ) + + x3 <- build(t3) + + cnts3 <- count(x3, row_label1, row_label2) + expect_equal(cnts3$n, c(6, 18, 18)) +}) + From 5ae408c0ea8d61d6591aea863a7c0b2146e3c025 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 2 Feb 2024 21:59:45 +0000 Subject: [PATCH 48/83] Finish count layer basic testing --- R/count.R | 3 +-- tests/testthat/test-set_limit_data_by.R | 36 +++++++++++++++++++++++++ 2 files changed, 37 insertions(+), 2 deletions(-) diff --git a/R/count.R b/R/count.R index 8a876513..4118dab8 100644 --- a/R/count.R +++ b/R/count.R @@ -257,8 +257,7 @@ process_count_n <- function(x) { } complete_levels <- summary_stat %>% - complete_and_limit(treat_var, by, target_var, cols, - limit = exists("limit_data_by"), + complete_and_limit(treat_var, by, cols, target_var, limit_data_by, .fill = list(n = 0, total = 0, distinct_n = 0, distinct_total = 0)) summary_stat <- complete_levels %>% diff --git a/tests/testthat/test-set_limit_data_by.R b/tests/testthat/test-set_limit_data_by.R index 792e4389..bc79c52d 100644 --- a/tests/testthat/test-set_limit_data_by.R +++ b/tests/testthat/test-set_limit_data_by.R @@ -62,3 +62,39 @@ test_that("Descriptive statistics data limiting works properly", { expect_equal(cnts3$n, c(6, 18, 18)) }) +test_that("Descriptive statistics data limiting works properly", { + + t1 <- tplyr_table(adpe, TRT01A) %>% + add_layer( + group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) + ) + + x1 <- build(t1) + + cnts1 <- count(x1, row_label1, row_label2) + expect_equal(cnts1$n, c(9, 9, 9, 9)) + + t2 <- tplyr_table(adpe, TRT01A) %>% + add_layer( + group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% + set_limit_data_by(PARAM, AVISIT) + ) + + x2 <- build(t2) + + cnts2 <- count(x2, row_label1, row_label2) + expect_equal(cnts2$n, c(3, 9, 3, 9)) + + t3 <- tplyr_table(adpe, TRT01A) %>% + add_layer( + group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% + set_limit_data_by(PECAT, PARAM, AVISIT) + ) + + x3 <- build(t3) + + cnts3 <- count(x3, row_label1, row_label2) + expect_equal(cnts3$n, c(3, 9, 9)) +}) + + From 52e9acf491dfc1b15888a3efed2493fc00b7a560 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 5 Feb 2024 19:36:03 +0000 Subject: [PATCH 49/83] Push development fixes for #173 --- R/sort.R | 110 +++++++++++++++++++++++++++++++++---------------------- 1 file changed, 66 insertions(+), 44 deletions(-) diff --git a/R/sort.R b/R/sort.R index 1409f713..c1334c10 100644 --- a/R/sort.R +++ b/R/sort.R @@ -194,20 +194,28 @@ add_order_columns.count_layer <- function(x) { expr(!!sym(as_name(x)) == !!as_name(y)) }) + # Get the number of unique outer values, that is the number of rows to pull out. # If its text, it is just 1 to pull out - outer_number <- ifelse(quo_is_symbol(by[[1]]), - # Use built_target here to take the 'where' logic into account - length(unlist(unique(built_target[, as_name(by[[1]])]))), - 1) + # outer_number <- ifelse(quo_is_symbol(by[[1]]), + # # Use built_target here to take the 'where' logic into account + # nrow(filter(numeric_data, is.na(!!by[[1]]))), + # 1) + + # Identify the outer layer and attach it to the filter logic + filter_logic <- append(filter_logic, ifelse( + quo_is_symbol(by[[1]]), # Is the outside variable character or a symbol? + exprs(is.na(!!by[[1]])), # For symbols, the outer var will be NA + exprs(summary_var == !!by[[1]]) # For character, it will match summary_var + )) all_outer <- numeric_data %>% - filter(!!!filter_logic) %>% - extract(1:min(nrow(.), outer_number), ) + filter(!!!filter_logic) # Add the ordering of the pieces in the layer formatted_data <- formatted_data %>% - group_by(.data[[paste0("row_label", formatted_col_index - 1)]]) %>% + # group_by(.data[[paste0("row_label", formatted_col_index - 1)]]) %>% + group_by(row_label1) %>% do(add_data_order_nested(., formatted_col_index - 1, numeric_data, indentation_length = indentation_length, ordering_cols = ordering_cols, @@ -701,13 +709,15 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { all_outer$..index <- group_data[1,] %>% get_data_order_byvarn(varn_df, by[[1]], final_col, total_row_sort_value = total_row_sort_value) - group_data[, paste0("ord_layer_", final_col)] <- all_outer %>% - filter(summary_var == outer_value) %>% - ungroup() %>% - select(..index) + group_data[ + group_data[[tail(row_label_vec, 1)]] == outer_value, + paste0("ord_layer_", final_col) + ] <- all_outer %>% + filter(summary_var == outer_value) %>% + ungroup() %>% + select(..index) } else if(order_count_method[1] == "bycount") { - all_outer$..index <- all_outer %>% get_data_order_bycount(ordering_cols, treat_var, vars(!!!head(by, -1)), cols, result_order_var, vars(!!by[[1]], !!target_var), @@ -717,13 +727,20 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { numeric_cutoff_column = numeric_cutoff_column, nested = TRUE) - group_data[, paste0("ord_layer_", final_col)] <- all_outer %>% - filter(summary_var == outer_value) %>% - ungroup() %>% - select(..index) + group_data[ + group_data[[tail(row_label_vec, 1)]] == outer_value, + paste0("ord_layer_", final_col) + ] <- all_outer %>% + filter(summary_var == outer_value) %>% + ungroup() %>% + select(..index) } - present_vars <- unlist(group_data[-1, row_label_vec[length(row_label_vec)]]) + outer_nest_rows <- group_data %>% + filter(!!sym(tail(row_label_vec, 1)) == outer_value) %>% + nrow() + + present_vars <- group_data[(outer_nest_rows + 1): nrow(group_data),][[row_label_vec[length(row_label_vec)]]] ##### Inner nest values ##### filtered_numeric_data <- numeric_data %>% @@ -732,48 +749,53 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { # Remove nesting prefix to prepare numeric data. mutate(summary_var := str_sub(summary_var, indentation_length)) - #Same idea here, remove prefix - filtered_group_data <- group_data[-1, ] %>% + filtered_group_data <- tail(group_data, -outer_nest_rows) %>% mutate(!!row_label_vec[length(row_label_vec)] := str_sub(.data[[row_label_vec[length(row_label_vec)]]], indentation_length + 1)) + # The first row is always the first thing in the order so make it Inf - group_data[1, paste0("ord_layer_", final_col + 1)] <- ifelse((is.null(outer_inf) || outer_inf), Inf, -Inf) + group_data[1:outer_nest_rows, paste0("ord_layer_", final_col + 1)] <- ifelse((is.null(outer_inf) || outer_inf), Inf, -Inf) if(tail(order_count_method, 1) == "bycount") { if (nrow(group_data) > 1) { - group_data[-1 , paste0("ord_layer_", final_col + 1)] <- get_data_order_bycount(filtered_numeric_data, - ordering_cols, - treat_var, - head(by, -1), - cols, - result_order_var, - target_var, - break_ties = break_ties, - numeric_cutoff = numeric_cutoff, - numeric_cutoff_stat = numeric_cutoff_stat, - numeric_cutoff_column = numeric_cutoff_column, - nested = TRUE) - } - } else if(tail(order_count_method, 1) == "byvarn") { + group_data[ + (outer_nest_rows + 1): nrow(group_data), + paste0("ord_layer_", final_col + 1)] <- get_data_order_bycount(filtered_numeric_data, + ordering_cols, + treat_var, + head(by, -1), + cols, + result_order_var, + target_var, + break_ties = break_ties, + numeric_cutoff = numeric_cutoff, + numeric_cutoff_stat = numeric_cutoff_stat, + numeric_cutoff_column = numeric_cutoff_column, + nested = TRUE) + } } else if(tail(order_count_method, 1) == "byvarn") { varn_df <- get_varn_values(target, target_var[[1]]) - group_data[-1, paste0("ord_layer_", final_col + 1)] <- get_data_order_byvarn(filtered_group_data, - varn_df, - target_var[[1]], - length(by) + 1, - indentation, - total_row_sort_value = total_row_sort_value) - + group_data[ + (outer_nest_rows + 1): nrow(group_data), + paste0("ord_layer_", final_col + 1) + ] <- get_data_order_byvarn(filtered_group_data, + varn_df, + target_var[[1]], + length(by) + 1, + indentation, + total_row_sort_value = total_row_sort_value) } else { - - group_row_count <- nrow(group_data[-1,]) + group_row_count <- nrow(group_data[(outer_nest_rows + 1): nrow(group_data),]) # Logic for group_row_count is when numeric_where values cause unexpected results - group_data[-1, paste0("ord_layer_", final_col + 1)] <- 1:ifelse(group_row_count == 0, 1, group_row_count) + group_data[ + (outer_nest_rows + 1): nrow(group_data), + paste0("ord_layer_", final_col + 1) + ] <- 1:ifelse(group_row_count == 0, 1, group_row_count) } From a7a5365d7c8ff596f399ad4ea6922f140043ce92 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 5 Feb 2024 21:56:12 +0000 Subject: [PATCH 50/83] I think I fixed this nightmare. --- R/sort.R | 33 +++++++++++++++++++++------------ 1 file changed, 21 insertions(+), 12 deletions(-) diff --git a/R/sort.R b/R/sort.R index c1334c10..c940d04c 100644 --- a/R/sort.R +++ b/R/sort.R @@ -702,6 +702,8 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { ##### Outer nest values ##### # The value of the outer label outer_value <- group_data[1, tail(row_label_vec, 1)][[1]] + # Reserve for joins + mrg_by <- paste0("row_label", seq_along(by))[-1] if(order_count_method[1] == "byvarn") { varn_df <- get_varn_values(target, as_name(by[[1]])) @@ -709,13 +711,7 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { all_outer$..index <- group_data[1,] %>% get_data_order_byvarn(varn_df, by[[1]], final_col, total_row_sort_value = total_row_sort_value) - group_data[ - group_data[[tail(row_label_vec, 1)]] == outer_value, - paste0("ord_layer_", final_col) - ] <- all_outer %>% - filter(summary_var == outer_value) %>% - ungroup() %>% - select(..index) + } else if(order_count_method[1] == "bycount") { all_outer$..index <- all_outer %>% @@ -726,14 +722,27 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { numeric_cutoff_stat = numeric_cutoff_stat, numeric_cutoff_column = numeric_cutoff_column, nested = TRUE) + } - group_data[ - group_data[[tail(row_label_vec, 1)]] == outer_value, - paste0("ord_layer_", final_col) - ] <- all_outer %>% + + # Grab the index created above and insert it into group data + if (order_count_method[1] %in% c("bycount", "byvarn")){ + if (length(mrg_by) == 0) { + group_data[,paste0("ord_layer_", final_col)] <- all_outer %>% filter(summary_var == outer_value) %>% ungroup() %>% - select(..index) + pull(..index) + } else { + group_data[,paste0("ord_layer_", final_col)] <- group_data %>% + left_join( + all_outer %>% + filter(summary_var == outer_value) %>% + replace_by_string_names(c(by, quo(summary_var))) %>% + select(starts_with('row'), ..index, -c(row_label1, !!treat_var)), + by = mrg_by + ) %>% + pull(..index) + } } outer_nest_rows <- group_data %>% From 753124a543a4e5079848dde9b07974fa2ea536a9 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 6 Feb 2024 13:49:30 +0000 Subject: [PATCH 51/83] Last update and test added. --- R/sort.R | 4 ++-- tests/testthat/test-sort.R | 36 ++++++++++++++++++++++++++++++++++++ 2 files changed, 38 insertions(+), 2 deletions(-) diff --git a/R/sort.R b/R/sort.R index c940d04c..4084716b 100644 --- a/R/sort.R +++ b/R/sort.R @@ -728,12 +728,12 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { # Grab the index created above and insert it into group data if (order_count_method[1] %in% c("bycount", "byvarn")){ if (length(mrg_by) == 0) { - group_data[,paste0("ord_layer_", final_col)] <- all_outer %>% + group_data[,"ord_layer_1"] <- all_outer %>% filter(summary_var == outer_value) %>% ungroup() %>% pull(..index) } else { - group_data[,paste0("ord_layer_", final_col)] <- group_data %>% + group_data[,"ord_layer_1"] <- group_data %>% left_join( all_outer %>% filter(summary_var == outer_value) %>% diff --git a/tests/testthat/test-sort.R b/tests/testthat/test-sort.R index c77458dd..e0236cc0 100644 --- a/tests/testthat/test-sort.R +++ b/tests/testthat/test-sort.R @@ -264,3 +264,39 @@ test_that("by variables get sorted with varn/factors in the correct order", { expect_equal(t3[["row_label1"]], c("1", "1", "1", "0", "0", "0")) expect_equal(t3[["ord_layer_1"]], c(1, 1, 1, 2, 2, 2)) }) + + +# Added to address #175 +test_that("Nested counts with by variables process properly", { + + t_ae1 <- tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD), by = vars(AESEV, AEOUT)) + %>% + set_order_count_method("bycount") %>% + set_ordering_cols("Xanomeline High Dose") %>% + set_result_order_var(distinct_n) + ) + + t_ae_df1 <- t_ae1 %>% + build() + + # This is verifying that the right number of combinations of row_labels exist, and that + # there aren't duplicate order values for the outer layer + expect_equal(nrow(count(t_ae_df1, row_label2, row_label3, ord_layer_3)), 6) + + t_ae2 <- tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(vars("testing", AEDECOD), by=AEOUT) %>% + set_order_count_method("bycount") %>% + set_ordering_cols("Xanomeline High Dose") %>% + set_result_order_var(distinct_n) + ) + + t_ae_df2 <- t_ae2 %>% + build() + + # Same test but now working with a text outer layer and one by variable + expect_equal(nrow(count(t_ae_df2, row_label2, ord_layer_2)), 2) + +}) From cc615e7da19eb72835eac4d7ed1bed4bbb0f02ef Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 6 Feb 2024 18:42:07 +0000 Subject: [PATCH 52/83] Handle nested counts properly --- R/count.R | 7 +++++- R/nested.R | 2 ++ R/set_limit_data_by.R | 24 ++++++++++++-------- tests/testthat/test-set_limit_data_by.R | 29 +++++++++++++++++++++++++ 4 files changed, 52 insertions(+), 10 deletions(-) diff --git a/R/count.R b/R/count.R index 4118dab8..9d5cf2b0 100644 --- a/R/count.R +++ b/R/count.R @@ -101,6 +101,7 @@ process_summaries.count_layer <- function(x, ...) { process_count_denoms(x) + outer <- FALSE process_single_count_target(x) } @@ -256,9 +257,13 @@ process_count_n <- function(x) { names(missing_count_list))) } + # Need to mark this for nested counts + if (!exists('outer_')) outer_ <- FALSE + complete_levels <- summary_stat %>% complete_and_limit(treat_var, by, cols, target_var, limit_data_by, - .fill = list(n = 0, total = 0, distinct_n = 0, distinct_total = 0)) + .fill = list(n = 0, total = 0, distinct_n = 0, distinct_total = 0), + outer=outer_) summary_stat <- complete_levels %>% # Change the treat_var and first target_var to characters to resolve any diff --git a/R/nested.R b/R/nested.R index e05e854c..481b82b6 100644 --- a/R/nested.R +++ b/R/nested.R @@ -32,9 +32,11 @@ process_nested_count_target <- function(x) { second_denoms_by <- denoms_by } + outer_ <- TRUE first_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[1]], by = vars(!!!by), where = !!where)) + outer_ <- FALSE second_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[2]], by = vars(!!target_var[[1]], !!!by), where = !!where) %>% set_count_row_prefix(indentation) %>% diff --git a/R/set_limit_data_by.R b/R/set_limit_data_by.R index ac08047e..e6d973f0 100644 --- a/R/set_limit_data_by.R +++ b/R/set_limit_data_by.R @@ -48,15 +48,16 @@ set_limit_data_by.desc_layer <- function(e, ...) { #' General function used to process the steps to pad levels in data, or limit to #' combinations available in the data itself #' -#' @param dat -#' @param treat_var -#' @param by -#' @param cols -#' @param target_var -#' @param limit -#' @param .fill -#' TODO: Figure out best way to pass the data limiting into this function, because it doesn't exist unless distinctly set. -complete_and_limit <- function(dat, treat_var, by, cols, target_var=quos(), limit_data_by, .fill=list()) { +#' @param dat Input dataset +#' @param treat_var treat_var from tplyr_table +#' @param by by from tplyr_layer +#' @param cols cols from tplyr_table +#' @param target_var target_var from tplyr_layer +#' @param limit_data_by The variables to limit data by +#' @param .fill .fill parameter passed onto dplyr::complete +#' +#' @noRd +complete_and_limit <- function(dat, treat_var, by, cols, target_var=quos(), limit_data_by, .fill=list(), outer=FALSE) { complete_levels <- dat %>% # complete all combinations of factors to include combinations that don't exist. @@ -66,6 +67,11 @@ complete_and_limit <- function(dat, treat_var, by, cols, target_var=quos(), limi # Apply data limits specified by setter if (!is.null(limit_data_by)) { + # Outer layer won't have the target variable to limit by + if (outer) { + limit_data_by <- limit_data_by[map_chr(limit_data_by, as_name) %in% names(dat)] + } + # Find the combinations actually in the data groups_in_data <- dat %>% distinct(!!!limit_data_by) diff --git a/tests/testthat/test-set_limit_data_by.R b/tests/testthat/test-set_limit_data_by.R index bc79c52d..53a825a5 100644 --- a/tests/testthat/test-set_limit_data_by.R +++ b/tests/testthat/test-set_limit_data_by.R @@ -98,3 +98,32 @@ test_that("Descriptive statistics data limiting works properly", { }) +test_that("Nested count layers limit data accurately", { + + t_ae1 <- tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD), by = vars(AESEV, AEOUT)) %>% + set_limit_data_by(AEOUT, AEDECOD) + ) + + t_ae_df1 <- t_ae1 %>% + build() %>% select(-starts_with('ord')) + + t_ae2 <- tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD), by = vars(AESEV, AEOUT)) %>% + set_limit_data_by(AESEV, AEOUT, AEDECOD) + ) + + t_ae_df2 <- t_ae2 %>% + build() %>% select(-starts_with('ord')) + + dropped_rows <- anti_join( + t_ae_df1, + t_ae_df2, + by=names(t_ae_df1) + ) + + check <- c(dropped_rows$var1_Placebo, dropped_rows$`var1_Xanomeline High Dose`, dropped_rows$`var1_Xanomeline Low Dose`) + expect_true(all(check == " 0 ( 0.0%)")) +}) From c9d46fddc672cd4d6afec717fcd4f5602c4a396f Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 6 Feb 2024 20:11:38 +0000 Subject: [PATCH 53/83] Add data limiting for shift layers --- NAMESPACE | 1 + R/set_limit_data_by.R | 6 ++ R/shift.R | 5 +- tests/testthat/test-set_limit_data_by.R | 95 ++++++++++++++++++------- 4 files changed, 78 insertions(+), 29 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index fe7924b1..cd21ea81 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -35,6 +35,7 @@ S3method(set_format_strings,desc_layer) S3method(set_format_strings,shift_layer) S3method(set_limit_data_by,count_layer) S3method(set_limit_data_by,desc_layer) +S3method(set_limit_data_by,shift_layer) S3method(set_where,tplyr_layer) S3method(set_where,tplyr_table) S3method(str,f_str) diff --git a/R/set_limit_data_by.R b/R/set_limit_data_by.R index e6d973f0..2d5eb649 100644 --- a/R/set_limit_data_by.R +++ b/R/set_limit_data_by.R @@ -28,6 +28,12 @@ set_limit_data_by.count_layer <- function(e, ...) { e } +#' @export +#' @noRd +set_limit_data_by.shift_layer <- function(e, ...) { + set_limit_data_by.count_layer(e, ...) +} + #' @export #' @noRd set_limit_data_by.desc_layer <- function(e, ...) { diff --git a/R/shift.R b/R/shift.R index a6a38d7b..c6a42d9f 100644 --- a/R/shift.R +++ b/R/shift.R @@ -39,7 +39,6 @@ process_summaries.shift_layer <- function(x, ...) { process_shift_n <- function(x) { evalq({ - numeric_data <- built_target %>% # Group by variables including target variables and count them group_by(!!treat_var, !!!by, !!!unname(target_var), !!!cols) %>% @@ -47,7 +46,9 @@ process_shift_n <- function(x) { ungroup() %>% # complete all combinations of factors to include combinations that don't exist. # add 0 for combinations that don't exist - complete(!!treat_var, !!!by, !!!unname(target_var), !!!cols, fill = list(n = 0)) %>% + # complete(!!treat_var, !!!by, !!!unname(target_var), !!!cols, fill = list(n = 0)) %>% + complete_and_limit(treat_var, by, cols, unname(target_var), + limit_data_by, .fill = list(n = 0)) %>% # Change the treat_var and first target_var to characters to resolve any # issues if there are total rows and the original column is numeric mutate(!!treat_var := as.character(!!treat_var)) %>% diff --git a/tests/testthat/test-set_limit_data_by.R b/tests/testthat/test-set_limit_data_by.R index 53a825a5..28f0856e 100644 --- a/tests/testthat/test-set_limit_data_by.R +++ b/tests/testthat/test-set_limit_data_by.R @@ -1,31 +1,32 @@ library(dplyr) -adpe <- tibble::tribble(~USUBJID, ~AVISIT, ~PECAT, ~PARAM, ~TRT01A, ~AVALC, ~AVAL, - "101-001", "Screening", "A", "Head", "TRT A", "Normal", 1, - "101-001", "Screening", "A", "Lungs", "TRT A", "Normal", 2, - "101-001", "Day -1", "A", "Lungs", "TRT A", "Normal", 3, - "101-001", "Day 5", "A", "Lungs", "TRT A", "Normal", 4, - "101-002", "Screening", "A", "Head", "TRT B", "Semi-Normal", 5, - "101-002", "Screening", "A", "Lungs", "TRT B", "Normal", 6, - "101-002", "Day -1", "A", "Lungs", "TRT B", "Normal", 7, - "101-002", "Day 5", "A", "Lungs", "TRT B", "Normal", 8, - "101-003", "Screening", "A", "Head", "TRT A", "Normal", 9, - "101-003", "Screening", "A", "Lungs", "TRT A", "Abnormal", 10, - "101-003", "Day -1", "A", "Lungs", "TRT A", "Normal", 11, - "101-003", "Day 5", "A", "Lungs", "TRT A", "Abnormal", 12, - - "101-001", "Screening", "B", "Lungs", "TRT A", "Normal", 13, - "101-001", "Day -1", "B", "Lungs", "TRT A", "Normal", 14, - "101-001", "Day 5", "B", "Lungs", "TRT A", "Normal", 15, - "101-002", "Screening", "B", "Lungs", "TRT B", "Normal", 16, - "101-002", "Day -1", "B", "Lungs", "TRT B", "Normal", 17, - "101-002", "Day 5", "B", "Lungs", "TRT B", "Normal", 18, - "101-003", "Screening", "B", "Lungs", "TRT A", "Abnormal", 19, - "101-003", "Day -1", "B", "Lungs", "TRT A", "Normal", 20, - "101-003", "Day 5", "B", "Lungs", "TRT A", "Abnormal", 21 +adpe <- tibble::tribble(~USUBJID, ~AVISIT, ~PECAT, ~PARAM, ~TRT01A, ~AVALC, ~AVAL, ~BASEC, + "101-001", "Screening", "A", "Head", "TRT A", "Normal", 1, "Abnormal", + "101-001", "Screening", "A", "Lungs", "TRT A", "Normal", 2, "Semi-Normal", + "101-001", "Day -1", "A", "Lungs", "TRT A", "Normal", 3, "Normal", + "101-001", "Day 5", "A", "Lungs", "TRT A", "Normal", 4, "Normal", + "101-002", "Screening", "A", "Head", "TRT B", "Semi-Normal", 5, "Normal", + "101-002", "Screening", "A", "Lungs", "TRT B", "Normal", 6, "Normal", + "101-002", "Day -1", "A", "Lungs", "TRT B", "Normal", 7, "Normal", + "101-002", "Day 5", "A", "Lungs", "TRT B", "Normal", 8, "Semi-Normal", + "101-003", "Screening", "A", "Head", "TRT A", "Normal", 9, "Normal", + "101-003", "Screening", "A", "Lungs", "TRT A", "Abnormal", 10, "Abnormal", + "101-003", "Day -1", "A", "Lungs", "TRT A", "Normal", 11, "Abnormal", + "101-003", "Day 5", "A", "Lungs", "TRT A", "Abnormal", 12, "Abnormal", + + "101-001", "Screening", "B", "Lungs", "TRT A", "Normal", 13, "Normal", + "101-001", "Day -1", "B", "Lungs", "TRT A", "Normal", 14, "Normal", + "101-001", "Day 5", "B", "Lungs", "TRT A", "Normal", 15, "Semi-Normal", + "101-002", "Screening", "B", "Lungs", "TRT B", "Normal", 16, "Normal", + "101-002", "Day -1", "B", "Lungs", "TRT B", "Normal", 17, "Abnormal", + "101-002", "Day 5", "B", "Lungs", "TRT B", "Normal", 18, "Abnormal", + "101-003", "Screening", "B", "Lungs", "TRT A", "Abnormal", 19, "Normal", + "101-003", "Day -1", "B", "Lungs", "TRT A", "Normal", 20, "Normal", + "101-003", "Day 5", "B", "Lungs", "TRT A", "Abnormal", 21, "Normal" ) adpe$AVALC <- factor(adpe$AVALC, levels = c("Normal", "Semi-Normal", "Abnormal")) +adpe$BASEC <- factor(adpe$BASEC, levels = c("Normal", "Semi-Normal", "Abnormal")) test_that("Descriptive statistics data limiting works properly", { t1 <- tplyr_table(adpe, TRT01A) %>% @@ -62,11 +63,12 @@ test_that("Descriptive statistics data limiting works properly", { expect_equal(cnts3$n, c(6, 18, 18)) }) -test_that("Descriptive statistics data limiting works properly", { + +test_that("Shift layers can also handle data limiting", { t1 <- tplyr_table(adpe, TRT01A) %>% add_layer( - group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) + group_shift(vars(row=BASEC, column=AVALC), by = vars(PECAT, PARAM, AVISIT)) ) x1 <- build(t1) @@ -76,7 +78,7 @@ test_that("Descriptive statistics data limiting works properly", { t2 <- tplyr_table(adpe, TRT01A) %>% add_layer( - group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% + group_shift(vars(row=BASEC, column=AVALC), by = vars(PECAT, PARAM, AVISIT)) %>% set_limit_data_by(PARAM, AVISIT) ) @@ -87,7 +89,7 @@ test_that("Descriptive statistics data limiting works properly", { t3 <- tplyr_table(adpe, TRT01A) %>% add_layer( - group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% + group_shift(vars(row=BASEC, column=AVALC), by = vars(PECAT, PARAM, AVISIT)) %>% set_limit_data_by(PECAT, PARAM, AVISIT) ) @@ -95,6 +97,7 @@ test_that("Descriptive statistics data limiting works properly", { cnts3 <- count(x3, row_label1, row_label2) expect_equal(cnts3$n, c(3, 9, 9)) + }) @@ -127,3 +130,41 @@ test_that("Nested count layers limit data accurately", { check <- c(dropped_rows$var1_Placebo, dropped_rows$`var1_Xanomeline High Dose`, dropped_rows$`var1_Xanomeline Low Dose`) expect_true(all(check == " 0 ( 0.0%)")) }) + + +test_that("Descriptive statistics data limiting works properly", { + + t1 <- tplyr_table(adpe, TRT01A) %>% + add_layer( + group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) + ) + + x1 <- build(t1) + + cnts1 <- count(x1, row_label1, row_label2) + expect_equal(cnts1$n, c(9, 9, 9, 9)) + + t2 <- tplyr_table(adpe, TRT01A) %>% + add_layer( + group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% + set_limit_data_by(PARAM, AVISIT) + ) + + x2 <- build(t2) + + cnts2 <- count(x2, row_label1, row_label2) + expect_equal(cnts2$n, c(3, 9, 3, 9)) + + t3 <- tplyr_table(adpe, TRT01A) %>% + add_layer( + group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% + set_limit_data_by(PECAT, PARAM, AVISIT) + ) + + x3 <- build(t3) + + cnts3 <- count(x3, row_label1, row_label2) + expect_equal(cnts3$n, c(3, 9, 9)) +}) + + From f96c66bb420ae499a6687f429898f1a3cd466951 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Wed, 7 Feb 2024 15:26:35 +0000 Subject: [PATCH 54/83] Add documentation and convert adpe to a built-in dataset. --- R/data.R | 8 ++ R/set_limit_data_by.R | 46 ++++++++- data-raw/adpe.R | 31 ++++++ data/tplyr_adpe.rda | Bin 0 -> 500 bytes man/set_limit_data_by.Rd | 46 ++++++++- man/tplyr_adpe.Rd | 16 +++ tests/testthat/test-set_limit_data_by.R | 128 +++++++++--------------- tests/testthat/test-sort.R | 4 +- vignettes/table.Rmd | 52 ++++++++++ 9 files changed, 242 insertions(+), 89 deletions(-) create mode 100644 data-raw/adpe.R create mode 100644 data/tplyr_adpe.rda create mode 100644 man/tplyr_adpe.Rd diff --git a/R/data.R b/R/data.R index 25332b39..2627ef3f 100644 --- a/R/data.R +++ b/R/data.R @@ -47,6 +47,14 @@ #' "tplyr_adlb" +#' ADPE Data +#' +#' A mock-up dataset that is fit for testing data limiting +#' +#' @format A data.frame with 21 rows and 8 columns. +#' +#' +"tplyr_adpe" #' Get Data Labels #' diff --git a/R/set_limit_data_by.R b/R/set_limit_data_by.R index 2d5eb649..321c3366 100644 --- a/R/set_limit_data_by.R +++ b/R/set_limit_data_by.R @@ -1,11 +1,50 @@ -#' Set variables to limit to data values only rather than fully completing all -#' possible levels +#' Set variables to limit reported data values only to those that exist rather +#' than fully completing all possible levels +#' +#' This function allows you to select a combination of by variables or +#' potentially target variables for which you only want to display values +#' present in the data. By default, Tplyr will create a cartesian combination of +#' potential values of the data. For example, if you have 2 by variables +#' present, then each potential combination of those by variables will have a +#' row present in the final table. `set_limit_data_by()` allows you to choose +#' the by variables whose combination you wish to limit to values physically +#' present in the available data. #' #' @param e A tplyr_layer #' @param ... Subset of variables within by or target variables #' -#' @return +#' @return a tplyr_table +#' @md #' @export +#' +#' @examples +#' +#' tplyr_table(tplyr_adpe, TRT01A) %>% +#' add_layer( +#' group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) +#' ) %>% +#' build() +#' +#' tplyr_table(tplyr_adpe, TRT01A) %>% +#' add_layer( +#' group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) %>% +#' set_limit_data_by(PARAM, AVISIT) +#' ) %>% +#' build() +#' +#' tplyr_table(tplyr_adpe, TRT01A) %>% +#' add_layer( +#' group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% +#' set_limit_data_by(PARAM, AVISIT) +#' ) %>% +#' build() +#' +#' tplyr_table(tplyr_adpe, TRT01A) %>% +#' add_layer( +#' group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% +#' set_limit_data_by(PECAT, PARAM, AVISIT) +#' ) %>% +#' build() set_limit_data_by <- function(e, ...) { UseMethod("set_limit_data_by") } @@ -61,6 +100,7 @@ set_limit_data_by.desc_layer <- function(e, ...) { #' @param target_var target_var from tplyr_layer #' @param limit_data_by The variables to limit data by #' @param .fill .fill parameter passed onto dplyr::complete +#' @param outer Whether to bypass variables if working through the outer layer #' #' @noRd complete_and_limit <- function(dat, treat_var, by, cols, target_var=quos(), limit_data_by, .fill=list(), outer=FALSE) { diff --git a/data-raw/adpe.R b/data-raw/adpe.R new file mode 100644 index 00000000..d80860eb --- /dev/null +++ b/data-raw/adpe.R @@ -0,0 +1,31 @@ +# This adpe dataset is just a mock-up that's fit for purpose to test and demonstrate data limiting +tplyr_adpe <- tibble::tribble(~USUBJID, ~AVISIT, ~PECAT, ~PARAM, ~TRT01A, ~AVALC, ~AVAL, ~BASEC, + "101-001", "Screening", "A", "Head", "TRT A", "Normal", 1, "Abnormal", + "101-001", "Screening", "A", "Lungs", "TRT A", "Normal", 2, "Semi-Normal", + "101-001", "Day -1", "A", "Lungs", "TRT A", "Normal", 3, "Normal", + "101-001", "Day 5", "A", "Lungs", "TRT A", "Normal", 4, "Normal", + "101-002", "Screening", "A", "Head", "TRT B", "Semi-Normal", 5, "Normal", + "101-002", "Screening", "A", "Lungs", "TRT B", "Normal", 6, "Normal", + "101-002", "Day -1", "A", "Lungs", "TRT B", "Normal", 7, "Normal", + "101-002", "Day 5", "A", "Lungs", "TRT B", "Normal", 8, "Semi-Normal", + "101-003", "Screening", "A", "Head", "TRT A", "Normal", 9, "Normal", + "101-003", "Screening", "A", "Lungs", "TRT A", "Abnormal", 10, "Abnormal", + "101-003", "Day -1", "A", "Lungs", "TRT A", "Normal", 11, "Abnormal", + "101-003", "Day 5", "A", "Lungs", "TRT A", "Abnormal", 12, "Abnormal", + + "101-001", "Screening", "B", "Lungs", "TRT A", "Normal", 13, "Normal", + "101-001", "Day -1", "B", "Lungs", "TRT A", "Normal", 14, "Normal", + "101-001", "Day 5", "B", "Lungs", "TRT A", "Normal", 15, "Semi-Normal", + "101-002", "Screening", "B", "Lungs", "TRT B", "Normal", 16, "Normal", + "101-002", "Day -1", "B", "Lungs", "TRT B", "Normal", 17, "Abnormal", + "101-002", "Day 5", "B", "Lungs", "TRT B", "Normal", 18, "Abnormal", + "101-003", "Screening", "B", "Lungs", "TRT A", "Abnormal", 19, "Normal", + "101-003", "Day -1", "B", "Lungs", "TRT A", "Normal", 20, "Normal", + "101-003", "Day 5", "B", "Lungs", "TRT A", "Abnormal", 21, "Normal" +) + +tplyr_adpe$AVALC <- factor(tplyr_adpe$AVALC, levels = c("Normal", "Semi-Normal", "Abnormal")) +tplyr_adpe$BASEC <- factor(tplyr_adpe$BASEC, levels = c("Normal", "Semi-Normal", "Abnormal")) +tplyr_adpe$AVISIT <- factor(tplyr_adpe$AVISIT, levels = c("Screening", "Day -1", "Day 5")) + +usethis::use_data(tplyr_adpe, overwrite = TRUE) diff --git a/data/tplyr_adpe.rda b/data/tplyr_adpe.rda new file mode 100644 index 0000000000000000000000000000000000000000..58557959add5372807df04914e4a4e2765568d51 GIT binary patch literal 500 zcmV@T4*^jL0KkKS)a8~YXAd}f5HFzPDE8#egOV=UqHX7-=IJM00=+x=`;bMiRlduqz_D{f$Dy!MLd)MGy&=~(@g+00B9N-F&Z*59AwF% zh{Vx=Mgm~~U?!S0$j}TVN~fs(MAJr14Ky?xP-&11KmZ1S$@)q(DO0IdvFq4LJ4#zt z<@?7u?uiNjVG%I_AOIi&1_CIXtQ_c*njBmT9CDdLM5Ypip-53p=)^%MngIC4juc9Pk2dXYU#eG-_9Im8#_i3ve$j8+B=*>S)^R)dBp>^nO<{CnDZ z_zWmuS?v3HA*&TsY_hjrN#ydE#38;^NS7xFq;X{S>L)ycl%iE$dLEul9(}ydhqv}L ze+&95DlnMr^o^Cqy}zc*sWMPw$7}WOC|)60e_%sx6yNo*!6+{5Q(FHC@z|lOZx+@pmLsg$W7!RR*vHG}JW! literal 0 HcmV?d00001 diff --git a/man/set_limit_data_by.Rd b/man/set_limit_data_by.Rd index 49203e21..c9416a76 100644 --- a/man/set_limit_data_by.Rd +++ b/man/set_limit_data_by.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/set_limit_data_by.R \name{set_limit_data_by} \alias{set_limit_data_by} -\title{Set variables to limit to data values only rather than fully completing all -possible levels} +\title{Set variables to limit reported data values only to those that exist rather +than fully completing all possible levels} \usage{ set_limit_data_by(e, ...) } @@ -12,7 +12,45 @@ set_limit_data_by(e, ...) \item{...}{Subset of variables within by or target variables} } +\value{ +a tplyr_table +} \description{ -Set variables to limit to data values only rather than fully completing all -possible levels +This function allows you to select a combination of by variables or +potentially target variables for which you only want to display values +present in the data. By default, Tplyr will create a cartesian combination of +potential values of the data. For example, if you have 2 by variables +present, then each potential combination of those by variables will have a +row present in the final table. \code{set_limit_data_by()} allows you to choose +the by variables whose combination you wish to limit to values physically +present in the available data. +} +\examples{ + +tplyr_table(tplyr_adpe, TRT01A) \%>\% + add_layer( + group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) + ) \%>\% + build() + +tplyr_table(tplyr_adpe, TRT01A) \%>\% + add_layer( + group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) \%>\% + set_limit_data_by(PARAM, AVISIT) + ) \%>\% + build() + +tplyr_table(tplyr_adpe, TRT01A) \%>\% + add_layer( + group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) \%>\% + set_limit_data_by(PARAM, AVISIT) + ) \%>\% + build() + +tplyr_table(tplyr_adpe, TRT01A) \%>\% + add_layer( + group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) \%>\% + set_limit_data_by(PECAT, PARAM, AVISIT) + ) \%>\% + build() } diff --git a/man/tplyr_adpe.Rd b/man/tplyr_adpe.Rd new file mode 100644 index 00000000..ab19f95d --- /dev/null +++ b/man/tplyr_adpe.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/data.R +\docType{data} +\name{tplyr_adpe} +\alias{tplyr_adpe} +\title{ADPE Data} +\format{ +A data.frame with 21 rows and 8 columns. +} +\usage{ +tplyr_adpe +} +\description{ +A mock-up dataset that is fit for testing data limiting +} +\keyword{datasets} diff --git a/tests/testthat/test-set_limit_data_by.R b/tests/testthat/test-set_limit_data_by.R index 28f0856e..1f0e2bae 100644 --- a/tests/testthat/test-set_limit_data_by.R +++ b/tests/testthat/test-set_limit_data_by.R @@ -1,45 +1,15 @@ -library(dplyr) - -adpe <- tibble::tribble(~USUBJID, ~AVISIT, ~PECAT, ~PARAM, ~TRT01A, ~AVALC, ~AVAL, ~BASEC, - "101-001", "Screening", "A", "Head", "TRT A", "Normal", 1, "Abnormal", - "101-001", "Screening", "A", "Lungs", "TRT A", "Normal", 2, "Semi-Normal", - "101-001", "Day -1", "A", "Lungs", "TRT A", "Normal", 3, "Normal", - "101-001", "Day 5", "A", "Lungs", "TRT A", "Normal", 4, "Normal", - "101-002", "Screening", "A", "Head", "TRT B", "Semi-Normal", 5, "Normal", - "101-002", "Screening", "A", "Lungs", "TRT B", "Normal", 6, "Normal", - "101-002", "Day -1", "A", "Lungs", "TRT B", "Normal", 7, "Normal", - "101-002", "Day 5", "A", "Lungs", "TRT B", "Normal", 8, "Semi-Normal", - "101-003", "Screening", "A", "Head", "TRT A", "Normal", 9, "Normal", - "101-003", "Screening", "A", "Lungs", "TRT A", "Abnormal", 10, "Abnormal", - "101-003", "Day -1", "A", "Lungs", "TRT A", "Normal", 11, "Abnormal", - "101-003", "Day 5", "A", "Lungs", "TRT A", "Abnormal", 12, "Abnormal", - - "101-001", "Screening", "B", "Lungs", "TRT A", "Normal", 13, "Normal", - "101-001", "Day -1", "B", "Lungs", "TRT A", "Normal", 14, "Normal", - "101-001", "Day 5", "B", "Lungs", "TRT A", "Normal", 15, "Semi-Normal", - "101-002", "Screening", "B", "Lungs", "TRT B", "Normal", 16, "Normal", - "101-002", "Day -1", "B", "Lungs", "TRT B", "Normal", 17, "Abnormal", - "101-002", "Day 5", "B", "Lungs", "TRT B", "Normal", 18, "Abnormal", - "101-003", "Screening", "B", "Lungs", "TRT A", "Abnormal", 19, "Normal", - "101-003", "Day -1", "B", "Lungs", "TRT A", "Normal", 20, "Normal", - "101-003", "Day 5", "B", "Lungs", "TRT A", "Abnormal", 21, "Normal" -) - -adpe$AVALC <- factor(adpe$AVALC, levels = c("Normal", "Semi-Normal", "Abnormal")) -adpe$BASEC <- factor(adpe$BASEC, levels = c("Normal", "Semi-Normal", "Abnormal")) - test_that("Descriptive statistics data limiting works properly", { - t1 <- tplyr_table(adpe, TRT01A) %>% + t1 <- tplyr_table(tplyr_adpe, TRT01A) %>% add_layer( group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) ) x1 <- build(t1) - cnts1 <- count(x1, row_label1, row_label2) + cnts1 <- dplyr::count(x1, row_label1, row_label2) expect_equal(cnts1$n, c(18, 18, 18, 18)) - t2 <- tplyr_table(adpe, TRT01A) %>% + t2 <- tplyr_table(tplyr_adpe, TRT01A) %>% add_layer( group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) %>% set_limit_data_by(PARAM, AVISIT) @@ -47,11 +17,11 @@ test_that("Descriptive statistics data limiting works properly", { x2 <- build(t2) - cnts2 <- count(x2, row_label1, row_label2) + cnts2 <- dplyr::count(x2, row_label1, row_label2) expect_equal(cnts2$n, c(6, 18, 6, 18)) - t3 <- tplyr_table(adpe, TRT01A) %>% + t3 <- tplyr_table(tplyr_adpe, TRT01A) %>% add_layer( group_desc(AVAL, by = vars(PECAT, PARAM, AVISIT)) %>% set_limit_data_by(PECAT, PARAM, AVISIT) @@ -59,24 +29,24 @@ test_that("Descriptive statistics data limiting works properly", { x3 <- build(t3) - cnts3 <- count(x3, row_label1, row_label2) + cnts3 <- dplyr::count(x3, row_label1, row_label2) expect_equal(cnts3$n, c(6, 18, 18)) }) test_that("Shift layers can also handle data limiting", { - t1 <- tplyr_table(adpe, TRT01A) %>% + t1 <- tplyr_table(tplyr_adpe, TRT01A) %>% add_layer( group_shift(vars(row=BASEC, column=AVALC), by = vars(PECAT, PARAM, AVISIT)) ) x1 <- build(t1) - cnts1 <- count(x1, row_label1, row_label2) + cnts1 <- dplyr::count(x1, row_label1, row_label2) expect_equal(cnts1$n, c(9, 9, 9, 9)) - t2 <- tplyr_table(adpe, TRT01A) %>% + t2 <- tplyr_table(tplyr_adpe, TRT01A) %>% add_layer( group_shift(vars(row=BASEC, column=AVALC), by = vars(PECAT, PARAM, AVISIT)) %>% set_limit_data_by(PARAM, AVISIT) @@ -84,10 +54,10 @@ test_that("Shift layers can also handle data limiting", { x2 <- build(t2) - cnts2 <- count(x2, row_label1, row_label2) + cnts2 <- dplyr::count(x2, row_label1, row_label2) expect_equal(cnts2$n, c(3, 9, 3, 9)) - t3 <- tplyr_table(adpe, TRT01A) %>% + t3 <- tplyr_table(tplyr_adpe, TRT01A) %>% add_layer( group_shift(vars(row=BASEC, column=AVALC), by = vars(PECAT, PARAM, AVISIT)) %>% set_limit_data_by(PECAT, PARAM, AVISIT) @@ -95,56 +65,25 @@ test_that("Shift layers can also handle data limiting", { x3 <- build(t3) - cnts3 <- count(x3, row_label1, row_label2) + cnts3 <- dplyr::count(x3, row_label1, row_label2) expect_equal(cnts3$n, c(3, 9, 9)) }) -test_that("Nested count layers limit data accurately", { - - t_ae1 <- tplyr_table(tplyr_adae, TRTA) %>% - add_layer( - group_count(vars(AEBODSYS, AEDECOD), by = vars(AESEV, AEOUT)) %>% - set_limit_data_by(AEOUT, AEDECOD) - ) - - t_ae_df1 <- t_ae1 %>% - build() %>% select(-starts_with('ord')) - - t_ae2 <- tplyr_table(tplyr_adae, TRTA) %>% - add_layer( - group_count(vars(AEBODSYS, AEDECOD), by = vars(AESEV, AEOUT)) %>% - set_limit_data_by(AESEV, AEOUT, AEDECOD) - ) - - t_ae_df2 <- t_ae2 %>% - build() %>% select(-starts_with('ord')) - - dropped_rows <- anti_join( - t_ae_df1, - t_ae_df2, - by=names(t_ae_df1) - ) - - check <- c(dropped_rows$var1_Placebo, dropped_rows$`var1_Xanomeline High Dose`, dropped_rows$`var1_Xanomeline Low Dose`) - expect_true(all(check == " 0 ( 0.0%)")) -}) - - -test_that("Descriptive statistics data limiting works properly", { +test_that("Count data limiting works properly", { - t1 <- tplyr_table(adpe, TRT01A) %>% + t1 <- tplyr_table(tplyr_adpe, TRT01A) %>% add_layer( group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) ) x1 <- build(t1) - cnts1 <- count(x1, row_label1, row_label2) + cnts1 <- dplyr::count(x1, row_label1, row_label2) expect_equal(cnts1$n, c(9, 9, 9, 9)) - t2 <- tplyr_table(adpe, TRT01A) %>% + t2 <- tplyr_table(tplyr_adpe, TRT01A) %>% add_layer( group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% set_limit_data_by(PARAM, AVISIT) @@ -152,10 +91,10 @@ test_that("Descriptive statistics data limiting works properly", { x2 <- build(t2) - cnts2 <- count(x2, row_label1, row_label2) + cnts2 <- dplyr::count(x2, row_label1, row_label2) expect_equal(cnts2$n, c(3, 9, 3, 9)) - t3 <- tplyr_table(adpe, TRT01A) %>% + t3 <- tplyr_table(tplyr_adpe, TRT01A) %>% add_layer( group_count(AVALC, by = vars(PECAT, PARAM, AVISIT)) %>% set_limit_data_by(PECAT, PARAM, AVISIT) @@ -163,8 +102,37 @@ test_that("Descriptive statistics data limiting works properly", { x3 <- build(t3) - cnts3 <- count(x3, row_label1, row_label2) + cnts3 <- dplyr::count(x3, row_label1, row_label2) expect_equal(cnts3$n, c(3, 9, 9)) }) +test_that("Nested count layers limit data accurately", { + + t_ae1 <- tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD), by = vars(AESEV, AEOUT)) %>% + set_limit_data_by(AEOUT, AEDECOD) + ) + + t_ae_df1 <- t_ae1 %>% + build() %>% select(-starts_with('ord')) + + t_ae2 <- tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD), by = vars(AESEV, AEOUT)) %>% + set_limit_data_by(AESEV, AEOUT, AEDECOD) + ) + + t_ae_df2 <- t_ae2 %>% + build() %>% select(-starts_with('ord')) + + dropped_rows <- anti_join( + t_ae_df1, + t_ae_df2, + by=names(t_ae_df1) + ) + + check <- c(dropped_rows$var1_Placebo, dropped_rows$`var1_Xanomeline High Dose`, dropped_rows$`var1_Xanomeline Low Dose`) + expect_true(all(check == " 0 ( 0.0%)")) +}) diff --git a/tests/testthat/test-sort.R b/tests/testthat/test-sort.R index e0236cc0..e32fa740 100644 --- a/tests/testthat/test-sort.R +++ b/tests/testthat/test-sort.R @@ -283,7 +283,7 @@ test_that("Nested counts with by variables process properly", { # This is verifying that the right number of combinations of row_labels exist, and that # there aren't duplicate order values for the outer layer - expect_equal(nrow(count(t_ae_df1, row_label2, row_label3, ord_layer_3)), 6) + expect_equal(nrow(dplyr::count(t_ae_df1, row_label2, row_label3, ord_layer_3)), 6) t_ae2 <- tplyr_table(tplyr_adae, TRTA) %>% add_layer( @@ -297,6 +297,6 @@ test_that("Nested counts with by variables process properly", { build() # Same test but now working with a text outer layer and one by variable - expect_equal(nrow(count(t_ae_df2, row_label2, ord_layer_2)), 2) + expect_equal(nrow(dplyr::count(t_ae_df2, row_label2, ord_layer_2)), 2) }) diff --git a/vignettes/table.Rmd b/vignettes/table.Rmd index ae9c9a82..bad21d72 100644 --- a/vignettes/table.Rmd +++ b/vignettes/table.Rmd @@ -115,6 +115,58 @@ header_n(t) %>% Note: it’s expected the `set_distinct_by()` function is used with population data. This is because it does not make sense to use population data denominators unless you have distinct counts. The entire point of population data is to use subject counts, so non-distinct counts would potentially count multiple records per subject and then the percentage doesn’t make any sense. +## Data Completion + +When creating summary tables, often we have to mock up the potential values of data, even if those values aren't present in the data we're summarizing. **Tplyr** does its best effort to do this for you. Let's consider the following dataset: + +```{r data_comp, echo=FALSE} +kable(head(tplyr_adpe)) +``` +Let's say we want to create a count summary for this dataset, and report it by PARAM and AVISIT. Note that in the data, `PARAM=="HEAD"` is only collected at screening, while `LUNGS` is collected at Screening, Day -1, and Day 5. + +```{r data_comp1} +tplyr_table(tplyr_adpe, TRT01A) %>% + add_layer( + group_count(AVALC, by = vars(PARAM, AVISIT)) + ) %>% + build() %>% + select(-starts_with('ord')) %>% + head(18) %>% + kable() + +``` + +By default, given the `by` variables of PARAM and AVISIT, all of the potential visits have dummy rows created that are 0 filled - meaning results of 0 records for all treatment groups are presented. However, that might not be what you wish to present. Perhaps `HEAD` was only intended to be collected at the Screening visit so it's unnecessary to present other visits. To address this, you can use the `set_limit_data_by()` function. + +```{r data_comp2} +tplyr_table(tplyr_adpe, TRT01A) %>% + add_layer( + group_count(AVALC, by = vars(PARAM, AVISIT)) %>% + set_limit_data_by(PARAM, AVISIT) + ) %>% + build() %>% + select(-starts_with('ord')) %>% + head(12) %>% + kable() +``` + +Here you can see that now records for `HEAD` only present the screening visit. For count and shift layers, you can additionally dig further in to use target variables: + +```{r data_comp3} +tplyr_table(tplyr_adpe, TRT01A) %>% + add_layer( + group_count(AVALC, by = vars(PARAM, AVISIT)) %>% + set_limit_data_by(PARAM, AVISIT, AVALC) + ) %>% + build() %>% + select(-starts_with('ord')) %>% + kable() +``` + +This effectively limits to the values present in the data itself. + +## Where to Go From Here + With the table level settings under control, now you're ready to learn more about what **Tplyr** has to offer in each layer. - Learn more about descriptive statistics layers in `vignette("desc")` From d741739906d8b281d28b501131c2cde66f204171 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 13:48:49 +0000 Subject: [PATCH 55/83] Push development for missing subs --- R/count.R | 77 ++++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 65 insertions(+), 12 deletions(-) diff --git a/R/count.R b/R/count.R index 030db51d..0311fe68 100644 --- a/R/count.R +++ b/R/count.R @@ -129,6 +129,8 @@ process_single_count_target <- function(x) { if (is.null(include_total_row)) include_total_row <- FALSE if (is.null(total_row_label)) total_row_label <- "Total" + if (is.null(include_missing_subjects_row)) include_missing_subjects_row <- FALSE + if (is.null(missing_subjects_row_label)) missing_subjects_row_label <- "Missing" # The current environment should be the layer itself process_count_n(current_env()) @@ -150,6 +152,10 @@ process_single_count_target <- function(x) { } } + if (include_missing_subjects_row) { + process_missing_subjects_row(current_env()) + } + if (is.null(count_row_prefix)) count_row_prefix <- "" # If a denoms variable is factor then it should be character for the denoms calculations @@ -186,17 +192,16 @@ process_single_count_target <- function(x) { } # rbind tables together - numeric_data <- summary_stat %>% - bind_rows(total_stat) %>% + numeric_data <- bind_rows(summary_stat, total_stat, missing_subjects_stat) %>% rename("summary_var" = !!target_var[[1]]) %>% group_by(!!!denoms_by) %>% do(get_denom_total(., denoms_by, denoms_df_prep, "n")) %>% mutate(summary_var = prefix_count_row(summary_var, count_row_prefix)) %>% ungroup() - if (!is.null(distinct_stat)) { if (include_total_row) { + distinct_stat <- distinct_stat %>% bind_rows(total_stat_denom) %>% group_by(!!!denoms_by) %>% @@ -275,6 +280,25 @@ process_count_n <- function(x) { } + +#' Get Logical vector that is used to remove the treat_var and cols +#' +#' In total row and missing subject counts, denoms_by needs to be stripped of +#' cols and treat_var variables, otherwise it will error out in the group_by +#' +#' @param denoms_by The layer denoms by +#' @param treat_var table treat var +#' @param cols tables cols vars +#' +#' @return list of quosures +#' @noRd +get_needed_denoms_by <- function(denoms_by, treat_var, cols) { + map_lgl(denoms_by, function(x, treat_var, cols) { + all(as_name(x) != as_name(treat_var), + as_name(x) != map_chr(cols, as_name)) + }, treat_var, cols) +} + #' Process the amounts for a total row #' #' @param x A Count layer @@ -290,16 +314,8 @@ no denoms_by variable was set. This may cause unexpected results. If you wish to change this behavior, use `set_denoms_by()`.", immediate. = TRUE) } - # Make sure the denoms_by is stripped - # Stripped of cols and treat_var variables, otherwise it will error out in the group_by - # I thought of replacing the group by with !!!unique(c(treat_var, cols, denoms_by)) - # but that doesn't work due to the denoms_by having an environment set - # Logical vector that is used to remove the treat_var and cols - needed_denoms_by <- map_lgl(denoms_by, function(x, treat_var, cols) { - all(as_name(x) != as_name(treat_var), - as_name(x) != map_chr(cols, as_name)) - }, treat_var, cols) + needed_denoms_by <- get_needed_denoms_by(denoms_by, treat_var, cols) #Create an expression to evaluate filter if (!count_missings) { @@ -332,6 +348,43 @@ change this behavior, use `set_denoms_by()`.", immediate. = TRUE) }, envir = x) } +#' Process the amounts for a missing subjects row +#' +#' @param x A Count layer +#' @noRd +process_missing_subjects_row <- function(x) { + evalq({ + + # Logical vector that is used to remove the treat_var and cols + needed_denoms_by <- get_needed_denoms_by(denoms_by, treat_var, cols) + + # Create the merge variables to join the header_n data + mrg_vars <- map_chr(c(pop_treat_var, cols, denoms_by[needed_denoms_by]), as_name) + names(mrg_vars)[1] <- as_name(treat_var) + + # create a data.frame to create total counts + missing_subjects_stat <- built_target %>% + # Use distinct if this is a distinct total row + # Group by all column variables + group_by(!!treat_var, !!!cols, !!!by, !!!distinct_by) %>% + distinct() %>% + ungroup() %>% + count(!!treat_var, !!!cols, !!!by, name="distinct_n") %>% + left_join( + header_n %>% rename(distinct_total = n), by = mrg_vars + ) %>% + # Create a variable to label the totals when it is merged in. + mutate(!!as_name(target_var[[1]]) := missing_subjects_row_label) %>% + # Create variables to carry forward 'by'. Only pull out the ones that + # aren't symbols + group_by(!!!extract_character_from_quo(by)) %>% + # ungroup right away to make sure the complete works + ungroup() %>% + # complete based on missing groupings + complete(!!treat_var, !!!cols, fill = list(n = 0, total = 0)) + }, envir = x) +} + #' Prepare metadata for table #' #' @param x count_layer object From 208c13c3ad18357a072ceeae19d38b9e495ce1a6 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 13:49:16 +0000 Subject: [PATCH 56/83] Unreachable code - this is legacy from denom refactor --- R/count.R | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/R/count.R b/R/count.R index 0311fe68..75f9115a 100644 --- a/R/count.R +++ b/R/count.R @@ -199,18 +199,6 @@ process_single_count_target <- function(x) { mutate(summary_var = prefix_count_row(summary_var, count_row_prefix)) %>% ungroup() - if (!is.null(distinct_stat)) { - if (include_total_row) { - - distinct_stat <- distinct_stat %>% - bind_rows(total_stat_denom) %>% - group_by(!!!denoms_by) %>% - do(get_denom_total(., denoms_by, denoms_df, "distinct_n")) - } - numeric_data <- bind_cols(numeric_data, - distinct_stat[, c("distinct_n", "distinct_total")]) - } - rm(denoms_df_prep, fct_cols) }, envir = x) From 111d90d87d071ac66760c7287876e3d105e81a32 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 13:49:48 +0000 Subject: [PATCH 57/83] Bindings for add missing subs --- R/count_bindings.R | 64 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 64 insertions(+) diff --git a/R/count_bindings.R b/R/count_bindings.R index 197c6757..a618fd9f 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -711,3 +711,67 @@ set_numeric_threshold <- function(e, numeric_cutoff, stat, column = NULL) { e } + +#' Add a missing subject row into a count summary. +#' +#' +#' @param e A \code{count_layer} object +#' @param fmt An f_str object used to format the total row. If none is provided, +#' display is based on the layer formatting. +#' @param sort_value The value that will appear in the ordering column for total +#' rows. This must be a numeric value. +#' +#' @export +#' @examples +#' +#' tplyr_table(mtcars, gear) %>% +#' add_layer( +#' group_count(cyl) %>% +#' add_missing_subjects_row(f_str("xxxx", n)) +#' ) %>% +#' build() +add_missing_subjects_row <- function(e, fmt = NULL, sort_value = NULL) { + if(!is.null(fmt)) assert_inherits_class(fmt, "f_str") + if(!is.null(sort_value)) assert_inherits_class(sort_value, "numeric") + if("shift_layer" %in% class(e)) { + rlang::abort("`add_missing_subjects_row` for shift layers is not yet supported") + } + assert_inherits_class(e, "count_layer") + + env_bind(e, include_missing_subjects_row = TRUE) + env_bind(e, missing_subjects_count_format = fmt) + env_bind(e, missing_subjects_sort_value = sort_value) + + e +} + +#' Set the label for the missing subjects row +#' +#' @param e A \code{count_layer} object +#' @param total_row_label A character to label the total row +#' +#' @return The modified \code{count_layer} object +#' @export +#' +#' @examples +#' +#' t <- tplyr_table(mtcars, gear) %>% +#' add_layer( +#' group_count(cyl) %>% +#' add_missing_subjects_row() %>% +#' set_missing_subjects_label("Missing") +#' ) +#' build(t) +set_missing_subjects_row_label <- function(e, missing_subjects_row_label) { + + assert_has_class(missing_subjects_row_label, "character") + assert_that(length(missing_subjects_row_label) == 1) + if("shift_layer" %in% class(e)) { + rlang::abort("`missing_subjects_row_label` for shift layers is not yet supported") + } + assert_inherits_class(e, "count_layer") + + env_bind(e, missing_subjects_row_label = missing_subjects_row_label) + + e +} From 0f5b1467e11696bb686164ca1b76959709aa5dd2 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 14:54:02 +0000 Subject: [PATCH 58/83] push development --- NAMESPACE | 2 ++ R/count.R | 40 +++++++++++++++++++++------ R/sort.R | 27 +++++++++++++----- R/zzz.R | 6 ++-- man/add_missing_subjects_row.Rd | 29 +++++++++++++++++++ man/set_missing_subjects_row_label.Rd | 29 +++++++++++++++++++ 6 files changed, 115 insertions(+), 18 deletions(-) create mode 100644 man/add_missing_subjects_row.Rd create mode 100644 man/set_missing_subjects_row_label.Rd diff --git a/NAMESPACE b/NAMESPACE index d2b779eb..8566d406 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -45,6 +45,7 @@ export(add_column_headers) export(add_filters) export(add_layer) export(add_layers) +export(add_missing_subjects_row) export(add_risk_diff) export(add_total_group) export(add_total_row) @@ -102,6 +103,7 @@ export(set_format_strings) export(set_header_n) export(set_indentation) export(set_missing_count) +export(set_missing_subjects_row_label) export(set_nest_count) export(set_numeric_threshold) export(set_order_count_method) diff --git a/R/count.R b/R/count.R index 75f9115a..6d862b2a 100644 --- a/R/count.R +++ b/R/count.R @@ -459,6 +459,7 @@ process_formatting.count_layer <- function(x, ...) { summary_var = summary_var, indentation_length = indentation_length, total_count_format = total_count_format, + missing_subjects_count_format = missing_subjects_count_format, total_row_label = total_row_label, has_missing_count = has_missing_count) }) %>% @@ -526,7 +527,7 @@ process_formatting.count_layer <- function(x, ...) { construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_total = NULL, count_fmt = NULL, max_layer_length, max_n_width, missing_string, missing_f_str, summary_var, indentation_length, total_count_format, - total_row_label, has_missing_count) { + missing_subjects_count_format, total_row_label, has_missing_count) { ## Added this for processing formatting in nested count layers where this won't be processed yet if (is.null(max_layer_length)) max_layer_length <- 0 @@ -556,6 +557,12 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot total_vars_ord <- map_chr(total_count_format$vars, as_name) } + ## Pull out string information for missing subject rows + if (!is.null(missing_subjects_count_format)) { + missing_subject_rows <- summary_var %in% missing_subjects_row_label + missing_subject_vars_ord <- map_chr(missing_subjects_count_format$vars, as_name) + } + vars_ord <- map_chr(count_fmt$vars, as_name) # str_all is a list that contains character vectors for each parameter that might be calculated @@ -563,9 +570,14 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot # Append the repl_str to be passed to do.call str_all[1] <- count_fmt$repl_str # Iterate over every variable + rows_ <- !missing_rows & !total_rows & !missing_subject_rows for (i in seq_along(vars_ord)) { - str_all[[i + 1]] <- count_string_switch_help(vars_ord[i], count_fmt, .n[!missing_rows & !total_rows], .total[!missing_rows & !total_rows], - .distinct_n[!missing_rows & !total_rows], .distinct_total[!missing_rows & !total_rows], vars_ord) + str_all[[i + 1]] <- count_string_switch_help(vars_ord[i], count_fmt, + .n[rows_], + .total[rows_], + .distinct_n[rows_], + .distinct_total[rows_], + vars_ord) } @@ -595,20 +607,32 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot total_vars_ord) } + missing_subs_str_all <- vector("list", 5) + missing_subs_str_all[1] <- missing_subjects_count_format$repl_str + for (i in seq_along(missing_subject_vars_ord)) { + missing_subs_str_all[[i + 1]] <- count_string_switch_help(missing_subject_vars_ord[i], + missing_subjects_count_format, + .n[missing_subject_rows], + .total[missing_subject_rows], + .distinct_n[missing_subject_rows], + .distinct_total[missing_subject_rows], + missing_subject_vars_ord) + } + # Put the vector strings together. Only include parts of str_all that aren't null - # nm is non-missing, m is mising, and t is total. + # nm is non-missing, m is missing, t is total, ms is missing subjects string_nm <- do.call(sprintf, str_all[!map_lgl(str_all, is.null)]) if (!is.null(missing_vars_ord)) string_m <- do.call(sprintf, missing_str_all[!map_lgl(missing_str_all, is.null)]) if (!is.null(total_vars_ord)) string_t <- do.call(sprintf, total_str_all[!map_lgl(total_str_all, is.null)]) + if (!is.null(missing_subject_vars_ord)) string_ms <- do.call(sprintf, missing_subs_str_all[!map_lgl(missing_subs_str_all, is.null)]) # string_ is the final string to return. Merge the missing, non-missing, and others together string_ <- character(length(string_nm) + length(string_m) + length(string_t)) - string_[!missing_rows & !total_rows] <- string_nm + string_[rows_] <- string_nm string_[total_rows] <- string_t string_[missing_rows] <- string_m + string_[missing_subject_rows] <- string_ms - - - + browser() # Left pad set to 0 meaning it won't pad to the left at all # right pad is set to the maximum n count in the table string_ <- pad_formatted_data(string_, 0, max_n_width) diff --git a/R/sort.R b/R/sort.R index 1409f713..2d84b0be 100644 --- a/R/sort.R +++ b/R/sort.R @@ -352,7 +352,8 @@ add_order_columns.shift_layer <- function(x) { # The logic is the same now for a byvarn so reuse that function formatted_data[, paste0("ord_layer_", formatted_col_index)] <- get_data_order_byvarn(formatted_data, fact_df, as_name(target_var$row), - formatted_col_index, total_row_sort_value = total_row_sort_value) + formatted_col_index, total_row_sort_value = total_row_sort_value, + missing_subjects_sort_value = missing_subjects_sort_value) rm(formatted_col_index) @@ -432,7 +433,7 @@ get_data_order <- function(x, formatted_col_index) { get_data_order_bycount(numeric_data, ordering_cols, treat_var, by, cols, result_order_var, target_var, missing_index, missing_sort_value, - total_index, total_row_sort_value, + total_index, total_row_sort_value, missing_subjects_sort_value, break_ties = break_ties, numeric_cutoff = numeric_cutoff, numeric_cutoff_stat = numeric_cutoff_stat, @@ -466,7 +467,8 @@ get_data_order <- function(x, formatted_col_index) { } get_data_order_byvarn(formatted_data, varn_df, as_name(target_var[[1]]), - formatted_col_index, total_row_sort_value = total_row_sort_value) + formatted_col_index, total_row_sort_value = total_row_sort_value, + missing_subjects_sort_value = missing_subjects_sort_value) # Here it is 'byfactor' @@ -521,7 +523,8 @@ get_data_order <- function(x, formatted_col_index) { # The logic is the same now for a byvarn so reuse that function get_data_order_byvarn(formatted_data, fact_df, as_name(target_var[[1]]), - formatted_col_index, total_row_sort_value = total_row_sort_value) + formatted_col_index, total_row_sort_value = total_row_sort_value, + missing_subjects_sort_value = missing_subjects_sort_value) } }, envir = x) } @@ -532,6 +535,7 @@ get_data_order_bycount <- function(numeric_data, ordering_cols, treat_var, by, cols, result_order_var, target_var, missing_index = NULL, missing_sort_value = NULL, total_index = NULL, total_row_sort_value = NULL, + missing_subjects_sort_value = NULL, break_ties, numeric_cutoff, numeric_cutoff_stat, numeric_cutoff_column, nested = FALSE) { @@ -606,6 +610,10 @@ get_data_order_bycount <- function(numeric_data, ordering_cols, numeric_ordering_data[total_index,] <- total_row_sort_value } + if(!is.null(missing_subjects_index) && !is.null(missing_subjects_sort_value)) { + numeric_ordering_data[missing_subjects_sort_value,] <- missing_subjects_sort_value + } + # This is the numeric index that the numeric data is in. radix was chosen because # its the only method that gives indicies as far as I can tell # x are the values @@ -632,7 +640,8 @@ get_data_order_bycount <- function(numeric_data, ordering_cols, } get_data_order_byvarn <- function(formatted_data, by_varn_df, by_var, by_column_index, - indentation = "", total_row_sort_value = NULL) { + indentation = "", total_row_sort_value = NULL, + missing_subjects_sort_value = NULL) { # Pull out the by values in the formatted data. by_values <- unlist(formatted_data[, by_column_index]) @@ -650,6 +659,8 @@ get_data_order_byvarn <- function(formatted_data, by_varn_df, by_var, by_column_ # Flag to determine where total row is positioned if(!is.null(total_row_sort_value)) { total_row_sort_value + } else if (!is.null(missing_subjects_sort_value)){ + missing_subjects_sort_value } else { max(by_varn_df[,2]) + 1 } @@ -699,7 +710,8 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { varn_df <- get_varn_values(target, as_name(by[[1]])) all_outer$..index <- group_data[1,] %>% - get_data_order_byvarn(varn_df, by[[1]], final_col, total_row_sort_value = total_row_sort_value) + get_data_order_byvarn(varn_df, by[[1]], final_col, total_row_sort_value = total_row_sort_value, + missing_subjects_sort_value = missing_subjects_sort_value) group_data[, paste0("ord_layer_", final_col)] <- all_outer %>% filter(summary_var == outer_value) %>% @@ -767,7 +779,8 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { target_var[[1]], length(by) + 1, indentation, - total_row_sort_value = total_row_sort_value) + total_row_sort_value = total_row_sort_value, + missing_subjects_sort_value = missing_subjects_sort_value) } else { diff --git a/R/zzz.R b/R/zzz.R index 70df2747..b06b2444 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -199,7 +199,6 @@ display_string <- NULL built_target <- NULL table_where <- NULL distinct_by <- NULL -distinct_stat <- NULL summary_vars <- NULL trans_vars <- NULL stat <- NULL @@ -277,7 +276,6 @@ missing_sort_value <- NULL missing_index <- NULL total_index <- NULL process_distinct_total <- FALSE -total_stat_denom <- NULL denom_where <- NULL built_target_pre_where <- NULL count_fmt <- NULL @@ -307,4 +305,6 @@ og_row <- NULL desc <- NULL id <- NULL stub_sort <- NULL - +include_missing_subjects_row <- NULL +missing_subjects_row_label <- NULL +missing_subjects_stat <- NULL diff --git a/man/add_missing_subjects_row.Rd b/man/add_missing_subjects_row.Rd new file mode 100644 index 00000000..cfb873d7 --- /dev/null +++ b/man/add_missing_subjects_row.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/count_bindings.R +\name{add_missing_subjects_row} +\alias{add_missing_subjects_row} +\title{Add a missing subject row into a count summary.} +\usage{ +add_missing_subjects_row(e, fmt = NULL, sort_value = NULL) +} +\arguments{ +\item{e}{A \code{count_layer} object} + +\item{fmt}{An f_str object used to format the total row. If none is provided, +display is based on the layer formatting.} + +\item{sort_value}{The value that will appear in the ordering column for total +rows. This must be a numeric value.} +} +\description{ +Add a missing subject row into a count summary. +} +\examples{ + +tplyr_table(mtcars, gear) \%>\% + add_layer( + group_count(cyl) \%>\% + add_missing_subjects_row(f_str("xxxx", n)) + ) \%>\% + build() +} diff --git a/man/set_missing_subjects_row_label.Rd b/man/set_missing_subjects_row_label.Rd new file mode 100644 index 00000000..ed75af9e --- /dev/null +++ b/man/set_missing_subjects_row_label.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/count_bindings.R +\name{set_missing_subjects_row_label} +\alias{set_missing_subjects_row_label} +\title{Set the label for the missing subjects row} +\usage{ +set_missing_subjects_row_label(e, missing_subjects_row_label) +} +\arguments{ +\item{e}{A \code{count_layer} object} + +\item{total_row_label}{A character to label the total row} +} +\value{ +The modified \code{count_layer} object +} +\description{ +Set the label for the missing subjects row +} +\examples{ + +t <- tplyr_table(mtcars, gear) \%>\% + add_layer( + group_count(cyl) \%>\% + add_missing_subjects_row() \%>\% + set_missing_subjects_label("Missing") + ) +build(t) +} From 0bb5023a4ef6ee58d49cab676997b56f0b1a31f9 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 15:12:32 +0000 Subject: [PATCH 59/83] save so I can compare --- R/count.R | 2 ++ R/zzz.R | 4 ++++ 2 files changed, 6 insertions(+) diff --git a/R/count.R b/R/count.R index 6d862b2a..93898cb4 100644 --- a/R/count.R +++ b/R/count.R @@ -534,6 +534,7 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot if (is.null(max_n_width)) max_n_width <- 0 missing_rows <- FALSE total_rows <- FALSE + missing_subject_rows <- FALSE # Add in the missing format if its null and there are missing counts if (has_missing_count && is.null(missing_f_str)) { @@ -621,6 +622,7 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot # Put the vector strings together. Only include parts of str_all that aren't null # nm is non-missing, m is missing, t is total, ms is missing subjects + browser() string_nm <- do.call(sprintf, str_all[!map_lgl(str_all, is.null)]) if (!is.null(missing_vars_ord)) string_m <- do.call(sprintf, missing_str_all[!map_lgl(missing_str_all, is.null)]) if (!is.null(total_vars_ord)) string_t <- do.call(sprintf, total_str_all[!map_lgl(total_str_all, is.null)]) diff --git a/R/zzz.R b/R/zzz.R index b06b2444..6fb9f413 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -308,3 +308,7 @@ stub_sort <- NULL include_missing_subjects_row <- NULL missing_subjects_row_label <- NULL missing_subjects_stat <- NULL +missing_subjects_count_format <- NULL +missing_subject_rows <- NULL +missing_subject_vars_ord <- NULL +string_ms <- NULL From c9904b73a5b1ac181cef45a4b32d502f921cbe82 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 21:26:18 +0000 Subject: [PATCH 60/83] namespace --- NAMESPACE | 1 + R/zzz.R | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 8566d406..233873fc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -141,6 +141,7 @@ importFrom(dplyr,between) importFrom(dplyr,bind_cols) importFrom(dplyr,bind_rows) importFrom(dplyr,case_when) +importFrom(dplyr,count) importFrom(dplyr,cur_column) importFrom(dplyr,cur_group) importFrom(dplyr,desc) diff --git a/R/zzz.R b/R/zzz.R index 6fb9f413..8fbb1823 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -11,7 +11,7 @@ #' @importFrom stats IQR median sd quantile var #' @importFrom dplyr n summarize filter vars tally ungroup group_by mutate lag select bind_rows full_join add_tally distinct rowwise #' @importFrom dplyr everything rename mutate_at mutate_all as_tibble bind_cols do case_when arrange left_join row_number between mutate_if -#' @importFrom dplyr across anti_join n_distinct if_else group_keys cur_group cur_column pull matches slice_head where desc +#' @importFrom dplyr across anti_join n_distinct if_else group_keys cur_group cur_column pull matches slice_head where desc count #' @importFrom tidyr complete nesting pivot_wider pivot_longer replace_na starts_with fill #' @importFrom utils str head tail #' @importFrom tidyselect all_of vars_select any_of @@ -312,3 +312,4 @@ missing_subjects_count_format <- NULL missing_subject_rows <- NULL missing_subject_vars_ord <- NULL string_ms <- NULL +missing_subjects_sort_value <- NULL From 963aeb5c11da0d91d578ff2922cc51cb24e64544 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 21:26:51 +0000 Subject: [PATCH 61/83] I don't actually see what changed here? --- R/utils.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 1187d100..e38ab18f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -314,8 +314,8 @@ ut_round <- function(x, n=0) { # x is the value to be rounded # n is the precision of the rounding - posneg <- sign(x) - e <- abs(x) * 10^n + posneg <- sign(x) + e <- abs(x) * 10^n e <- e + 0.5 + sqrt(.Machine$double.eps) e <- trunc(e) e <- e / 10^n From aeb9843c415093fdafa78200d2bcd181f5dd203a Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 21:27:17 +0000 Subject: [PATCH 62/83] iron out nuance and sorting for subject counts --- R/count.R | 50 +++++++++++++++++++++++++++----------------------- R/nested.R | 19 ++++++++++++++----- R/sort.R | 13 ++++++++++--- 3 files changed, 51 insertions(+), 31 deletions(-) diff --git a/R/count.R b/R/count.R index 93898cb4..5726dc68 100644 --- a/R/count.R +++ b/R/count.R @@ -39,6 +39,13 @@ process_summaries.count_layer <- function(x, ...) { sep = " "))) } + # Do this here to make sure that defaults are available everywhere else + # Downstream + if (is.null(include_total_row)) include_total_row <- FALSE + if (is.null(total_row_label)) total_row_label <- "Total" + if (is.null(include_missing_subjects_row)) include_missing_subjects_row <- FALSE + if (is.null(missing_subjects_row_label)) missing_subjects_row_label <- "Missing" + # Save this for the denominator where, but only if it hasn't been saved yet. if (is.null(built_target_pre_where)) built_target_pre_where <- built_target @@ -127,11 +134,6 @@ process_summaries.count_layer <- function(x, ...) { process_single_count_target <- function(x) { evalq({ - if (is.null(include_total_row)) include_total_row <- FALSE - if (is.null(total_row_label)) total_row_label <- "Total" - if (is.null(include_missing_subjects_row)) include_missing_subjects_row <- FALSE - if (is.null(missing_subjects_row_label)) missing_subjects_row_label <- "Missing" - # The current environment should be the layer itself process_count_n(current_env()) @@ -330,9 +332,7 @@ change this behavior, use `set_denoms_by()`.", immediate. = TRUE) # aren't symbols group_by(!!!extract_character_from_quo(by)) %>% # ungroup right away to make sure the complete works - ungroup() %>% - # complete based on missing groupings - complete(!!treat_var, !!!cols, fill = list(n = 0, total = 0)) + ungroup() }, envir = x) } @@ -349,27 +349,28 @@ process_missing_subjects_row <- function(x) { # Create the merge variables to join the header_n data mrg_vars <- map_chr(c(pop_treat_var, cols, denoms_by[needed_denoms_by]), as_name) names(mrg_vars)[1] <- as_name(treat_var) - # create a data.frame to create total counts missing_subjects_stat <- built_target %>% # Use distinct if this is a distinct total row # Group by all column variables - group_by(!!treat_var, !!!cols, !!!by, !!!distinct_by) %>% - distinct() %>% + distinct(!!treat_var, !!!cols, !!!by, !!!distinct_by) %>% ungroup() %>% - count(!!treat_var, !!!cols, !!!by, name="distinct_n") %>% + count(!!treat_var, !!!cols, !!!by, name="n_present") %>% + # complete based on missing groupings + complete(!!treat_var, !!!cols, !!!by, fill = list(distinct_n = 0)) %>% left_join( - header_n %>% rename(distinct_total = n), by = mrg_vars + header_n %>% rename(header_tots = n), by = mrg_vars ) %>% # Create a variable to label the totals when it is merged in. - mutate(!!as_name(target_var[[1]]) := missing_subjects_row_label) %>% + mutate( + !!as_name(target_var[[1]]) := missing_subjects_row_label, + distinct_n = header_tots - n_present + ) %>% # Create variables to carry forward 'by'. Only pull out the ones that # aren't symbols group_by(!!!extract_character_from_quo(by)) %>% # ungroup right away to make sure the complete works - ungroup() %>% - # complete based on missing groupings - complete(!!treat_var, !!!cols, fill = list(n = 0, total = 0)) + ungroup() }, envir = x) } @@ -461,6 +462,7 @@ process_formatting.count_layer <- function(x, ...) { total_count_format = total_count_format, missing_subjects_count_format = missing_subjects_count_format, total_row_label = total_row_label, + missing_subjects_row_label = missing_subjects_row_label, has_missing_count = has_missing_count) }) %>% # Pivot table @@ -521,13 +523,19 @@ process_formatting.count_layer <- function(x, ...) { #' target variable. #' @param indentation_length If this is a nested count layer. The row prefixes #' must be removed +#' @param total_count_format f_str for total counts +#' @param missing_subjects_count_format f_str for missing subjects +#' @param total_row_label Label string for total rows +#' @param missing_subjects_row_label Label string for missing subjects +#' @param has_missing_count Boolean for if missing counts are present #' #' @return A tibble replacing the original counts #' @noRd construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_total = NULL, count_fmt = NULL, max_layer_length, max_n_width, missing_string, missing_f_str, summary_var, indentation_length, total_count_format, - missing_subjects_count_format, total_row_label, has_missing_count) { + missing_subjects_count_format, total_row_label, missing_subjects_row_label, + has_missing_count) { ## Added this for processing formatting in nested count layers where this won't be processed yet if (is.null(max_layer_length)) max_layer_length <- 0 @@ -581,7 +589,6 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot vars_ord) } - # Logic for missing # Same logic as above, just add for missing missing_str_all <- vector("list", 5) @@ -622,19 +629,16 @@ construct_count_string <- function(.n, .total, .distinct_n = NULL, .distinct_tot # Put the vector strings together. Only include parts of str_all that aren't null # nm is non-missing, m is missing, t is total, ms is missing subjects - browser() string_nm <- do.call(sprintf, str_all[!map_lgl(str_all, is.null)]) if (!is.null(missing_vars_ord)) string_m <- do.call(sprintf, missing_str_all[!map_lgl(missing_str_all, is.null)]) if (!is.null(total_vars_ord)) string_t <- do.call(sprintf, total_str_all[!map_lgl(total_str_all, is.null)]) if (!is.null(missing_subject_vars_ord)) string_ms <- do.call(sprintf, missing_subs_str_all[!map_lgl(missing_subs_str_all, is.null)]) # string_ is the final string to return. Merge the missing, non-missing, and others together - string_ <- character(length(string_nm) + length(string_m) + length(string_t)) + string_ <- character(sum(length(string_nm), length(string_m), length(string_t), length(string_ms))) string_[rows_] <- string_nm string_[total_rows] <- string_t string_[missing_rows] <- string_m string_[missing_subject_rows] <- string_ms - - browser() # Left pad set to 0 meaning it won't pad to the left at all # right pad is set to the maximum n count in the table string_ <- pad_formatted_data(string_, 0, max_n_width) diff --git a/R/nested.R b/R/nested.R index e05e854c..971a9770 100644 --- a/R/nested.R +++ b/R/nested.R @@ -32,8 +32,11 @@ process_nested_count_target <- function(x) { second_denoms_by <- denoms_by } - first_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[1]], - by = vars(!!!by), where = !!where)) + # Missing subject counts should not occur in the outer layer + fl <- group_count(current_env(), target_var = !!target_var[[1]], + by = vars(!!!by), where = !!where) + fl$include_missing_subjects_row <- FALSE + first_layer <- process_summaries(fl) second_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[2]], by = vars(!!target_var[[1]], !!!by), where = !!where) %>% @@ -50,7 +53,8 @@ process_nested_count_target <- function(x) { treat_var = treat_var ) %>% group_by(!!target_var[[1]]) %>% - do(filter_nested_inner_layer(., target, target_var[[1]], target_var[[2]], indentation)) + do(filter_nested_inner_layer(., target, target_var[[1]], target_var[[2]], indentation, + missing_subjects_row_label)) ignored_filter_rows <- ifelse(include_total_row, ifelse(is.null(total_row_label), @@ -85,7 +89,8 @@ process_nested_count_target <- function(x) { #' This function is meant to remove the values of an inner layer that don't #' appear in the target data #' @noRd -filter_nested_inner_layer <- function(.group, target, outer_name, inner_name, indentation) { +filter_nested_inner_layer <- function(.group, target, outer_name, inner_name, indentation, + missing_subjects_row_label) { # Is outer variable text? If it is don't filter on it text_outer <- !quo_is_symbol(outer_name) @@ -108,9 +113,13 @@ filter_nested_inner_layer <- function(.group, target, outer_name, inner_name, in filter(!!sym(outer_name) == current_outer_value) %>% select(any_of(inner_name)) %>% unlist() %>% - paste0(indentation, .) + paste0(indentation, .) %>% + unique() } + target_inner_values <- c(target_inner_values %>% unique(), + paste0(indentation, missing_subjects_row_label)) + .group %>% filter(summary_var %in% target_inner_values) diff --git a/R/sort.R b/R/sort.R index 2d84b0be..e38dcb55 100644 --- a/R/sort.R +++ b/R/sort.R @@ -222,7 +222,9 @@ add_order_columns.count_layer <- function(x) { break_ties = break_ties, numeric_cutoff = numeric_cutoff, numeric_cutoff_stat = numeric_cutoff_stat, - numeric_cutoff_column = numeric_cutoff_column)) %>% + numeric_cutoff_column = numeric_cutoff_column, + missing_subjects_row_label = missing_subjects_row_label, + missing_subjects_sort_value = missing_subjects_sort_value)) %>% ungroup() if (!is.null(nest_count) && nest_count) { @@ -428,6 +430,9 @@ get_data_order <- function(x, formatted_col_index) { if(!is.null(missing_string)) missing_index <- which(unlist(formatted_data[, label_row_ind]) %in% missing_string) if(!is.null(total_row_label)) total_index <- which(unlist(formatted_data[, label_row_ind]) %in% total_row_label) + if(!is.null(missing_subjects_row_label)) { + missing_subjects_index <- which(unlist(formatted_data[, label_row_ind]) %in% missing_subjects_row_label) + } # No processing is needed here just pass in the needed info get_data_order_bycount(numeric_data, ordering_cols, @@ -611,7 +616,7 @@ get_data_order_bycount <- function(numeric_data, ordering_cols, } if(!is.null(missing_subjects_index) && !is.null(missing_subjects_sort_value)) { - numeric_ordering_data[missing_subjects_sort_value,] <- missing_subjects_sort_value + numeric_ordering_data[missing_subjects_index,] <- missing_subjects_sort_value } # This is the numeric index that the numeric data is in. radix was chosen because @@ -783,11 +788,13 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { missing_subjects_sort_value = missing_subjects_sort_value) } else { - group_row_count <- nrow(group_data[-1,]) # Logic for group_row_count is when numeric_where values cause unexpected results group_data[-1, paste0("ord_layer_", final_col + 1)] <- 1:ifelse(group_row_count == 0, 1, group_row_count) + # missing_subjects_row_label not passing in here + missing_rows <- group_data[[paste0('row_label', final_col+1)]] == paste0(indentation, missing_subjects_row_label) + group_data[missing_rows, paste0("ord_layer_", final_col + 1)] <- missing_subjects_sort_value } group_data From 54d5c1b7e0908598f5dba740e49635d570711100 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 21:34:06 +0000 Subject: [PATCH 63/83] gh_issue_84 merge --- R/nested.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/nested.R b/R/nested.R index 971a9770..bea05511 100644 --- a/R/nested.R +++ b/R/nested.R @@ -37,7 +37,11 @@ process_nested_count_target <- function(x) { by = vars(!!!by), where = !!where) fl$include_missing_subjects_row <- FALSE first_layer <- process_summaries(fl) + outer_ <- TRUE + first_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[1]], + by = vars(!!!by), where = !!where)) + outer_ <- FALSE second_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[2]], by = vars(!!target_var[[1]], !!!by), where = !!where) %>% set_count_row_prefix(indentation) %>% From 89de295110ad7f319c67aa0bec7da82d9a117a56 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 21:34:06 +0000 Subject: [PATCH 64/83] gh_issue_84 merge --- R/nested.R | 4 ++++ R/sort.R | 18 ++---------------- 2 files changed, 6 insertions(+), 16 deletions(-) diff --git a/R/nested.R b/R/nested.R index 971a9770..bea05511 100644 --- a/R/nested.R +++ b/R/nested.R @@ -37,7 +37,11 @@ process_nested_count_target <- function(x) { by = vars(!!!by), where = !!where) fl$include_missing_subjects_row <- FALSE first_layer <- process_summaries(fl) + outer_ <- TRUE + first_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[1]], + by = vars(!!!by), where = !!where)) + outer_ <- FALSE second_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[2]], by = vars(!!target_var[[1]], !!!by), where = !!where) %>% set_count_row_prefix(indentation) %>% diff --git a/R/sort.R b/R/sort.R index 22d0c8dc..e9de385b 100644 --- a/R/sort.R +++ b/R/sort.R @@ -804,20 +804,6 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { varn_df <- get_varn_values(target, target_var[[1]]) - - -<<<<<<< HEAD - group_data[-1, paste0("ord_layer_", final_col + 1)] <- get_data_order_byvarn(filtered_group_data, - varn_df, - target_var[[1]], - length(by) + 1, - indentation, - total_row_sort_value = total_row_sort_value, - missing_subjects_sort_value = missing_subjects_sort_value) - - } else { - group_row_count <- nrow(group_data[-1,]) -======= group_data[ (outer_nest_rows + 1): nrow(group_data), paste0("ord_layer_", final_col + 1) @@ -826,10 +812,10 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { target_var[[1]], length(by) + 1, indentation, - total_row_sort_value = total_row_sort_value) + total_row_sort_value = total_row_sort_value, + missing_subjects_sort_value = missing_subjects_sort_value) } else { group_row_count <- nrow(group_data[(outer_nest_rows + 1): nrow(group_data),]) ->>>>>>> gh_issue_84 # Logic for group_row_count is when numeric_where values cause unexpected results group_data[ (outer_nest_rows + 1): nrow(group_data), From a9cc8936c227aca708962edaaf3198d3b0275ba0 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 8 Feb 2024 22:28:34 +0000 Subject: [PATCH 65/83] start testing and push progress --- R/count.R | 2 +- R/count_bindings.R | 2 +- R/nested.R | 5 +- R/sort.R | 12 ++- tests/testthat/test-count.R | 146 ++++++++++++++++++++++++++++++++++++ 5 files changed, 160 insertions(+), 7 deletions(-) diff --git a/R/count.R b/R/count.R index 0cb48224..270f3d64 100644 --- a/R/count.R +++ b/R/count.R @@ -362,7 +362,7 @@ process_missing_subjects_row <- function(x) { ungroup() %>% count(!!treat_var, !!!cols, !!!by, name="n_present") %>% # complete based on missing groupings - complete(!!treat_var, !!!cols, !!!by, fill = list(distinct_n = 0)) %>% + complete(!!treat_var, !!!cols, !!!by, fill = list(n_present = 0)) %>% left_join( header_n %>% rename(header_tots = n), by = mrg_vars ) %>% diff --git a/R/count_bindings.R b/R/count_bindings.R index a618fd9f..1eb1ddcb 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -767,7 +767,7 @@ set_missing_subjects_row_label <- function(e, missing_subjects_row_label) { assert_has_class(missing_subjects_row_label, "character") assert_that(length(missing_subjects_row_label) == 1) if("shift_layer" %in% class(e)) { - rlang::abort("`missing_subjects_row_label` for shift layers is not yet supported") + rlang::abort("`set_missing_subjects_row_label` for shift layers is not yet supported") } assert_inherits_class(e, "count_layer") diff --git a/R/nested.R b/R/nested.R index bea05511..9843c188 100644 --- a/R/nested.R +++ b/R/nested.R @@ -36,10 +36,9 @@ process_nested_count_target <- function(x) { fl <- group_count(current_env(), target_var = !!target_var[[1]], by = vars(!!!by), where = !!where) fl$include_missing_subjects_row <- FALSE - first_layer <- process_summaries(fl) outer_ <- TRUE - first_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[1]], - by = vars(!!!by), where = !!where)) + first_layer <- process_summaries(fl) + outer_ <- FALSE second_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[2]], diff --git a/R/sort.R b/R/sort.R index e9de385b..00d37436 100644 --- a/R/sort.R +++ b/R/sort.R @@ -438,6 +438,7 @@ get_data_order <- function(x, formatted_col_index) { if(!is.null(missing_string)) missing_index <- which(unlist(formatted_data[, label_row_ind]) %in% missing_string) if(!is.null(total_row_label)) total_index <- which(unlist(formatted_data[, label_row_ind]) %in% total_row_label) + if(!is.null(missing_subjects_row_label)) { missing_subjects_index <- which(unlist(formatted_data[, label_row_ind]) %in% missing_subjects_row_label) } @@ -446,7 +447,8 @@ get_data_order <- function(x, formatted_col_index) { get_data_order_bycount(numeric_data, ordering_cols, treat_var, by, cols, result_order_var, target_var, missing_index, missing_sort_value, - total_index, total_row_sort_value, missing_subjects_sort_value, + total_index, total_row_sort_value, + missing_subjects_index, missing_subjects_sort_value, break_ties = break_ties, numeric_cutoff = numeric_cutoff, numeric_cutoff_stat = numeric_cutoff_stat, @@ -548,6 +550,7 @@ get_data_order_bycount <- function(numeric_data, ordering_cols, treat_var, by, cols, result_order_var, target_var, missing_index = NULL, missing_sort_value = NULL, total_index = NULL, total_row_sort_value = NULL, + missing_subjects_index = NULL, missing_subjects_sort_value = NULL, break_ties, numeric_cutoff, numeric_cutoff_stat, numeric_cutoff_column, nested = FALSE) { @@ -780,12 +783,15 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { mutate(!!row_label_vec[length(row_label_vec)] := str_sub(.data[[row_label_vec[length(row_label_vec)]]], indentation_length + 1)) - + # Pick up here = we need to get the missing_subjects_index, but the label + # isn't so need to find the index and then pass that into get_data_order_bycount + browser() # The first row is always the first thing in the order so make it Inf group_data[1:outer_nest_rows, paste0("ord_layer_", final_col + 1)] <- ifelse((is.null(outer_inf) || outer_inf), Inf, -Inf) if(tail(order_count_method, 1) == "bycount") { if (nrow(group_data) > 1) { + browser() group_data[ (outer_nest_rows + 1): nrow(group_data), paste0("ord_layer_", final_col + 1)] <- get_data_order_bycount(filtered_numeric_data, @@ -796,6 +802,8 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { result_order_var, target_var, break_ties = break_ties, + missing_subjects_index = missing_subjects_index, + missing_subjects_sort_value = missing_subjects_sort_value, numeric_cutoff = numeric_cutoff, numeric_cutoff_stat = numeric_cutoff_stat, numeric_cutoff_column = numeric_cutoff_column, diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index b4d929f2..f8219061 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -945,3 +945,149 @@ test_that("Regression test to make sure cols produce correct denom", { expect_snapshot(t) }) + +test_that("Error checking for add_missing_subjects_row()", { + expect_snapshot_error( + tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(AEDECOD) %>% + add_missing_subjects_row("blah") + ) + ) + + expect_snapshot_error( + tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(AEDECOD) %>% + add_missing_subjects_row(f_str("xx", distinct_n), sort_value = "x") + ) + ) + + expect_error({ + tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_shift(vars(AEBODSYS, AEDECOD)) %>% + add_missing_subjects_row(f_str("xx", distinct_n)) + ) + }, "`add_missing_subjects_row` for shift layers" + ) + + expect_snapshot_error( + tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_desc(RACEN) %>% + add_missing_subjects_row(f_str("xx", distinct_n)) + ) + ) + + ## ---- + + expect_snapshot_error( + tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(AEDECOD) %>% + set_missing_subjects_row_label(3) + ) + ) + + expect_snapshot_error( + tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_count(AEDECOD) %>% + set_missing_subjects_row_label(c("x", "y")) + ) + ) + + expect_error({ + tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_shift(vars(AEBODSYS, AEDECOD)) %>% + set_missing_subjects_row_label("x") + )}, "`set_missing_subjects_row_label` for shift layers" + ) + + expect_snapshot_error( + tplyr_table(tplyr_adae, TRTA) %>% + add_layer( + group_desc(RACEN) %>% + set_missing_subjects_row_label("x") + ) + ) + +}) + +test_that("Missing subjects row calculates correctly", { + x <- tplyr_table(tplyr_adlb, TRTA, cols=SEX) %>% + set_pop_data(tplyr_adsl) %>% + set_pop_treat_var(TRT01A) %>% + add_layer( + group_count(ANRIND, by = vars(PARAM, AVISIT)) %>% + set_distinct_by(USUBJID) %>% + add_missing_subjects_row(f_str("xx", distinct_n)) + ) %>% + build() + + # Check 1 + in_res1 <- x %>% + filter(row_label3 == "Missing", row_label1 == "Blood Urea Nitrogen (mmol/L)", row_label2 == "Week 12") %>% + pull(var1_Placebo_F) %>% + as.numeric() + + pop1 <- tplyr_adsl %>% + filter(TRT01A == "Placebo", SEX == "F") %>% + nrow() + + dat1 <- tplyr_adlb %>% + filter(PARAM == "Blood Urea Nitrogen (mmol/L)", AVISIT == "Week 12", TRTA == "Placebo", SEX == "F") %>% + distinct(USUBJID) %>% + nrow() + + expect_equal(pop1-dat1, in_res1) + + # Check 2 + in_res2 <- x %>% + filter(row_label3 == "Missing", row_label1 == "Gamma Glutamyl Transferase (U/L)", row_label2 == "Week 24") %>% + pull(`var1_Xanomeline Low Dose_M`) %>% + as.numeric() + + pop2 <- tplyr_adsl %>% + filter(TRT01A == "Xanomeline Low Dose", SEX == "M") %>% + nrow() + + dat2 <- tplyr_adlb %>% + filter(PARAM == "Gamma Glutamyl Transferase (U/L)", AVISIT == "Week 24", TRTA == "Xanomeline Low Dose", SEX == "M") %>% + distinct(USUBJID) %>% + nrow() + + expect_equal(pop2-dat2, in_res2) + +}) + +test_that("Missing counts on nested count layers function correctly", { + x <- tplyr_table(tplyr_adae, TRTA) %>% + set_pop_data(tplyr_adsl) %>% + set_pop_treat_var(TRT01A) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD)) %>% + set_distinct_by(USUBJID) %>% + add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = Inf) + ) %>% + build() + + expect_equal(nrow(x %>% filter(row_label2 == " Missing")), 1) + expect_equal(tail(x, 1)$ord_layer_2, Inf) + + x <- tplyr_table(tplyr_adae, TRTA) %>% + set_pop_data(tplyr_adsl) %>% + set_pop_treat_var(TRT01A) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD)) %>% + set_distinct_by(USUBJID) %>% + set_order_count_method("bycount") %>% + set_ordering_cols("Xanomeline High Dose") %>% + set_result_order_var(distinct_n) %>% + add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = Inf) + ) %>% + build() + +}) From 483412085696cfd5dc31751a3ea94e039ef76d02 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 9 Feb 2024 16:26:52 +0000 Subject: [PATCH 66/83] Finishing testing and remaining updates --- R/count.R | 3 +- R/sort.R | 68 ++++++++++++++++++---------------- tests/testthat/_snaps/count.md | 24 ++++++++++++ tests/testthat/test-count.R | 16 +++++++- 4 files changed, 78 insertions(+), 33 deletions(-) diff --git a/R/count.R b/R/count.R index 270f3d64..c896a930 100644 --- a/R/count.R +++ b/R/count.R @@ -375,7 +375,8 @@ process_missing_subjects_row <- function(x) { # aren't symbols group_by(!!!extract_character_from_quo(by)) %>% # ungroup right away to make sure the complete works - ungroup() + ungroup() %>% + select(-c(n_present, header_tots)) }, envir = x) } diff --git a/R/sort.R b/R/sort.R index 00d37436..d36563a2 100644 --- a/R/sort.R +++ b/R/sort.R @@ -627,7 +627,7 @@ get_data_order_bycount <- function(numeric_data, ordering_cols, } if(!is.null(missing_subjects_index) && !is.null(missing_subjects_sort_value)) { - numeric_ordering_data[missing_subjects_index,] <- missing_subjects_sort_value + numeric_ordering_data[missing_subjects_index,] <- missing_subjects_sort_value } # This is the numeric index that the numeric data is in. radix was chosen because @@ -776,22 +776,24 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { # Only include the parts of the numeric data that is in the current label filter(numeric_data$summary_var %in% present_vars, !!by[[1]] == outer_value) %>% # Remove nesting prefix to prepare numeric data. - mutate(summary_var := str_sub(summary_var, indentation_length)) + mutate(summary_var := str_sub(summary_var, indentation_length+1)) #Same idea here, remove prefix filtered_group_data <- tail(group_data, -outer_nest_rows) %>% mutate(!!row_label_vec[length(row_label_vec)] := str_sub(.data[[row_label_vec[length(row_label_vec)]]], indentation_length + 1)) - # Pick up here = we need to get the missing_subjects_index, but the label - # isn't so need to find the index and then pass that into get_data_order_bycount - browser() + + # Identify the index of missing subjects + if(!is.null(missing_subjects_row_label)) { + missing_subjects_index <- which(filtered_group_data[[length(row_label_vec)]] %in% missing_subjects_row_label) + } + # The first row is always the first thing in the order so make it Inf group_data[1:outer_nest_rows, paste0("ord_layer_", final_col + 1)] <- ifelse((is.null(outer_inf) || outer_inf), Inf, -Inf) if(tail(order_count_method, 1) == "bycount") { if (nrow(group_data) > 1) { - browser() group_data[ (outer_nest_rows + 1): nrow(group_data), paste0("ord_layer_", final_col + 1)] <- get_data_order_bycount(filtered_numeric_data, @@ -808,31 +810,35 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { numeric_cutoff_stat = numeric_cutoff_stat, numeric_cutoff_column = numeric_cutoff_column, nested = TRUE) - } } else if(tail(order_count_method, 1) == "byvarn") { - - varn_df <- get_varn_values(target, target_var[[1]]) - - group_data[ - (outer_nest_rows + 1): nrow(group_data), - paste0("ord_layer_", final_col + 1) - ] <- get_data_order_byvarn(filtered_group_data, - varn_df, - target_var[[1]], - length(by) + 1, - indentation, - total_row_sort_value = total_row_sort_value, - missing_subjects_sort_value = missing_subjects_sort_value) - } else { - group_row_count <- nrow(group_data[(outer_nest_rows + 1): nrow(group_data),]) - # Logic for group_row_count is when numeric_where values cause unexpected results - group_data[ - (outer_nest_rows + 1): nrow(group_data), - paste0("ord_layer_", final_col + 1) - ] <- 1:ifelse(group_row_count == 0, 1, group_row_count) - - # missing_subjects_row_label not passing in here - missing_rows <- group_data[[paste0('row_label', final_col+1)]] == paste0(indentation, missing_subjects_row_label) - group_data[missing_rows, paste0("ord_layer_", final_col + 1)] <- missing_subjects_sort_value + } + + } else if(tail(order_count_method, 1) == "byvarn") { + + varn_df <- get_varn_values(target, target_var[[1]]) + + group_data[ + (outer_nest_rows + 1): nrow(group_data), + paste0("ord_layer_", final_col + 1) + ] <- get_data_order_byvarn(filtered_group_data, + varn_df, + target_var[[1]], + length(by) + 1, + indentation, + total_row_sort_value = total_row_sort_value, + missing_subjects_sort_value = missing_subjects_sort_value) + } else { + group_row_count <- nrow(group_data[(outer_nest_rows + 1): nrow(group_data),]) + # Logic for group_row_count is when numeric_where values cause unexpected results + group_data[ + (outer_nest_rows + 1): nrow(group_data), + paste0("ord_layer_", final_col + 1) + ] <- 1:ifelse(group_row_count == 0, 1, group_row_count) + + # missing_subjects_row_label not passing in here + if (!is.null(missing_subjects_sort_value)) { + missing_rows <- group_data[[paste0('row_label', final_col+1)]] == paste0(indentation, missing_subjects_row_label) + group_data[missing_rows, paste0("ord_layer_", final_col + 1)] <- missing_subjects_sort_value + } } group_data diff --git a/tests/testthat/_snaps/count.md b/tests/testthat/_snaps/count.md index 6045b796..01d31a37 100644 --- a/tests/testthat/_snaps/count.md +++ b/tests/testthat/_snaps/count.md @@ -615,3 +615,27 @@ var1_54_F var1_54_M var1_81_F var1_81_M 1 27 (54.0) [50] 23 (67.6) [34] 17 (42.5) [40] 26 (59.1) [44] +# Error checking for add_missing_subjects_row() + + Argument `fmt` does not inherit "f_str". Classes: character + +--- + + Argument `sort_value` does not inherit "numeric". Classes: character + +--- + + Argument `e` does not inherit "count_layer". Classes: tplyr_layer, desc_layer, environment + +--- + + Argument `missing_subjects_row_label` must be character. Instead a class of "numeric" was passed. + +--- + + length(missing_subjects_row_label) not equal to 1 + +--- + + Argument `e` does not inherit "count_layer". Classes: tplyr_layer, desc_layer, environment + diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index f8219061..c8fc41ce 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -1077,6 +1077,7 @@ test_that("Missing counts on nested count layers function correctly", { expect_equal(nrow(x %>% filter(row_label2 == " Missing")), 1) expect_equal(tail(x, 1)$ord_layer_2, Inf) + # Verify that bycount works for missing values and sort value is assigned correctly x <- tplyr_table(tplyr_adae, TRTA) %>% set_pop_data(tplyr_adsl) %>% set_pop_treat_var(TRT01A) %>% @@ -1086,8 +1087,21 @@ test_that("Missing counts on nested count layers function correctly", { set_order_count_method("bycount") %>% set_ordering_cols("Xanomeline High Dose") %>% set_result_order_var(distinct_n) %>% - add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = Inf) + add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = 99999) + ) %>% + build() + + expect_equal(tail(x, 1)$ord_layer_2, 99999) + + # Also test that label reassignment flows + x <- tplyr_table(tplyr_adsl, TRT01A) %>% + add_layer( + group_count(vars(SEX, RACE)) %>% + set_order_count_method(c("byfactor", "byvarn")) %>% + add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = 99999) %>% + set_missing_subjects_row_label("New label") ) %>% build() + expect_equal(filter(x, row_label2 == " New label")$ord_layer_2, c(99999, 99999)) }) From dc2e92c49e2e4bad0d3810a9b5b3638e82ab8fee Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 9 Feb 2024 17:28:10 +0000 Subject: [PATCH 67/83] R CMD check updates --- R/count_bindings.R | 15 +++++++++++---- R/zzz.R | 3 ++- man/add_missing_subjects_row.Rd | 10 ++++++++-- man/set_missing_subjects_row_label.Rd | 4 ++-- vignettes/denom.Rmd | 26 ++++++++++++++++++++++++++ 5 files changed, 49 insertions(+), 9 deletions(-) diff --git a/R/count_bindings.R b/R/count_bindings.R index 1eb1ddcb..bc86aa84 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -714,8 +714,15 @@ set_numeric_threshold <- function(e, numeric_cutoff, stat, column = NULL) { #' Add a missing subject row into a count summary. #' -#' -#' @param e A \code{count_layer} object +#' This function calculates the number of subjects missing from a particular +#' group of results. The calculation is done by examining the total number of +#' subjects potentially available from the Header N values within the result +#' column, and finding the difference with the total number of subjects present +#' in the result group. Note that for accurate results, the subject variable +#' needs to be defined using the `set_distinct_by()` function. As with other +#' methods, this function instructs how distinct results should be identified. +#' +#' @param e A `count_layer` object #' @param fmt An f_str object used to format the total row. If none is provided, #' display is based on the layer formatting. #' @param sort_value The value that will appear in the ordering column for total @@ -748,7 +755,7 @@ add_missing_subjects_row <- function(e, fmt = NULL, sort_value = NULL) { #' Set the label for the missing subjects row #' #' @param e A \code{count_layer} object -#' @param total_row_label A character to label the total row +#' @param missing_subjects_row_label A character to label the total row #' #' @return The modified \code{count_layer} object #' @export @@ -759,7 +766,7 @@ add_missing_subjects_row <- function(e, fmt = NULL, sort_value = NULL) { #' add_layer( #' group_count(cyl) %>% #' add_missing_subjects_row() %>% -#' set_missing_subjects_label("Missing") +#' set_missing_subjects_row_label("Missing") #' ) #' build(t) set_missing_subjects_row_label <- function(e, missing_subjects_row_label) { diff --git a/R/zzz.R b/R/zzz.R index b7c53fba..5b1989d4 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -314,4 +314,5 @@ missing_subject_vars_ord <- NULL string_ms <- NULL missing_subjects_sort_value <- NULL limit_data_by <- NULL - +n_present <- NULL +header_tots <- NULL diff --git a/man/add_missing_subjects_row.Rd b/man/add_missing_subjects_row.Rd index cfb873d7..55769f5a 100644 --- a/man/add_missing_subjects_row.Rd +++ b/man/add_missing_subjects_row.Rd @@ -7,7 +7,7 @@ add_missing_subjects_row(e, fmt = NULL, sort_value = NULL) } \arguments{ -\item{e}{A \code{count_layer} object} +\item{e}{A `count_layer` object} \item{fmt}{An f_str object used to format the total row. If none is provided, display is based on the layer formatting.} @@ -16,7 +16,13 @@ display is based on the layer formatting.} rows. This must be a numeric value.} } \description{ -Add a missing subject row into a count summary. +This function calculates the number of subjects missing from a particular +group of results. The calculation is done by examining the total number of +subjects potentially available from the Header N values within the result +column, and finding the difference with the total number of subjects present +in the result group. Note that for accurate results, the subject variable +needs to be defined using the `set_distinct_by()` function. As with other +methods, this function instructs how distinct results should be identified. } \examples{ diff --git a/man/set_missing_subjects_row_label.Rd b/man/set_missing_subjects_row_label.Rd index ed75af9e..bcc943a1 100644 --- a/man/set_missing_subjects_row_label.Rd +++ b/man/set_missing_subjects_row_label.Rd @@ -9,7 +9,7 @@ set_missing_subjects_row_label(e, missing_subjects_row_label) \arguments{ \item{e}{A \code{count_layer} object} -\item{total_row_label}{A character to label the total row} +\item{missing_subjects_row_label}{A character to label the total row} } \value{ The modified \code{count_layer} object @@ -23,7 +23,7 @@ t <- tplyr_table(mtcars, gear) \%>\% add_layer( group_count(cyl) \%>\% add_missing_subjects_row() \%>\% - set_missing_subjects_label("Missing") + set_missing_subjects_row_label("Missing") ) build(t) } diff --git a/vignettes/denom.Rmd b/vignettes/denom.Rmd index af221fa5..18d2a9c9 100644 --- a/vignettes/denom.Rmd +++ b/vignettes/denom.Rmd @@ -233,6 +233,32 @@ t %>% We did one more other thing worth explaining in the example above - gave the missing count its own sort value. If you leave this field null, it will simply be the maximum value in the order layer plus 1, to put the Missing counts at the bottom during an ascending sort. But tables can be sorted a lot of different ways, as you'll see in the sort vignette. So instead of trying to come up with novel ways for you to control where the missing row goes - we decided to just let you specify your own value. +## Missing Subjects + +Missing counts and counting missing subjects work two different ways within Tplyr. Missing counts, as described above, will examine the records present in the data and collect and missing values. But for these results to be counted, they need to first be provided within the input data itself. On the other hand, missing subjects are calculated by looking at the difference between the potential number of subjects within the column (i.e. the combination of the treatment variables and column variables) and the number of subjects actually present. Consider this example: + +```{r missing_subs1} + missing_subs <- tplyr_table(tplyr_adae, TRTA) %>% + set_pop_data(tplyr_adsl) %>% + set_pop_treat_var(TRT01A) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD)) %>% + set_nest_count(TRUE) %>% + set_distinct_by(USUBJID) %>% + add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = Inf) %>% + set_missing_subjects_row_label("Missing Subjects") + ) %>% + build() + + tail(missing_subs) %>% + select(-starts_with('ord')) %>% + kable() +``` + +In the example above, we produce a nested count layer. Using the function `add_missing_subjects_row()`. This triggers the addition of the new result row for which the missing subjects are calculated. The row label applied for this can be configured using `set_missing_subjects_row_label()`, and the row label itself will default for Missing. Depending on your sorting needs, a `sort_value` can be applied to whatever numeric value you provide. Lastly, you can provide an `f_str()` to format the missing subjects row separately from the rest of the layer, but whatever format is applied to the layer will apply otherwise. + +Note that in nested count layers, missing subject rows will generate for each independent group within the outer layer. Outer layers cannot have missing subject rows calculated individually. This would best be done in an independent layer itself, as the result would apply to the whole input target dataset. + ## Adding a 'Total' Row In addition to missing counts, some summaries require the addition of a 'Total' row. **Tplyr** has the helper function `add_total_row()` to ease this process for you. Like most other things within **Tplyr** - particularly in this vignette - this too has a significant bit of nuance to it. From 8d70c50be433d0bcaac2cdeb623170c73f8ac003 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 12 Feb 2024 19:03:14 +0000 Subject: [PATCH 68/83] Update comments --- vignettes/denom.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/denom.Rmd b/vignettes/denom.Rmd index 18d2a9c9..cb657c4e 100644 --- a/vignettes/denom.Rmd +++ b/vignettes/denom.Rmd @@ -255,7 +255,7 @@ Missing counts and counting missing subjects work two different ways within Tply kable() ``` -In the example above, we produce a nested count layer. Using the function `add_missing_subjects_row()`. This triggers the addition of the new result row for which the missing subjects are calculated. The row label applied for this can be configured using `set_missing_subjects_row_label()`, and the row label itself will default for Missing. Depending on your sorting needs, a `sort_value` can be applied to whatever numeric value you provide. Lastly, you can provide an `f_str()` to format the missing subjects row separately from the rest of the layer, but whatever format is applied to the layer will apply otherwise. +In the example above, we produce a nested count layer. The function `add_missing_subjects_row()` triggers the addition of the new result row for which the missing subjects are calculated. The row label applied for this can be configured using `set_missing_subjects_row_label()`, and the row label itself will default to 'Missing'. Depending on your sorting needs, a `sort_value` can be applied to whatever numeric value you provide. Lastly, you can provide an `f_str()` to format the missing subjects row separately from the rest of the layer, but whatever format is applied to the layer will apply otherwise. Note that in nested count layers, missing subject rows will generate for each independent group within the outer layer. Outer layers cannot have missing subject rows calculated individually. This would best be done in an independent layer itself, as the result would apply to the whole input target dataset. From b261356f15b9830ee28c23f1f89ae5e54f79d091 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Tue, 13 Feb 2024 19:45:21 +0000 Subject: [PATCH 69/83] PR review comments. --- R/count.R | 1 - R/desc.R | 16 ---------------- 2 files changed, 17 deletions(-) diff --git a/R/count.R b/R/count.R index c896a930..49a6e15f 100644 --- a/R/count.R +++ b/R/count.R @@ -108,7 +108,6 @@ process_summaries.count_layer <- function(x, ...) { process_count_denoms(x) - outer <- FALSE process_single_count_target(x) } diff --git a/R/desc.R b/R/desc.R index 829da546..40e36686 100644 --- a/R/desc.R +++ b/R/desc.R @@ -59,22 +59,6 @@ process_summaries.desc_layer <- function(x, ...) { ungroup() num_sums_raw[[i]] <- complete_and_limit(cmplt1, treat_var, by, cols, limit_data_by=limit_data_by) - # num_sums_raw[[i]] <- cmplt1 %>% - # # complete all combinations of factors to include combinations that don't exist. - # # add 0 for combinations that don't exist - # complete(!!treat_var, !!!by, !!!cols) - # - # # Apply data limits specified by setter - # if (exists("limit_data_by")) { - # # Find the combinations actually in the data - # groups_in_data <- cmplt1 %>% - # distinct(!!!limit_data_by) - # - # # Join back to limit the completed levels based on the preferred - # # data driven ones - # num_sums_raw[[i]] <- groups_in_data %>% - # left_join(num_sums_raw[[i]], by = map_chr(limit_data_by, as_name)) - # } # Create the transposed summary data to prepare for formatting trans_sums[[i]] <- num_sums_raw[[i]] %>% From bd85990f8dfb330f41c854522e0efeb574fe45af Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Wed, 14 Feb 2024 14:58:58 +0000 Subject: [PATCH 70/83] Documentation updates, news updates, and cran comments updates --- DESCRIPTION | 6 +++++- NEWS.md | 15 +++++++++++++++ R/layer_templates.R | 2 +- cran-comments.md | 4 ++-- man/Tplyr.Rd | 3 +++ man/layer_templates.Rd | 2 +- 6 files changed, 27 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index df6307f1..f12f07c9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: Tplyr Title: A Traceability Focused Grammar of Clinical Data Summary -Version: 1.1.0.9000 +Version: 1.2.0 Authors@R: c( person(given = "Eli", @@ -34,6 +34,10 @@ Authors@R: family = "Chen", email = "shiyu.chen@atorusresearch.com", role = "ctb"), + person(given = "Oleksii", + family = "Mikryukov", + email = "alex.mikryukov@atorusresearch.com", + role = "ctb"), person(given = "Atorus Research LLC", role = "cph") ) diff --git a/NEWS.md b/NEWS.md index 2482e4c0..35608b85 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,18 @@ +# Tplyr 1.2.0 +- Resolve #62 Add data vignette data into the package (thanks for the suggestion @thebioengineer) +- Resolve #74 Add an example of piping in set_pop_data +- Resolve #83 Add the `add_missing_subjects()` function +- Resolve #84 Add `set_limit_data_by()` function +- Resolve #111, #148 Allow ellipsis argument unpacking outside of `add_layer()` +- Resolve #129 Add `collapse_row_labels()` function +- Resolve #134 Clarify how population data works to trigger denominators +- Resolve #75, #146, #166 Fix nested count layer handling where one inner layer value exists in multiple outer layer groups +- Resolve #21, #152 Fix handling of Inf, -Inf in desc layer for min and max +- Resolve #154 Fix namespace scoping for execution of Tplyr tables within non-global environments +- Resolve #155 Dead code clean-up +- Resolve #170 Add `replace_leading_whitespace()` post-processing function +- Resolve #173 Fix nested count layer sort variable behavior when using by variables + # Tplyr 1.1.0 - This release incorporate parenthesis hugging across all layers (#117) - New functions `apply_conditional_formats()`, `str_extract_fmt_group()` and `str_extract_num()` diff --git a/R/layer_templates.R b/R/layer_templates.R index 3de3c246..ad0e8865 100644 --- a/R/layer_templates.R +++ b/R/layer_templates.R @@ -177,7 +177,7 @@ get_layer_templates <- function() { #' target, by, and where parameters. #' @param add_params Additional parameters passed into layer modifier functions. #' These arguments are specified in a template within curly brackets such as -#' {param}. Supply as a named list, where the element name is the parameter. +#' \{param\}. Supply as a named list, where the element name is the parameter. #' #' @family Layer Templates #' @rdname layer_templates diff --git a/cran-comments.md b/cran-comments.md index 00720ad0..b9156a36 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,5 +1,5 @@ -## Submission 1.0.2 -* Bug fix identified in Tplyr 1.0.1 +## Submission 1.2.0 +* Several bug fixes and the addition of new functions `add_missing_subjects()`, `set_limit_data_by()`, `collapse_row_labels()`, and `replace_leading_whitespace()` ## Test Environments diff --git a/man/Tplyr.Rd b/man/Tplyr.Rd index 1a923391..06706f33 100644 --- a/man/Tplyr.Rd +++ b/man/Tplyr.Rd @@ -125,6 +125,9 @@ Other contributors: \itemize{ \item Nathan Kosiba \email{Nathan.Kosiba@atorusresearch.com} (\href{https://orcid.org/0000-0001-5359-4234}{ORCID}) [contributor] \item Sadchla Mascary \email{sadchla.mascary@atorusresearch.com} [contributor] + \item Andrew Bates \email{andrew.bates@atorusresearch.com} [contributor] + \item Shiyu Chen \email{shiyu.chen@atorusresearch.com} [contributor] + \item Oleksii Mikryukov \email{alex.mikryukov@atorusresearch.com} [contributor] \item Atorus Research LLC [copyright holder] } diff --git a/man/layer_templates.Rd b/man/layer_templates.Rd index 329003dc..ff17203e 100644 --- a/man/layer_templates.Rd +++ b/man/layer_templates.Rd @@ -30,7 +30,7 @@ target, by, and where parameters.} \item{add_params}{Additional parameters passed into layer modifier functions. These arguments are specified in a template within curly brackets such as -{param}. Supply as a named list, where the element name is the parameter.} +\{param\}. Supply as a named list, where the element name is the parameter.} } \description{ There are several scenarios where a layer template may be useful. Some From e08ceeaa8b44ed32fd16ea9bd54ac876f862caa6 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Wed, 14 Feb 2024 15:18:35 +0000 Subject: [PATCH 71/83] link fix --- vignettes/metadata.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/metadata.Rmd b/vignettes/metadata.Rmd index f68f1a69..b36b4e84 100644 --- a/vignettes/metadata.Rmd +++ b/vignettes/metadata.Rmd @@ -134,7 +134,7 @@ cat(c("tplyr_adsl %>%\n", So we get get metadata around a result cell, and we can get the exact results from a result cell. You just need a row ID and a column name. But - what does that get you? You can query your tables - and that's great. But how do you _use_ that. -The idea behind this is really to support [Shiny](https://shiny.rstudio.com/). Consider this minimal application. Click any of the result cells within the table and see what happens. +The idea behind this is really to support [Shiny](https://shiny.posit.co/). Consider this minimal application. Click any of the result cells within the table and see what happens. ```{r, out.width=850, out.extra='style="border: 1px solid #464646;" allowfullscreen="" allow="autoplay"', echo=FALSE} From 10f09a1282203a085247a79f0ca5d4b23d7de139 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Wed, 14 Feb 2024 15:21:18 +0000 Subject: [PATCH 72/83] ignore scratch file --- .Rbuildignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.Rbuildignore b/.Rbuildignore index dbb90f3a..9c3045a1 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -23,3 +23,4 @@ ^Jenkinsfile$ ^rsconnect$ ^data-raw$ +^scratch.R$ From 806f9a0a103059542437632f5977cc1e8ded2652 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Wed, 14 Feb 2024 15:27:50 +0000 Subject: [PATCH 73/83] update CRAN comments. --- cran-comments.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cran-comments.md b/cran-comments.md index b9156a36..26a668e8 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -3,7 +3,7 @@ ## Test Environments -* Local Ubuntu 18.04.4 devtools::check +* Local Ubuntu 22.04.3 devtools::check * Latest Ubuntu CI with latest tidyverse * Github release action with windows, linux, and osx check * RHub Check From eca35a10c9ee9a933a2ea09bd17ef917f5e8ff05 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 15 Feb 2024 22:12:11 +0000 Subject: [PATCH 74/83] handling of metadata for missing subject rows --- NAMESPACE | 1 + R/count_bindings.R | 7 +++ R/meta-builders.R | 38 ++++++++++++--- R/meta.R | 89 +++++++++++++++++++++++++++++++++- R/meta_utils.R | 71 ++++++++++++++++++++++----- man/add_anti_join.Rd | 46 ++++++++++++++++++ man/get_meta_subset.Rd | 1 + tests/testthat/_snaps/count.md | 6 +++ tests/testthat/_snaps/meta.md | 27 ++++++++++- tests/testthat/test-count.R | 19 +++++--- tests/testthat/test-meta.R | 84 ++++++++++++++++++++++++++++++++ 11 files changed, 358 insertions(+), 31 deletions(-) create mode 100644 man/add_anti_join.Rd diff --git a/NAMESPACE b/NAMESPACE index c1e7f2a4..b3b291b0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,6 +44,7 @@ S3method(str,tplyr_table) export("%>%") export("header_n<-") export("pop_data<-") +export(add_anti_join) export(add_column_headers) export(add_filters) export(add_layer) diff --git a/R/count_bindings.R b/R/count_bindings.R index bc86aa84..4dd1603c 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -745,6 +745,13 @@ add_missing_subjects_row <- function(e, fmt = NULL, sort_value = NULL) { } assert_inherits_class(e, "count_layer") + if (identical(env_get(env_parent(e), 'target'), env_get(env_parent(e), 'pop_data'))) { + warning(paste("\tPopulation data was not set separately from the target data.", + "\tMissing subject counts may be misleading in this scenario.", + "\tDid you mean to use `set_missing_count() instead?", + sep="\n")) + } + env_bind(e, include_missing_subjects_row = TRUE) env_bind(e, missing_subjects_count_format = fmt) env_bind(e, missing_subjects_sort_value = sort_value) diff --git a/R/meta-builders.R b/R/meta-builders.R index 601ba14e..3cae0b2a 100644 --- a/R/meta-builders.R +++ b/R/meta-builders.R @@ -94,6 +94,7 @@ build_count_meta <- function(layer, table_where, layer_where, treat_grps, summar # The total row label may not pass through, so set it total_row_label <- ifelse(is.null(layer$total_row_label), 'Total', layer$total_row_label) + missing_subjects_row_label <- ifelse(is.null(layer$total_row_label), 'Missing', layer$missing_subjects_row_label) count_missings <- ifelse(is.null(layer$count_missings), FALSE, layer$count_missings) mlist <- layer$missing_count_list @@ -101,6 +102,9 @@ build_count_meta <- function(layer, table_where, layer_where, treat_grps, summar character_outer <- get_character_outer(layer) unnested_character <- is_unnested_character(layer) + # Pull out table object to use later + tbl <- env_parent(layer) + meta <- vector('list', length(values[[1]])) # Vectorize across the input data @@ -113,6 +117,7 @@ build_count_meta <- function(layer, table_where, layer_where, treat_grps, summar } row_filter <- list() + aj <- NULL # Pull out the current row's values cur_values <- map(values, ~ .x[i]) @@ -130,21 +135,26 @@ build_count_meta <- function(layer, table_where, layer_where, treat_grps, summar if (summary_var[i] == total_row_label && !count_missings) { # Filter out the missing counts if the total row should exclude missings row_filter <- make_parsed_strings(layer$target_var, list(mlist), negate=TRUE) - } - else if (summary_var[i] %in% names(mlist)) { + } else if (summary_var[i] == missing_subjects_row_label) { + # Special handling for missing subject rows + # Make a meta object for the pop data + pop_filt_inds <- which(filter_variables %in% unlist(list(tbl$treat_var, tbl$cols))) + pop_filt_vars <- filter_variables[pop_filt_inds] + pop_filt_vals <- filter_values[pop_filt_inds] + pop_meta <- build_meta(tbl$pop_where, quo(TRUE), treat_grps, pop_filt_vars, pop_filt_vals) + aj <- new_anti_join(join_meta=pop_meta, on=layer$distinct_by) + } else if (summary_var[i] %in% names(mlist)) { # Get the values for the missing row miss_val <- mlist[which(names(mlist) == summary_var[i])] row_filter <- make_parsed_strings(layer$target_var, list(miss_val)) - } - else if (summary_var[i] != total_row_label) { + } else if (summary_var[i] != total_row_label) { # Subset to outer layer value row_filter <- make_parsed_strings(na_var, summary_var[i]) } add_vars <- append(add_vars, na_var) - } - else { + } else { # Inside the nested layer filter_variables <- variables filter_values <- cur_values @@ -162,6 +172,18 @@ build_count_meta <- function(layer, table_where, layer_where, treat_grps, summar else if (summary_var[i] == total_row_label && !count_missings) { # Filter out the missing counts if the total row should exclude missings row_filter <- make_parsed_strings(layer$target_var, list(mlist), negate=TRUE) + } else if (summary_var[i] == missing_subjects_row_label) { + # Special handling for missing subject rows + # Make a meta object for the pop data + pop_filt_inds <- which(filter_variables %in% unlist(list(tbl$treat_var, tbl$cols))) + pop_filt_vars <- filter_variables[pop_filt_inds] + pop_filt_vals <- filter_values[pop_filt_inds] + # Reset to the pop treat value + pop_filt_vars[[ + which(map_chr(pop_filt_vars, as_label) == as_label(tbl$treat_var)) + ]] <- tbl$pop_treat_var + pop_meta <- build_meta(tbl$pop_where, quo(TRUE), treat_grps, pop_filt_vars, pop_filt_vals) + aj <- new_anti_join(join_meta=pop_meta, on=layer$distinct_by) } else if (!is.na(character_outer) && summary_var[i] == character_outer) { # If the outer layer is a character string then don't provide a filter @@ -176,8 +198,8 @@ build_count_meta <- function(layer, table_where, layer_where, treat_grps, summar # Make the meta object meta[[i]] <- build_meta(table_where, layer_where, treat_grps, filter_variables, filter_values) %>% add_filters_(row_filter) %>% - add_variables_(add_vars) - + add_variables_(add_vars) %>% + add_anti_join_(aj) } meta diff --git a/R/meta.R b/R/meta.R index 78ccaa2f..e3c2d0c1 100644 --- a/R/meta.R +++ b/R/meta.R @@ -221,8 +221,93 @@ print.tplyr_meta <- function(x, ...) { cat("Names:\n") names <- map_chr(x$names, as_label) filters <- map_chr(x$filters, as_label) - cat(" ", paste(names, collapse = ", "), "\n") + cat(" ", paste0(names, collapse = ", "), "\n") cat("Filters:\n") - cat(" ", paste(filters, collapse = ", "), "\n") + cat(" ", paste0(filters, collapse = ", "), "\n") + if (!is.null(x$anti_join)) { + cat("Anti-join:\n") + cat(" Join Meta:\n") + cat(paste0(" ", capture.output(x$anti_join$join_meta), "\n"), sep="") + cat(" On:\n") + aj_on <- map_chr(x$names, as_label) + cat(" ", paste0(aj_on, collapse = ", "), "\n") + } invisible() } + +#' Create an tplyr_meta_anti_join object +#' +#' @return tplyr_meta_anti_join object +#' @noRd +new_anti_join <- function(join_meta, on) { + structure( + list( + join_meta = join_meta, + on = on + ), + class="tplyr_meta_anti_join" + ) +} + +#' Internal application of anti_join onto tplyr_meta object +#' @noRd +add_anti_join_ <- function(meta, aj) { + meta$anti_join <- aj + meta +} + +#' Add an anti-join onto a tplyr_meta object +#' +#' An anti-join allows a tplyr_meta object to refer to data that should be +#' extract from a separate dataset, like the population data of a Tplyr table, +#' that is unavailable in the target dataset. The primary use case for this is +#' the presentation of missing subjects, which in a Tplyr table is presented +#' using the function `add_missing_subjects_row()`. The missing subjects +#' themselves are not present in the target data, and are thus only available in +#' the population data. The `add_anti_join()` function allows you to provide the +#' meta information relevant to the population data, and then specify the `on` +#' variable that should be used to join with the target dataset and find the +#' values present in the population data that are missing from the target data. +#' +#' @param meta A tplyr_meta object referring to the target data +#' @param join_meta A tplyr_meta object referring to the population data +#' @param on A list of quosures containing symbols - most likely set to USUBJID. +#' +#' @return A tplyr_meta object +#' @md +#' @export +#' +#' @examples +#' +#' tm <- tplyr_meta( +#' quos(TRT01A, SEX, ETHNIC, RACE), +#' quos(TRT01A == "Placebo", TRT01A == "SEX", ETHNIC == "HISPANIC OR LATINO") +#' ) +#' +#' tm %>% +#' add_anti_join( +#' tplyr_meta( +#' quos(TRT01A, ETHNIC), +#' quos(TRT01A == "Placebo", ETHNIC == "HISPANIC OR LATINO") +#' ), +#' on = quos(USUBJID) +#' ) +add_anti_join <- function(meta, join_meta, on){ + + if (!inherits(meta, 'tplyr_meta')) { + stop("meta must be a tplyr_meta object", call.=FALSE) + } + + if (!inherits(join_meta, 'tplyr_meta')) { + stop("join_meta must be a tplyr_meta object", call.=FALSE) + } + + if (!all(map_lgl(on, ~ is_quosure(.) && quo_is_symbol(.)))) { + stop("on must be provided as a list of names", call.=FALSE) + } + + + aj <- new_anti_join(join_meta, on) + + add_anti_join_(meta, aj) +} diff --git a/R/meta_utils.R b/R/meta_utils.R index fabbbcbd..e3a29bd5 100644 --- a/R/meta_utils.R +++ b/R/meta_utils.R @@ -54,7 +54,7 @@ get_meta_result <- function(x, row_id, column, ...) { get_meta_result.tplyr_table <- function(x, row_id, column, ...) { m <- x$metadata - get_meta_result.data.frame(m, row_id, column) + get_meta_result.data.frame(m, row_id, column, ...) } #' @export @@ -69,6 +69,10 @@ get_meta_result.data.frame <- function(x, row_id, column, ...) { 'column present in the built Tplyr dataframe'), call.=FALSE) } + if (length(list(...)) > 0) { + warning("Extra arguments were provided to get_meta_result() that will not be used.", immediate.=TRUE) + } + # Pull out the cell of interest res <- x[[which(x$row_id == row_id), column]][[1]] @@ -139,7 +143,8 @@ get_meta_subset <- function(x, row_id, column, add_cols = vars(USUBJID), ...) { #' @export #' @rdname get_meta_subset get_meta_subset.data.frame <- function(x, row_id, column, - add_cols = vars(USUBJID), target = NULL, ...) { + add_cols = vars(USUBJID), + target = NULL, pop_data = NULL, ...) { # Get the metadata object ready m <- get_meta_result(x, row_id, column) @@ -152,9 +157,33 @@ get_meta_subset.data.frame <- function(x, row_id, column, stop("If querying metadata without a tplyr_table, a target must be provided", call.=FALSE) } - target %>% + if (length(list(...)) > 0) { + warning("Extra arguments were provided to get_meta_subset() that will not be used.") + } + + out <- target %>% filter(!!!m$filters) %>% select(!!!add_cols, !!!m$names) + + if (!is.null(m$anti_join)) { + aj <- m$anti_join + pd <- pop_data %>% + filter(!!!aj$join_meta$filters) %>% + select(!!!aj$on, !!!add_cols, !!!aj$join_meta$names) + + mrg_var <- map_chr(aj$on, as_name) + names(mrg_var) <- mrg_var + + if (!(mrg_var %in% names(pd)) | !(mrg_var %in% names(out))) { + stop(paste0( + "The `on` variable specified is missing from either the target data or the population data subsets.\n ", + "Try adding the `on` variables to the `add_cols` parameter") + ) + } + out <- anti_join(pd, out, by=mrg_var) + } + + out } #' @export @@ -164,13 +193,33 @@ get_meta_subset.tplyr_table <- function(x, row_id, column, add_cols = vars(USUBJ # Get the metadata object ready m <- get_meta_result(x, row_id, column) - if (!inherits(add_cols, 'quosures')) { - stop("add_cols must be provided using `dplyr::vars()`", call.=FALSE) - } - - # Subset and return the data - x$target %>% - filter(!!!m$filters) %>% - select(!!!add_cols, !!!m$names) + # if (!inherits(add_cols, 'quosures')) { + # stop("add_cols must be provided using `dplyr::vars()`", call.=FALSE) + # } + # + # if (length(list(...)) > 0) { + # warning("Extra arguments were provided to get_meta_subset() that will not be used.") + # } + + get_meta_subset(x$metadata, row_id, column, add_cols = add_cols, + target = x$target, pop_data = x$pop_data) + # # Subset and return the data + # out <- x$target %>% + # filter(!!!m$filters) %>% + # select(!!!add_cols, !!!m$names) + # + # if (!is.null(m$anti_join)) { + # aj <- m$anti_join + # pd <- X$pop_data %>% + # filter(!!!aj$join_meta$filters) %>% + # select(!!!aj$on, !!!add_cols, !!!aj$join_meta$names) + # + # mrg_var <- map_chr(aj$on, as_name) + # names(mrg_var) <- mrg_var + # + # out <- anti_join(pd, out, by=mrg_var) + # } + # + # out } diff --git a/man/add_anti_join.Rd b/man/add_anti_join.Rd new file mode 100644 index 00000000..37c3dc9f --- /dev/null +++ b/man/add_anti_join.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/meta.R +\name{add_anti_join} +\alias{add_anti_join} +\title{Add an anti-join onto a tplyr_meta object} +\usage{ +add_anti_join(meta, join_meta, on) +} +\arguments{ +\item{meta}{A tplyr_meta object referring to the target data} + +\item{join_meta}{A tplyr_meta object referring to the population data} + +\item{on}{A list of quosures containing symbols - most likely set to USUBJID.} +} +\value{ +A tplyr_meta object +} +\description{ +An anti-join allows a tplyr_meta object to refer to data that should be +extract from a separate dataset, like the population data of a Tplyr table, +that is unavailable in the target dataset. The primary use case for this is +the presentation of missing subjects, which in a Tplyr table is presented +using the function \code{add_missing_subjects_row()}. The missing subjects +themselves are not present in the target data, and are thus only available in +the population data. The \code{add_anti_join()} function allows you to provide the +meta information relevant to the population data, and then specify the \code{on} +variable that should be used to join with the target dataset and find the +values present in the population data that are missing from the target data. +} +\examples{ + +tm <- tplyr_meta( + quos(TRT01A, SEX, ETHNIC, RACE), + quos(TRT01A == "Placebo", TRT01A == "SEX", ETHNIC == "HISPANIC OR LATINO") +) + +tm \%>\% + add_anti_join( + tplyr_meta( + quos(TRT01A, ETHNIC), + quos(TRT01A == "Placebo", ETHNIC == "HISPANIC OR LATINO") + ), + on = quos(USUBJID) + ) +} diff --git a/man/get_meta_subset.Rd b/man/get_meta_subset.Rd index f8028394..e4374d4a 100644 --- a/man/get_meta_subset.Rd +++ b/man/get_meta_subset.Rd @@ -14,6 +14,7 @@ get_meta_subset(x, row_id, column, add_cols = vars(USUBJID), ...) column, add_cols = vars(USUBJID), target = NULL, + pop_data = NULL, ... ) diff --git a/tests/testthat/_snaps/count.md b/tests/testthat/_snaps/count.md index 01d31a37..a3c4c87d 100644 --- a/tests/testthat/_snaps/count.md +++ b/tests/testthat/_snaps/count.md @@ -639,3 +639,9 @@ Argument `e` does not inherit "count_layer". Classes: tplyr_layer, desc_layer, environment +# Missing counts on nested count layers function correctly + + Population data was not set separately from the target data. + Missing subject counts may be misleading in this scenario. + Did you mean to use `set_missing_count() instead? + diff --git a/tests/testthat/_snaps/meta.md b/tests/testthat/_snaps/meta.md index 19c02cb6..119c03c5 100644 --- a/tests/testthat/_snaps/meta.md +++ b/tests/testthat/_snaps/meta.md @@ -6,6 +6,14 @@ meta must be a tplyr_meta object +--- + + meta must be a tplyr_meta object + +--- + + join_meta must be a tplyr_meta object + --- Filters must be provided as a list of calls @@ -22,6 +30,10 @@ Names must be provided as a list of names +--- + + on must be provided as a list of names + # Metadata extraction and extension error properly t must be a tplyr_table object @@ -75,7 +87,18 @@ Output tplyr_meta: 3 names, 4 filters Names: - a, b, c + a, b, c Filters: - a == 1, b == 2, c == 3, x == "a" + a == 1, b == 2, c == 3, x == "a" + +# Anti-join extraction works properly + + Population data was not set separately from the target data. + Missing subject counts may be misleading in this scenario. + Did you mean to use `set_missing_count() instead? + +--- + + The `on` variable specified is missing from either the target data or the population data subsets. + Try adding the `on` variables to the `add_cols` parameter diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index c8fc41ce..546da515 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -1094,14 +1094,17 @@ test_that("Missing counts on nested count layers function correctly", { expect_equal(tail(x, 1)$ord_layer_2, 99999) # Also test that label reassignment flows - x <- tplyr_table(tplyr_adsl, TRT01A) %>% - add_layer( - group_count(vars(SEX, RACE)) %>% - set_order_count_method(c("byfactor", "byvarn")) %>% - add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = 99999) %>% - set_missing_subjects_row_label("New label") - ) %>% - build() + # The warning here is intentional + expect_snapshot_warning({ + x <- tplyr_table(tplyr_adsl, TRT01A) %>% + add_layer( + group_count(vars(SEX, RACE)) %>% + set_order_count_method(c("byfactor", "byvarn")) %>% + add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = 99999) %>% + set_missing_subjects_row_label("New label") + ) %>% + build() + }) expect_equal(filter(x, row_label2 == " New label")$ord_layer_2, c(99999, 99999)) }) diff --git a/tests/testthat/test-meta.R b/tests/testthat/test-meta.R index 3400c209..5650eebe 100644 --- a/tests/testthat/test-meta.R +++ b/tests/testthat/test-meta.R @@ -86,6 +86,8 @@ test_that("Metadata creation errors generate properly", { # Not providing metadata object expect_snapshot_error(add_variables(mtcars, quos(a))) expect_snapshot_error(add_filters(mtcars, quos(a==1))) + expect_snapshot_error(add_anti_join(mtcars, m, quos(a==1))) + expect_snapshot_error(add_anti_join(m, mtcars, quos(a==1))) # Didn't provide filter expect_snapshot_error(tplyr_meta(quos(a), 'x')) @@ -94,6 +96,7 @@ test_that("Metadata creation errors generate properly", { # Didn't provide names expect_snapshot_error(tplyr_meta('x')) expect_snapshot_error(add_variables(m, 'x')) + expect_snapshot_error(add_anti_join(m, m, 'x')) }) @@ -105,9 +108,12 @@ test_that("Exported metadata function construct metadata properly", { m <- add_variables(m, quos(x)) m <- add_filters(m, quos(x=="a")) + m2 <- add_anti_join(m, m, quos(y)) expect_equal(m$names, quos(a, b, c, x)) expect_equal(m$filters, quos(a==1, b==2, c==3, x=="a")) + expect_equal(m2$anti_join$join_meta, m) + expect_equal(m2$anti_join$on, quos(y)) }) test_that("Descriptive Statistics metadata backend assembles correctly", { @@ -352,3 +358,81 @@ test_that("Metadata print method is accurate", { x <- tplyr_meta(quos(a, b, c), quos(a==1, b==2, c==3, x=="a")) expect_snapshot(print(x)) }) + + +test_that("Anti-join extraction works properly", { + + # This is purposefully a convoluted warning that's unrealistic, hence the + # warning that's generating. + expect_snapshot_warning({ + t <- tplyr_table(tplyr_adsl, TRT01A, cols = ETHNIC) %>% + add_layer( + group_count(RACE, by = SEX) %>% + set_distinct_by(USUBJID) %>% + add_missing_subjects_row() + ) + }) + + x <- build(t, metadata=TRUE) + + # Check that the object looks right + res <- get_meta_result(t, 'c7_1', 'var1_Placebo_HISPANIC OR LATINO') + + expect_equal(unname(map_chr(res$names, as_label)), c("TRT01A", "SEX", "ETHNIC", "RACE")) + expect_equal( + unname(map_chr(res$filters, as_label)), + c("TRT01A == c(\"Placebo\")", "SEX == c(\"F\")", "ETHNIC == c(\"HISPANIC OR LATINO\")", + "TRUE", "TRUE") + ) + expect_equal(unname(map_chr(res$anti_join$join_meta$names, as_label)), c("TRT01A", "ETHNIC")) + expect_equal( + unname(map_chr(res$anti_join$join_meta$filters, as_label)), + c("TRT01A == c(\"Placebo\")", "ETHNIC == c(\"HISPANIC OR LATINO\")", "TRUE", "TRUE") + ) + expect_equal(as_label(res$anti_join$on[[1]]), "USUBJID") + + # Variables needed for the merge aren't there + expect_snapshot_error(get_meta_subset(t, 'c7_1', 'var1_Placebo_HISPANIC OR LATINO', add_cols = quos(SITEID))) + + + sbst <- get_meta_subset(t, 'c7_1', 'var1_Placebo_HISPANIC OR LATINO') + + + cmp <- tplyr_adsl %>% filter( + USUBJID == "01-701-1023" + ) + + # The counted subjects will include female, so this subject would have to be male + # Again - this is a weird example that wouldn't be used in practice, but this is the + # row variable + expect_true(cmp$SEX == "M") + # Since this is column, these would both match the metadata + expect_true(cmp$TRT01A == "Placebo") + expect_true(cmp$ETHNIC == "HISPANIC OR LATINO") + + # and then selecting out the columns these should match + expect_equal( + sbst, + cmp %>% + select(USUBJID, TRT01A, ETHNIC) + ) + + # Now for a real example, but also test for nested counts + t <- tplyr_table(tplyr_adae, TRTA) %>% + set_pop_data(tplyr_adsl) %>% + set_pop_treat_var(TRT01A) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD)) %>% + set_distinct_by(USUBJID) %>% + add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = Inf) + ) + + x <- build(t, metadata=TRUE) + + sbst <- get_meta_subset(t, 'c23_1', 'var1_Placebo') + + # If you manually check out x, the count here is 65 + expect_equal(nrow(sbst), 65) + expect_equal(unique(sbst$TRT01A), "Placebo") + +}) From edbbd81edd9307288902adb62f9477ab90a9f3ac Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Thu, 15 Feb 2024 22:12:21 +0000 Subject: [PATCH 75/83] cran submission --- .Rbuildignore | 1 + CRAN-SUBMISSION | 3 +++ 2 files changed, 4 insertions(+) create mode 100644 CRAN-SUBMISSION diff --git a/.Rbuildignore b/.Rbuildignore index 9c3045a1..c2d17038 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -24,3 +24,4 @@ ^rsconnect$ ^data-raw$ ^scratch.R$ +^CRAN-SUBMISSION$ diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION new file mode 100644 index 00000000..a964860a --- /dev/null +++ b/CRAN-SUBMISSION @@ -0,0 +1,3 @@ +Version: 1.2.0 +Date: 2024-02-14 17:07:48 UTC +SHA: 806f9a0a103059542437632f5977cc1e8ded2652 From 3da13c75e5bcfb12d1f2785569f70f8ad6e02a01 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 16 Feb 2024 19:46:13 +0000 Subject: [PATCH 76/83] Vignette, print test, and associated updates --- R/meta.R | 12 +++++----- R/meta_utils.R | 2 ++ man/add_anti_join.Rd | 10 ++++---- man/get_meta_subset.Rd | 3 +++ tests/testthat/_snaps/meta.md | 20 ++++++++++++++++ tests/testthat/test-meta.R | 18 ++++++++++++++ vignettes/custom-metadata.Rmd | 15 ++++++++++++ vignettes/metadata.Rmd | 45 +++++++++++++++++++++++++++++++++++ 8 files changed, 114 insertions(+), 11 deletions(-) diff --git a/R/meta.R b/R/meta.R index e3c2d0c1..0ed930a7 100644 --- a/R/meta.R +++ b/R/meta.R @@ -229,7 +229,7 @@ print.tplyr_meta <- function(x, ...) { cat(" Join Meta:\n") cat(paste0(" ", capture.output(x$anti_join$join_meta), "\n"), sep="") cat(" On:\n") - aj_on <- map_chr(x$names, as_label) + aj_on <- map_chr(x$anti_join$on, as_label) cat(" ", paste0(aj_on, collapse = ", "), "\n") } invisible() @@ -280,17 +280,17 @@ add_anti_join_ <- function(meta, aj) { #' @examples #' #' tm <- tplyr_meta( -#' quos(TRT01A, SEX, ETHNIC, RACE), -#' quos(TRT01A == "Placebo", TRT01A == "SEX", ETHNIC == "HISPANIC OR LATINO") +#' rlang::quos(TRT01A, SEX, ETHNIC, RACE), +#' rlang::quos(TRT01A == "Placebo", TRT01A == "SEX", ETHNIC == "HISPANIC OR LATINO") #' ) #' #' tm %>% #' add_anti_join( #' tplyr_meta( -#' quos(TRT01A, ETHNIC), -#' quos(TRT01A == "Placebo", ETHNIC == "HISPANIC OR LATINO") +#' rlang::quos(TRT01A, ETHNIC), +#' rlang::quos(TRT01A == "Placebo", ETHNIC == "HISPANIC OR LATINO") #' ), -#' on = quos(USUBJID) +#' on = rlang::quos(USUBJID) #' ) add_anti_join <- function(meta, join_meta, on){ diff --git a/R/meta_utils.R b/R/meta_utils.R index e3a29bd5..d951b857 100644 --- a/R/meta_utils.R +++ b/R/meta_utils.R @@ -113,6 +113,8 @@ get_meta_result.data.frame <- function(x, row_id, column, ...) { #' @param column The result column of interest, provided as a character string #' @param add_cols Additional columns to include in subset data.frame output #' @param target A data frame to be subset (if not pulled from a Tplyr table) +#' @param pop_data A data frame to be subset through an anti-join (if not pulled +#' from a Tplyr table) #' @param ... additional arguments #' #' @return A data.frame diff --git a/man/add_anti_join.Rd b/man/add_anti_join.Rd index 37c3dc9f..c6956075 100644 --- a/man/add_anti_join.Rd +++ b/man/add_anti_join.Rd @@ -31,16 +31,16 @@ values present in the population data that are missing from the target data. \examples{ tm <- tplyr_meta( - quos(TRT01A, SEX, ETHNIC, RACE), - quos(TRT01A == "Placebo", TRT01A == "SEX", ETHNIC == "HISPANIC OR LATINO") + rlang::quos(TRT01A, SEX, ETHNIC, RACE), + rlang::quos(TRT01A == "Placebo", TRT01A == "SEX", ETHNIC == "HISPANIC OR LATINO") ) tm \%>\% add_anti_join( tplyr_meta( - quos(TRT01A, ETHNIC), - quos(TRT01A == "Placebo", ETHNIC == "HISPANIC OR LATINO") + rlang::quos(TRT01A, ETHNIC), + rlang::quos(TRT01A == "Placebo", ETHNIC == "HISPANIC OR LATINO") ), - on = quos(USUBJID) + on = rlang::quos(USUBJID) ) } diff --git a/man/get_meta_subset.Rd b/man/get_meta_subset.Rd index e4374d4a..725892e0 100644 --- a/man/get_meta_subset.Rd +++ b/man/get_meta_subset.Rd @@ -33,6 +33,9 @@ string} \item{...}{additional arguments} \item{target}{A data frame to be subset (if not pulled from a Tplyr table)} + +\item{pop_data}{A data frame to be subset through an anti-join (if not pulled +from a Tplyr table)} } \value{ A data.frame diff --git a/tests/testthat/_snaps/meta.md b/tests/testthat/_snaps/meta.md index 119c03c5..3103c329 100644 --- a/tests/testthat/_snaps/meta.md +++ b/tests/testthat/_snaps/meta.md @@ -102,3 +102,23 @@ The `on` variable specified is missing from either the target data or the population data subsets. Try adding the `on` variables to the `add_cols` parameter +# Tplyr meta print method works as expected + + Code + print(meta2) + Output + tplyr_meta: 11 names, 5 filters + Names: + TRTP, EFFFL, ITTFL, ANL01FL, SITEGR1, AVISIT, AVISITN, PARAMCD, AVAL, BASE, CHG + Filters: + EFFFL == "Y", ITTFL == "Y", PARAMCD == "ACTOT", ANL01FL == "Y", AVISITN == 24 + Anti-join: + Join Meta: + tplyr_meta: 4 names, 2 filters + Names: + TRT01P, EFFFL, ITTFL, SITEGR1 + Filters: + EFFFL == "Y", ITTFL == "Y" + On: + USUBJID + diff --git a/tests/testthat/test-meta.R b/tests/testthat/test-meta.R index 5650eebe..a8b8e9b2 100644 --- a/tests/testthat/test-meta.R +++ b/tests/testthat/test-meta.R @@ -436,3 +436,21 @@ test_that("Anti-join extraction works properly", { expect_equal(unique(sbst$TRT01A), "Placebo") }) + +test_that("Tplyr meta print method works as expected", { + meta <- tplyr_meta( + names = quos(TRTP, EFFFL, ITTFL, ANL01FL, SITEGR1, AVISIT, AVISITN, PARAMCD, AVAL, BASE, CHG), + filters = quos(EFFFL == "Y", ITTFL == "Y", PARAMCD == "ACTOT", ANL01FL == "Y", AVISITN == 24) + ) + + meta2 <- meta %>% + add_anti_join( + join_meta = tplyr_meta( + names = quos(TRT01P, EFFFL, ITTFL, SITEGR1), + filters = quos(EFFFL == "Y", ITTFL == "Y") + ), + on = quos(USUBJID) + ) + + expect_snapshot(print(meta2)) +}) diff --git a/vignettes/custom-metadata.Rmd b/vignettes/custom-metadata.Rmd index 6e9f2fd2..108a6f05 100644 --- a/vignettes/custom-metadata.Rmd +++ b/vignettes/custom-metadata.Rmd @@ -159,6 +159,21 @@ When building a data frame for use with `tplyr_table` metadata, there are really The `row_id` values built by **Tplyr** will always follow the format "n_n", where the first letter of the layer type will either be "c", "d", or "s". The next number is the layer number (i.e. the order in which the layer was inserted to the **Tplyr** table), and then finally the row of that layer within the output. For example, the third row of a count layer that was the second layer in the table would have a `row_id` of "c2_3". In this example, I chose "x4_n" as the format for the "x" to symbolize custom, and these data can be thought of as the fourth layer. That said, these values would typically be masked by the viewer of the table so they really just need to be unique - so you can choose whatever you want. +### Anti-joins + +If the custom metadata you're constructing requires references to data outside your target dataset, this is also possible with a `tplyr_meta` object. If you're looking for non-overlap with the target dataset, you can use an anti-join. Anti-joins can be added to a `tplyr_meta` object using the `add_anti_join()` function. + + +```{r anti_join1} +meta %>% + add_anti_join( + join_meta = tplyr_meta( + names = quos(TRT01P, EFFFL, ITTFL, SITEGR1), + filters = quos(EFFFL == "Y", ITTFL == "Y") + ), + on = quos(USUBJID) + ) +``` ## Appending Existing **Tplyr** Metadata Now that we've created our custom extension of the **Tplyr** metadata, let's extend the existing data frame. To do this, **Tplyr** has the function `append_metadata()`: diff --git a/vignettes/metadata.Rmd b/vignettes/metadata.Rmd index b36b4e84..c41d9a2b 100644 --- a/vignettes/metadata.Rmd +++ b/vignettes/metadata.Rmd @@ -119,6 +119,51 @@ cat(c("tplyr_adsl %>%\n", )) ``` +### Anti Joins + +Most data presented within a table refers back to the target dataset from which data are being summarized. In some cases, data presented may refer to information _excluded_ from the summary. This is the case when you use the **Tplyr** function `add_missing_subjects_row()`. In this case, the counts presented refer to data excluded from the target which are present into the population data. The metadata thus need to refer to that excluded data. To handle this, there's an additional field called an 'Anti Join'. Consider this example: + +```{r anti_join1} +t <- tplyr_table(tplyr_adae, TRTA) %>% + set_pop_data(tplyr_adsl) %>% + set_pop_treat_var(TRT01A) %>% + add_layer( + group_count(vars(AEBODSYS, AEDECOD)) %>% + set_distinct_by(USUBJID) %>% + add_missing_subjects_row(f_str("xx (XX.x%)", distinct_n, distinct_pct), sort_value = Inf) + ) + +x <- build(t, metadata=TRUE) + +tail(x) %>% + select(starts_with('row'), var1_Placebo) %>% + kable() +``` + +The missing row in this example counts the subjects within their respective treatment groups who do *not* have any adverse events for the body system "SKIN AND SUBCUTANEOUS TISSUE DISORDERS". Here's what the metadata for the result for the Placebo treatment group looks like. + +```{r anti_join2} +m <- get_meta_result(t, 'c23_1', 'var1_Placebo') +m +``` + +This result has the addition field of 'Anti-join'. This element has two fields, which are the join metadata, and the "on" field, which specifies a merging variable to be used when "anti-joining" with the target data. The join metadata here refers to the data of interest from the population data. Note that while the metadata for the target data has variable names and filter conditions referring to AEBODSYS and AEDECOD, these variables are _not_ present within the join metadata, because that information is not present within the population data. + +While the usual joins we work with focus on the overlap between two sets, an anti-join looks at the non-overlap. The metadata provided here will specifically give us "The subjects within the Placebo treatment group who do **not** have an adverse event within the body system 'SKIN AND SUBCUTANEOUS TISSUE DISORDERS'". + +Extracting this metadata works very much the same way as extracting other results. + +```{r anti_join3} +head(get_meta_subset(t, 'c23_1', 'var1_Placebo')) +``` + +If you're not working with the `tplyr_table` object, then there's some additional information you need to provide to the function. + +```{r anti_join4} +head(get_meta_subset(t$metadata, 'c23_1', 'var1_Placebo', + target=t$target, pop_data=t$pop_data)) +``` + ``` ```{r to string content, results='asis', echo=FALSE} cat(c("tplyr_adsl %>%\n", From 0e354d329cf54ed42da6282ca55a6c3c6ebe2217 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 16 Feb 2024 19:55:57 +0000 Subject: [PATCH 77/83] Update pkgdown for new functions --- _pkgdown.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 8218614e..380b4141 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -62,7 +62,9 @@ reference: - add_total_row - add_total_group - add_risk_diff + - add_missing_subjects_row - set_total_row_label + - set_missing_subjects_row_label - title: Descriptive Statistics Layer Functions desc: Descriptive statistics layer helper functions - contents: @@ -84,6 +86,7 @@ reference: - set_denom_ignore - set_indentation - set_numeric_threshold + - set_limit_data_by - title: Column Headers desc: Column header helpers - contents: @@ -95,6 +98,7 @@ reference: - tplyr_meta - add_variables - add_filters + - add_anti_join - get_metadata - append_metadata - starts_with('get_meta') @@ -109,6 +113,7 @@ reference: - apply_formats - apply_row_masks - collapse_row_labels + - replace_leading_whitespace - str_extract_fmt_group - str_extract_num - str_indent_wrap @@ -130,6 +135,7 @@ reference: - tplyr_adas - tplyr_adlb - tplyr_adsl + - tplyr_adpe - get_data_labels articles: From caf45957c5c006a5dd418627fae49975901f1036 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Fri, 16 Feb 2024 19:56:31 +0000 Subject: [PATCH 78/83] Increment version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f12f07c9..fec79b17 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: Tplyr Title: A Traceability Focused Grammar of Clinical Data Summary -Version: 1.2.0 +Version: 1.2.1 Authors@R: c( person(given = "Eli", From a0cf280c5bbe223d5ae3de37c7cc35d8ffe4072a Mon Sep 17 00:00:00 2001 From: Michael Stackhouse Date: Mon, 19 Feb 2024 12:30:20 -0500 Subject: [PATCH 79/83] Update R/meta.R Co-authored-by: Eli Miller --- R/meta.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/meta.R b/R/meta.R index 0ed930a7..86da7d37 100644 --- a/R/meta.R +++ b/R/meta.R @@ -259,7 +259,7 @@ add_anti_join_ <- function(meta, aj) { #' Add an anti-join onto a tplyr_meta object #' #' An anti-join allows a tplyr_meta object to refer to data that should be -#' extract from a separate dataset, like the population data of a Tplyr table, +#' extracted from a separate dataset, like the population data of a Tplyr table, #' that is unavailable in the target dataset. The primary use case for this is #' the presentation of missing subjects, which in a Tplyr table is presented #' using the function `add_missing_subjects_row()`. The missing subjects From 1ec836d2551525ac63d1b11d65726c3512a10c5a Mon Sep 17 00:00:00 2001 From: Michael Stackhouse Date: Mon, 19 Feb 2024 12:30:29 -0500 Subject: [PATCH 80/83] Update vignettes/metadata.Rmd Co-authored-by: Eli Miller --- vignettes/metadata.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/metadata.Rmd b/vignettes/metadata.Rmd index c41d9a2b..abdf4e78 100644 --- a/vignettes/metadata.Rmd +++ b/vignettes/metadata.Rmd @@ -121,7 +121,7 @@ cat(c("tplyr_adsl %>%\n", ### Anti Joins -Most data presented within a table refers back to the target dataset from which data are being summarized. In some cases, data presented may refer to information _excluded_ from the summary. This is the case when you use the **Tplyr** function `add_missing_subjects_row()`. In this case, the counts presented refer to data excluded from the target which are present into the population data. The metadata thus need to refer to that excluded data. To handle this, there's an additional field called an 'Anti Join'. Consider this example: +Most data presented within a table refers back to the target dataset from which data are being summarized. In some cases, data presented may refer to information _excluded_ from the summary. This is the case when you use the **Tplyr** function `add_missing_subjects_row()`. In this case, the counts presented refer to data excluded from the target which are present in the population data. The metadata thus needs to refer to that excluded data. To handle this, there's an additional field called an 'Anti Join'. Consider this example: ```{r anti_join1} t <- tplyr_table(tplyr_adae, TRTA) %>% From 343f99e17a9219058ee44815f647610ec84e7978 Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 19 Feb 2024 17:36:00 +0000 Subject: [PATCH 81/83] Update PR comments --- R/meta_utils.R | 28 +--------------------------- 1 file changed, 1 insertion(+), 27 deletions(-) diff --git a/R/meta_utils.R b/R/meta_utils.R index d951b857..3d0fc36e 100644 --- a/R/meta_utils.R +++ b/R/meta_utils.R @@ -160,7 +160,7 @@ get_meta_subset.data.frame <- function(x, row_id, column, } if (length(list(...)) > 0) { - warning("Extra arguments were provided to get_meta_subset() that will not be used.") + warning("Extra arguments were provided to get_meta_subset() that will not be used.", immediate.=TRUE) } out <- target %>% @@ -195,33 +195,7 @@ get_meta_subset.tplyr_table <- function(x, row_id, column, add_cols = vars(USUBJ # Get the metadata object ready m <- get_meta_result(x, row_id, column) - # if (!inherits(add_cols, 'quosures')) { - # stop("add_cols must be provided using `dplyr::vars()`", call.=FALSE) - # } - # - # if (length(list(...)) > 0) { - # warning("Extra arguments were provided to get_meta_subset() that will not be used.") - # } - get_meta_subset(x$metadata, row_id, column, add_cols = add_cols, target = x$target, pop_data = x$pop_data) - # # Subset and return the data - # out <- x$target %>% - # filter(!!!m$filters) %>% - # select(!!!add_cols, !!!m$names) - # - # if (!is.null(m$anti_join)) { - # aj <- m$anti_join - # pd <- X$pop_data %>% - # filter(!!!aj$join_meta$filters) %>% - # select(!!!aj$on, !!!add_cols, !!!aj$join_meta$names) - # - # mrg_var <- map_chr(aj$on, as_name) - # names(mrg_var) <- mrg_var - # - # out <- anti_join(pd, out, by=mrg_var) - # } - # - # out } From 002a4464c60c20489970ff507b52fe720d22354e Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 19 Feb 2024 19:39:21 +0000 Subject: [PATCH 82/83] update news --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 35608b85..6bf7d521 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +# Tplyr 1.2.1 +- Resolve #178 to add metadata handling for missing subjects, and add the `add_anti_join()` function + # Tplyr 1.2.0 - Resolve #62 Add data vignette data into the package (thanks for the suggestion @thebioengineer) - Resolve #74 Add an example of piping in set_pop_data From 8405704a476d6dafcdb87a45fb923a5c70c71c5b Mon Sep 17 00:00:00 2001 From: "mike.stackhouse" Date: Mon, 19 Feb 2024 20:58:13 +0000 Subject: [PATCH 83/83] CRAN comments and leftover doc update --- cran-comments.md | 4 ++-- man/add_anti_join.Rd | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/cran-comments.md b/cran-comments.md index 26a668e8..a35c0f51 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,5 +1,5 @@ -## Submission 1.2.0 -* Several bug fixes and the addition of new functions `add_missing_subjects()`, `set_limit_data_by()`, `collapse_row_labels()`, and `replace_leading_whitespace()` +## Submission 1.2.1 +* Added metadata handling for features introduced in 1.2.0, added function `add_anti_join()` ## Test Environments diff --git a/man/add_anti_join.Rd b/man/add_anti_join.Rd index c6956075..5d0bc5ca 100644 --- a/man/add_anti_join.Rd +++ b/man/add_anti_join.Rd @@ -18,7 +18,7 @@ A tplyr_meta object } \description{ An anti-join allows a tplyr_meta object to refer to data that should be -extract from a separate dataset, like the population data of a Tplyr table, +extracted from a separate dataset, like the population data of a Tplyr table, that is unavailable in the target dataset. The primary use case for this is the presentation of missing subjects, which in a Tplyr table is presented using the function \code{add_missing_subjects_row()}. The missing subjects