From 1ee583999a35449955ccb85c9db3521e0422803a Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Fri, 15 Dec 2023 19:25:29 +0000 Subject: [PATCH 1/5] 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 2/5] 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 baa329c9cde882d30339dae1cbfe27370e06b42e Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Fri, 15 Dec 2023 20:31:30 +0000 Subject: [PATCH 3/5] vars() replaced with quos --- R/assertions.R | 18 +- R/count_bindings.R | 2 +- R/denom.R | 2 +- R/desc.R | 6 +- R/layer.R | 4 +- R/layer_bindings.R | 14 +- R/layering.R | 12 +- R/meta_utils.R | 14 +- R/nested.R | 8 +- R/process_metadata.R | 4 +- R/set_format_strings.R | 8 +- R/shift_bindings.R | 8 +- R/sort.R | 4 +- R/table.R | 2 +- R/utils.R | 6 +- R/zzz.R | 2 +- man/Tplyr.Rd | 2 +- man/by.Rd | 4 +- man/get_meta_subset.Rd | 10 +- man/layer_constructors.Rd | 12 +- man/precision_by.Rd | 4 +- man/precision_on.Rd | 4 +- man/set_denoms_by.Rd | 6 +- man/set_format_strings.Rd | 2 +- man/tplyr_layer.Rd | 4 +- man/tplyr_table.Rd | 2 +- tests/testthat/_snaps/count.md | 607 ---------------------- tests/testthat/_snaps/layer.md | 24 +- tests/testthat/_snaps/meta_utils.md | 2 +- tests/testthat/_snaps/properties_layer.md | 10 +- tests/testthat/test-count.R | 56 +- tests/testthat/test-desc.R | 10 +- tests/testthat/test-functional.R | 6 +- tests/testthat/test-layer.R | 24 +- tests/testthat/test-layer_templates.R | 4 +- tests/testthat/test-meta.R | 6 +- tests/testthat/test-num_fmt.R | 12 +- tests/testthat/test-opts.R | 6 +- tests/testthat/test-properties_layer.R | 6 +- tests/testthat/test-shift.R | 12 +- tests/testthat/test-sort.R | 20 +- uat/test_cases.R | 48 +- vignettes/Tplyr.Rmd | 4 +- vignettes/count.Rmd | 2 +- vignettes/metadata.Rmd | 2 +- vignettes/table.Rmd | 2 +- 46 files changed, 210 insertions(+), 817 deletions(-) delete mode 100644 tests/testthat/_snaps/count.md diff --git a/R/assertions.R b/R/assertions.R index ba108032..ce2c322f 100644 --- a/R/assertions.R +++ b/R/assertions.R @@ -100,7 +100,7 @@ assert_inherits_class <- function(x, should_have) { #' Assert that variables not passed as strings are present in target dataset #' #' @param quo_list A variable that can be a string, variable, or combination of -#' those using dplyr::vars +#' those using rlang::quos #' @param vnames Variable names of the target dataset to check against #' @param envir Environment containing the dataset \code{target} from which names will be checked against #' @param allow_character Whether or not character strings are allows in an entry @@ -114,10 +114,10 @@ assert_quo_var_present <- function(quo_list, vnames=NULL, envir=NULL, allow_char if (allow_character) { allow <- c('name', 'character') - allow_str <- "`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`." + allow_str <- "`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`." } else { allow <- "name" - allow_str <- "`. Submit either a variable name or multiple variable names using `dplyr::vars`." + allow_str <- "`. Submit either a variable name or multiple variable names using `rlang::quos`." } # Global definition warning @@ -155,7 +155,7 @@ assert_quo_var_present <- function(quo_list, vnames=NULL, envir=NULL, allow_char #' Assert that an argument is passed using vars as appropriate #' #' @param quo_list A variable that can be a string, variable, or combination of -#' those using dplyr::vars +#' those using rlang::quos #' @param allow_character Whether or not character strings are allows in an entry #' #' @return Unpacked quosure. @@ -169,9 +169,9 @@ unpack_vars <- function(quo_list, allow_character=TRUE) { param <- enexpr(quo_list) if (allow_character) { - allow_str <- "`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`." + allow_str <- "`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`." } else { - allow_str <- "`. Submit either a variable name or multiple variable names using `dplyr::vars`." + allow_str <- "`. Submit either a variable name or multiple variable names using `rlang::quos`." } # Unpack the `quo_list` group to ensure that the type is `list_of` @@ -181,8 +181,8 @@ unpack_vars <- function(quo_list, allow_character=TRUE) { if (is.call(c)) { # If it's a call, we need to pull it out a level quo_list <- tryCatch({ - # If it's in here, the call has to be to dplyr::vars - if (call_name(c) != "vars") abort("Multiple variables should be using dplyr::vars") + # If it's in here, the call has to be to rlang::quos + if (call_name(c) != "vars") abort("Multiple variables should be using rlang::quos") # Evaluate the quosure sort_vars getting the expression eval(c, envir=caller_env()) @@ -192,7 +192,7 @@ unpack_vars <- function(quo_list, allow_character=TRUE) { abort(message = paste0("Invalid input to `", param, allow_str)) }) } else { - if (is.null(c)) return(vars()) + if (is.null(c)) return(quos()) } quo_list } diff --git a/R/count_bindings.R b/R/count_bindings.R index 291779e3..717cd2f6 100644 --- a/R/count_bindings.R +++ b/R/count_bindings.R @@ -591,7 +591,7 @@ set_denom_where <- function(e, denom_where) { #' @export #' @noRd set_denoms_by.count_layer <- function(e, ...) { - dots <- vars(...) + dots <- quos(...) dots_chr <- map_chr(dots, as_name) # Pull these variables to make sure the denoms used make sense diff --git a/R/denom.R b/R/denom.R index a618f40d..a8cf4869 100644 --- a/R/denom.R +++ b/R/denom.R @@ -65,7 +65,7 @@ this_denom <- function(.data, header_n, treat_var) { #' @examples #' library(dplyr) #' -#' t <- tplyr_table(mtcars, gear, cols = vars(cyl, am)) +#' t <- tplyr_table(mtcars, gear, cols = quos(cyl, am)) #' #' get_header_n_value(t, 3, 6, 0) #' # Returns the number of cars that have 3 gears, 6 cylinders, and auto transmission diff --git a/R/desc.R b/R/desc.R index efb01320..0306a3a2 100644 --- a/R/desc.R +++ b/R/desc.R @@ -139,7 +139,7 @@ process_formatting.desc_layer <- function(x, ...) { if (stats_as_columns) { form_sums[[i]] <- trans_sums[[i]] %>% pivot_wider(id_cols=c(!!treat_var, match_exact(by)), # Keep row_label and the by variables - names_from = match_exact(vars(row_label, !!!cols)), # Pull the names from treatment and cols argument + names_from = match_exact(quos(row_label, !!!cols)), # Pull the names from treatment and cols argument names_prefix = paste0('var', i, "_"), # Prefix with the name of the target variable values_from = display_string # Use the created display_string variable for values ) @@ -147,7 +147,7 @@ process_formatting.desc_layer <- function(x, ...) { } else { form_sums[[i]] <- trans_sums[[i]] %>% pivot_wider(id_cols=c('row_label', match_exact(by)), # Keep row_label and the by variables - names_from = match_exact(vars(!!treat_var, !!!cols)), # Pull the names from treatment and cols argument + names_from = match_exact(quos(!!treat_var, !!!cols)), # Pull the names from treatment and cols argument names_prefix = paste0('var', i, "_"), # Prefix with the name of the target variable values_from = display_string # Use the created display_string variable for values ) @@ -173,7 +173,7 @@ process_formatting.desc_layer <- function(x, ...) { # formatted_data <- formatted_data %>% # rowwise() %>% # # Replace NA values with the proper empty strings - # mutate_at(vars(starts_with('var')), ~ replace_na(.x, format_strings[[row_label]]$empty)) + # mutate_at(quos(starts_with('var')), ~ replace_na(.x, format_strings[[row_label]]$empty)) # Clean up diff --git a/R/layer.R b/R/layer.R index abaea5a9..59f63bd6 100644 --- a/R/layer.R +++ b/R/layer.R @@ -26,7 +26,7 @@ #' either "counts" for categorical counts, "desc" for descriptive statistics, #' or "shift" for shift table counts #' @param by A string, a variable name, or a list of variable names supplied -#' using \code{dplyr::vars} +#' using \code{rlang::quos} #' @param target_var Symbol. Required, The variable name on which the summary is #' to be performed. Must be a variable within the target dataset. Enter #' unquoted - i.e. target_var = AEBODSYS. @@ -63,7 +63,7 @@ #' @examples #' tab <- tplyr_table(iris, Sepal.Width) #' -#' l <- group_count(tab, by=vars('Label Text', Species), +#' l <- group_count(tab, by=quos('Label Text', Species), #' target_var=Species, where= Sepal.Width < 5.5, #' cols = Species) #' diff --git a/R/layer_bindings.R b/R/layer_bindings.R index 35d711f6..171dc82c 100644 --- a/R/layer_bindings.R +++ b/R/layer_bindings.R @@ -50,13 +50,13 @@ set_target_var <- function(layer, target_var) { #' iris$Species2 <- iris$Species #' lay <- tplyr_table(iris, Species) %>% #' group_count(Species) %>% -#' set_by(vars(Species2, Sepal.Width)) +#' set_by(quos(Species2, Sepal.Width)) get_by <- function(layer) { env_get(layer, "by") } #' @param by A string, a variable name, or a list of variable names supplied -#' using \code{dplyr::vars}. +#' using \code{rlang::quos}. #' #' @export #' @rdname by @@ -111,7 +111,7 @@ set_where.tplyr_layer <- function(obj, where) { #' library(magrittr) #' lay <- tplyr_table(mtcars, gear) %>% #' add_layer( -#' group_desc(mpg, by=vars(carb, am)) %>% +#' group_desc(mpg, by=quos(carb, am)) %>% #' set_precision_by(carb) #' ) get_precision_by <- function(layer) { @@ -119,7 +119,7 @@ get_precision_by <- function(layer) { } #' @param precision_by A string, a variable name, or a list of variable names supplied -#' using \code{dplyr::vars}. +#' using \code{rlang::quos}. #' #' @export #' @rdname precision_by @@ -155,7 +155,7 @@ set_precision_by <- function(layer, precision_by) { #' library(magrittr) #' lay <- tplyr_table(mtcars, gear) %>% #' add_layer( -#' group_desc(vars(mpg, disp), by=vars(carb, am)) %>% +#' group_desc(quos(mpg, disp), by=quos(carb, am)) %>% #' set_precision_on(disp) #' ) get_precision_on <- function(layer) { @@ -163,7 +163,7 @@ get_precision_on <- function(layer) { } #' @param precision_on A string, a variable name, or a list of variable names -#' supplied using \code{dplyr::vars}. +#' supplied using \code{rlang::quos}. #' #' @export #' @rdname precision_on @@ -229,7 +229,7 @@ set_precision_data <- function(layer, prec, default = c("error", "auto")) { precision_by_syms <- map(precision_by, sym) # Insert the by variables in the layer and let set_precision_by validate - set_precision_by(layer, vars(!!!precision_by_syms)) + set_precision_by(layer, quos(!!!precision_by_syms)) # Checks # max_int and max_dec are both on precision dataset diff --git a/R/layering.R b/R/layering.R index b2d05f38..87126add 100644 --- a/R/layering.R +++ b/R/layering.R @@ -135,7 +135,7 @@ add_layers <- function(parent, ...) { #' Count layers are also capable of producing counts of nested relationships. #' For example, if you want to produce counts of an overall outside group, and #' then the subgroup counts within that group, you can specify the target -#' variable as vars(OutsideVariable, InsideVariable). This allows you to do +#' variable as quos(OutsideVariable, InsideVariable). This allows you to do #' tables like Adverse Events where you want to see the Preferred Terms within #' Body Systems, all in one layer. Further control over denominators is #' available using the function \code{\link{set_denoms_by}} and distinct @@ -153,7 +153,7 @@ add_layers <- function(parent, ...) { #' shift layer displays an endpoint's 'shift' throughout the duration of the #' study. It is an abstraction over the count layer, however we have provided #' an interface that is more efficient and intuitive. Targets are passed as -#' named symbols using \code{dplyr::vars}. Generally the baseline is passed +#' named symbols using \code{rlang::quos}. Generally the baseline is passed #' with the name 'row' and the shift is passed with the name 'column'. Both #' counts (n) and percentages (pct) are supported and can be specified with #' the \code{\link{set_format_strings}} function. To allow for flexibility @@ -190,22 +190,22 @@ add_layers <- function(parent, ...) { #' #' t <- tplyr_table(mtcars, am) %>% #' add_layer( -#' group_shift(vars(row=gear, column=carb), by=cyl) +#' group_shift(quos(row=gear, column=carb), by=cyl) #' ) -group_count <- function(parent, target_var, by=vars(), where=TRUE, ...) { +group_count <- function(parent, target_var, by=quos(), where=TRUE, ...) { tplyr_layer(parent, type='count', by=enquos(by), target_var=enquos(target_var), where=enquo(where), ...) } #' @rdname layer_constructors #' @family Layer Construction Functions #' @export -group_desc <- function(parent, target_var, by=vars(), where=TRUE, ...) { +group_desc <- function(parent, target_var, by=quos(), where=TRUE, ...) { tplyr_layer(parent, type='desc', by=enquos(by), target_var=enquos(target_var), where=enquo(where), ...) } #' @rdname layer_constructors #' @family Layer Construction Functions #' @export -group_shift <- function(parent, target_var, by=vars(), where=TRUE, ...) { +group_shift <- function(parent, target_var, by=quos(), where=TRUE, ...) { tplyr_layer(parent, type='shift', by=enquos(by), target_var=enquos(target_var), where=enquo(where), ...) } diff --git a/R/meta_utils.R b/R/meta_utils.R index fabbbcbd..f0ea1605 100644 --- a/R/meta_utils.R +++ b/R/meta_utils.R @@ -126,25 +126,25 @@ get_meta_result.data.frame <- function(x, row_id, column, ...) { #' #' dat <- t %>% build(metadata = TRUE) #' -#' get_meta_subset(t, 'd1_1', 'var1_4', add_cols = dplyr::vars(carb)) +#' get_meta_subset(t, 'd1_1', 'var1_4', add_cols = rlang::quos(carb)) #' #' m <- t$metadata #' dat <- t$target #' -#' get_meta_subset(t, 'd1_1', 'var1_4', add_cols = dplyr::vars(carb), target = target) -get_meta_subset <- function(x, row_id, column, add_cols = vars(USUBJID), ...) { +#' get_meta_subset(t, 'd1_1', 'var1_4', add_cols = rlang::quos(carb), target = target) +get_meta_subset <- function(x, row_id, column, add_cols = quos(USUBJID), ...) { UseMethod("get_meta_subset") } #' @export #' @rdname get_meta_subset get_meta_subset.data.frame <- function(x, row_id, column, - add_cols = vars(USUBJID), target = NULL, ...) { + add_cols = quos(USUBJID), target = NULL, ...) { # 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) + stop("add_cols must be provided using `rlang::quos()`", call.=FALSE) } # Subset and return the data @@ -159,13 +159,13 @@ get_meta_subset.data.frame <- function(x, row_id, column, #' @export #' @rdname get_meta_subset -get_meta_subset.tplyr_table <- function(x, row_id, column, add_cols = vars(USUBJID), ...) { +get_meta_subset.tplyr_table <- function(x, row_id, column, add_cols = quos(USUBJID), ...) { # 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) + stop("add_cols must be provided using `rlang::quos()`", call.=FALSE) } # Subset and return the data diff --git a/R/nested.R b/R/nested.R index 322b1588..8a895a13 100644 --- a/R/nested.R +++ b/R/nested.R @@ -41,10 +41,10 @@ process_nested_count_target <- function(x) { } first_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[1]], - by = vars(!!!by), where = !!where)) + by = quos(!!!by), where = !!where)) second_layer <- process_summaries(group_count(current_env(), target_var = !!target_var[[2]], - by = vars(!!target_var[[1]], !!!by), where = !!where) %>% + by = quos(!!target_var[[1]], !!!by), where = !!where) %>% set_count_row_prefix(indentation) %>% set_denoms_by(!!!second_denoms_by)) @@ -82,8 +82,8 @@ process_nested_count_target <- function(x) { target_var_saved <- target_var is_built_nest <- TRUE - by <- vars(!!target_var[[1]], !!!by) - target_var <- vars(!!target_var[[2]]) + by <- quos(!!target_var[[1]], !!!by) + target_var <- quos(!!target_var[[2]]) }, envir = x) diff --git a/R/process_metadata.R b/R/process_metadata.R index 2ea1ecf9..fd4d6d8a 100644 --- a/R/process_metadata.R +++ b/R/process_metadata.R @@ -34,14 +34,14 @@ process_metadata.desc_layer <- function(x, ...) { # Transpose the metadata identical to the summary form_meta[[i]] <- meta_sums[[i]] %>% pivot_wider(id_cols=c(!!treat_var, match_exact(by)), - names_from = match_exact(vars(row_label, !!!cols)), + names_from = match_exact(quos(row_label, !!!cols)), names_prefix = paste0('var', i, "_"), values_from = meta ) } else { form_meta[[i]] <- meta_sums[[i]] %>% pivot_wider(id_cols=c('row_label', match_exact(by)), - names_from = match_exact(vars(!!treat_var, !!!cols)), + names_from = match_exact(quos(!!treat_var, !!!cols)), names_prefix = paste0('var', i, "_"), values_from = meta ) diff --git a/R/set_format_strings.R b/R/set_format_strings.R index e81d7d6b..e76ee1ad 100644 --- a/R/set_format_strings.R +++ b/R/set_format_strings.R @@ -82,7 +82,7 @@ #' # In a shift layer #' tplyr_table(mtcars, am) %>% #' add_layer( -#' group_shift(vars(row=gear, column=carb), by=cyl) %>% +#' group_shift(quos(row=gear, column=carb), by=cyl) %>% #' set_format_strings(f_str("xxx (xx.xx%)", n, pct)) #' ) %>% #' build() @@ -157,9 +157,9 @@ set_format_strings.desc_layer <- function(e, ..., cap=getOption('tplyr.precision env_bind(e, format_strings = format_strings, - summary_vars = vars(!!!summary_vars), - keep_vars = vars(!!!keep_vars), - trans_vars = vars(!!!trans_vars), + summary_vars = quos(!!!summary_vars), + keep_vars = quos(!!!keep_vars), + trans_vars = quos(!!!trans_vars), row_labels = row_labels, max_length = max_format_length, need_prec_table = need_prec_table, diff --git a/R/shift_bindings.R b/R/shift_bindings.R index 0a4891a3..371e53b3 100644 --- a/R/shift_bindings.R +++ b/R/shift_bindings.R @@ -19,14 +19,14 @@ #' # and by variables sum to 1 #' tplyr_table(mtcars, am) %>% #' add_layer( -#' group_shift(vars(row=gear, column=carb), by=cyl) %>% +#' group_shift(quos(row=gear, column=carb), by=cyl) %>% #' set_format_strings(f_str("xxx (xx.xx%)", n, pct)) #' ) %>% #' build() #' #' tplyr_table(mtcars, am) %>% #' add_layer( -#' group_shift(vars(row=gear, column=carb), by=cyl) %>% +#' group_shift(quos(row=gear, column=carb), by=cyl) %>% #' set_format_strings(f_str("xxx (xx.xx%)", n, pct)) %>% #' set_denoms_by(cyl, gear) # Row % sums to 1 #' ) %>% @@ -34,7 +34,7 @@ #' #' tplyr_table(mtcars, am) %>% #' add_layer( -#' group_shift(vars(row=gear, column=carb), by=cyl) %>% +#' group_shift(quos(row=gear, column=carb), by=cyl) %>% #' set_format_strings(f_str("xxx (xx.xx%)", n, pct)) %>% #' set_denoms_by(cyl, gear, am) # % within treatment group sums to 1 #' ) %>% @@ -47,7 +47,7 @@ set_denoms_by <- function(e, ...) { #' @noRd set_denoms_by.shift_layer <- function(e, ...) { - dots <- vars(...) + dots <- quos(...) dots_chr <- map_chr(dots, as_name) # Pull these variables to make sure the denoms used make sense diff --git a/R/sort.R b/R/sort.R index d4638fde..2f77dee9 100644 --- a/R/sort.R +++ b/R/sort.R @@ -709,8 +709,8 @@ add_data_order_nested <- function(group_data, final_col, numeric_data, ...) { } 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), + get_data_order_bycount(ordering_cols, treat_var, quos(!!!head(by, -1)), cols, + result_order_var, quos(!!by[[1]], !!target_var), break_ties = break_ties, numeric_cutoff = numeric_cutoff, numeric_cutoff_stat = numeric_cutoff_stat, diff --git a/R/table.R b/R/table.R index a2441b3a..97d412db 100644 --- a/R/table.R +++ b/R/table.R @@ -40,7 +40,7 @@ #' #' tab <- tplyr_table(iris, Species, where = Sepal.Length < 5.8) #' -tplyr_table <- function(target, treat_var, where = TRUE, cols = vars()) { +tplyr_table <- function(target, treat_var, where = TRUE, cols = quos()) { if(missing(target)){ # return a blank environment if no table information is passed. This can be diff --git a/R/utils.R b/R/utils.R index 1187d100..011b6361 100644 --- a/R/utils.R +++ b/R/utils.R @@ -100,7 +100,7 @@ depth_from_table <- function(layer, i){ #' iris %>% #' group_by(Species) %>% #' summarize(mean=mean(Sepal.Length), median = median(Sepal.Length)) %>% -#' pivot_longer(cols = match_exact(vars(mean, median))) +#' pivot_longer(cols = match_exact(quos(mean, median))) #' match_exact <- function(var_list) { # Should have been a list of quosures on input @@ -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 diff --git a/R/zzz.R b/R/zzz.R index 0c8ec46a..a38e78c5 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -115,7 +115,7 @@ NULL #' # A Shift Table #' tplyr_table(mtcars, am) %>% #' add_layer( -#' group_shift(vars(row=gear, column=carb), by=cyl) %>% +#' group_shift(quos(row=gear, column=carb), by=cyl) %>% #' set_format_strings(f_str("xxx (xx.xx%)", n, pct)) #' ) %>% #' build() diff --git a/man/Tplyr.Rd b/man/Tplyr.Rd index 1a923391..fc740b4e 100644 --- a/man/Tplyr.Rd +++ b/man/Tplyr.Rd @@ -98,7 +98,7 @@ tplyr_table(mtcars, gear) \%>\% # A Shift Table tplyr_table(mtcars, am) \%>\% add_layer( - group_shift(vars(row=gear, column=carb), by=cyl) \%>\% + group_shift(quos(row=gear, column=carb), by=cyl) \%>\% set_format_strings(f_str("xxx (xx.xx\%)", n, pct)) ) \%>\% build() diff --git a/man/by.Rd b/man/by.Rd index ccc4db35..1fe9f00c 100644 --- a/man/by.Rd +++ b/man/by.Rd @@ -13,7 +13,7 @@ set_by(layer, by) \item{layer}{A \code{tplyr_layer} object} \item{by}{A string, a variable name, or a list of variable names supplied -using \code{dplyr::vars}.} +using \code{rlang::quos}.} } \value{ For \code{get_by}, the \code{by} binding of the supplied layer. For @@ -28,5 +28,5 @@ library(magrittr) iris$Species2 <- iris$Species lay <- tplyr_table(iris, Species) \%>\% group_count(Species) \%>\% - set_by(vars(Species2, Sepal.Width)) + set_by(quos(Species2, Sepal.Width)) } diff --git a/man/get_meta_subset.Rd b/man/get_meta_subset.Rd index f8028394..a4002401 100644 --- a/man/get_meta_subset.Rd +++ b/man/get_meta_subset.Rd @@ -6,18 +6,18 @@ \alias{get_meta_subset.tplyr_table} \title{Extract the subset of data based on result metadata} \usage{ -get_meta_subset(x, row_id, column, add_cols = vars(USUBJID), ...) +get_meta_subset(x, row_id, column, add_cols = quos(USUBJID), ...) \method{get_meta_subset}{data.frame}( x, row_id, column, - add_cols = vars(USUBJID), + add_cols = quos(USUBJID), target = NULL, ... ) -\method{get_meta_subset}{tplyr_table}(x, row_id, column, add_cols = vars(USUBJID), ...) +\method{get_meta_subset}{tplyr_table}(x, row_id, column, add_cols = quos(USUBJID), ...) } \arguments{ \item{x}{A built Tplyr table or a dataframe} @@ -69,10 +69,10 @@ t <- tplyr_table(mtcars, cyl) \%>\% dat <- t \%>\% build(metadata = TRUE) -get_meta_subset(t, 'd1_1', 'var1_4', add_cols = dplyr::vars(carb)) +get_meta_subset(t, 'd1_1', 'var1_4', add_cols = rlang::quos(carb)) m <- t$metadata dat <- t$target -get_meta_subset(t, 'd1_1', 'var1_4', add_cols = dplyr::vars(carb), target = target) +get_meta_subset(t, 'd1_1', 'var1_4', add_cols = rlang::quos(carb), target = target) } diff --git a/man/layer_constructors.Rd b/man/layer_constructors.Rd index 004b8303..de6f4f60 100644 --- a/man/layer_constructors.Rd +++ b/man/layer_constructors.Rd @@ -7,11 +7,11 @@ \title{Create a \code{count}, \code{desc}, or \code{shift} layer for discrete count based summaries, descriptive statistics summaries, or shift count summaries} \usage{ -group_count(parent, target_var, by = vars(), where = TRUE, ...) +group_count(parent, target_var, by = quos(), where = TRUE, ...) -group_desc(parent, target_var, by = vars(), where = TRUE, ...) +group_desc(parent, target_var, by = quos(), where = TRUE, ...) -group_shift(parent, target_var, by = vars(), where = TRUE, ...) +group_shift(parent, target_var, by = quos(), where = TRUE, ...) } \arguments{ \item{parent}{Required. The parent environment of the layer. This must be the @@ -51,7 +51,7 @@ This family of functions specifies the type of summary that is Count layers are also capable of producing counts of nested relationships. For example, if you want to produce counts of an overall outside group, and then the subgroup counts within that group, you can specify the target - variable as vars(OutsideVariable, InsideVariable). This allows you to do + variable as quos(OutsideVariable, InsideVariable). This allows you to do tables like Adverse Events where you want to see the Preferred Terms within Body Systems, all in one layer. Further control over denominators is available using the function \code{\link{set_denoms_by}} and distinct @@ -69,7 +69,7 @@ This family of functions specifies the type of summary that is shift layer displays an endpoint's 'shift' throughout the duration of the study. It is an abstraction over the count layer, however we have provided an interface that is more efficient and intuitive. Targets are passed as - named symbols using \code{dplyr::vars}. Generally the baseline is passed + named symbols using \code{rlang::quos}. Generally the baseline is passed with the name 'row' and the shift is passed with the name 'column'. Both counts (n) and percentages (pct) are supported and can be specified with the \code{\link{set_format_strings}} function. To allow for flexibility @@ -93,7 +93,7 @@ t <- tplyr_table(iris, Species) \%>\% t <- tplyr_table(mtcars, am) \%>\% add_layer( - group_shift(vars(row=gear, column=carb), by=cyl) + group_shift(quos(row=gear, column=carb), by=cyl) ) } \seealso{ diff --git a/man/precision_by.Rd b/man/precision_by.Rd index 1f676073..14b33e0e 100644 --- a/man/precision_by.Rd +++ b/man/precision_by.Rd @@ -13,7 +13,7 @@ set_precision_by(layer, precision_by) \item{layer}{A \code{tplyr_layer} object} \item{precision_by}{A string, a variable name, or a list of variable names supplied -using \code{dplyr::vars}.} +using \code{rlang::quos}.} } \value{ For \code{get_precision_by}, the precision_by binding of the supplied @@ -31,7 +31,7 @@ by variables library(magrittr) lay <- tplyr_table(mtcars, gear) \%>\% add_layer( - group_desc(mpg, by=vars(carb, am)) \%>\% + group_desc(mpg, by=quos(carb, am)) \%>\% set_precision_by(carb) ) } diff --git a/man/precision_on.Rd b/man/precision_on.Rd index ecef06e6..8f699e79 100644 --- a/man/precision_on.Rd +++ b/man/precision_on.Rd @@ -13,7 +13,7 @@ set_precision_on(layer, precision_on) \item{layer}{A \code{tplyr_layer} object} \item{precision_on}{A string, a variable name, or a list of variable names -supplied using \code{dplyr::vars}.} +supplied using \code{rlang::quos}.} } \value{ For \code{get_precision_on}, the precision_on binding of the supplied @@ -29,7 +29,7 @@ variables. library(magrittr) lay <- tplyr_table(mtcars, gear) \%>\% add_layer( - group_desc(vars(mpg, disp), by=vars(carb, am)) \%>\% + group_desc(quos(mpg, disp), by=quos(carb, am)) \%>\% set_precision_on(disp) ) } diff --git a/man/set_denoms_by.Rd b/man/set_denoms_by.Rd index 8b8a89c8..208aab09 100644 --- a/man/set_denoms_by.Rd +++ b/man/set_denoms_by.Rd @@ -27,14 +27,14 @@ library(magrittr) # and by variables sum to 1 tplyr_table(mtcars, am) \%>\% add_layer( - group_shift(vars(row=gear, column=carb), by=cyl) \%>\% + group_shift(quos(row=gear, column=carb), by=cyl) \%>\% set_format_strings(f_str("xxx (xx.xx\%)", n, pct)) ) \%>\% build() tplyr_table(mtcars, am) \%>\% add_layer( - group_shift(vars(row=gear, column=carb), by=cyl) \%>\% + group_shift(quos(row=gear, column=carb), by=cyl) \%>\% set_format_strings(f_str("xxx (xx.xx\%)", n, pct)) \%>\% set_denoms_by(cyl, gear) # Row \% sums to 1 ) \%>\% @@ -42,7 +42,7 @@ tplyr_table(mtcars, am) \%>\% tplyr_table(mtcars, am) \%>\% add_layer( - group_shift(vars(row=gear, column=carb), by=cyl) \%>\% + group_shift(quos(row=gear, column=carb), by=cyl) \%>\% set_format_strings(f_str("xxx (xx.xx\%)", n, pct)) \%>\% set_denoms_by(cyl, gear, am) # \% within treatment group sums to 1 ) \%>\% diff --git a/man/set_format_strings.Rd b/man/set_format_strings.Rd index 90fac1c0..48021166 100644 --- a/man/set_format_strings.Rd +++ b/man/set_format_strings.Rd @@ -103,7 +103,7 @@ tplyr_table(mtcars, gear) \%>\% # In a shift layer tplyr_table(mtcars, am) \%>\% add_layer( - group_shift(vars(row=gear, column=carb), by=cyl) \%>\% + group_shift(quos(row=gear, column=carb), by=cyl) \%>\% set_format_strings(f_str("xxx (xx.xx\%)", n, pct)) ) \%>\% build() diff --git a/man/tplyr_layer.Rd b/man/tplyr_layer.Rd index 628d10fc..d8f8ad14 100644 --- a/man/tplyr_layer.Rd +++ b/man/tplyr_layer.Rd @@ -17,7 +17,7 @@ to be performed. Must be a variable within the target dataset. Enter unquoted - i.e. target_var = AEBODSYS.} \item{by}{A string, a variable name, or a list of variable names supplied -using \code{dplyr::vars}} +using \code{rlang::quos}} \item{where}{Call. Filter logic used to subset the target data when performing a summary.} @@ -72,7 +72,7 @@ using the layer constructor functions \code{\link{group_count}}, \examples{ tab <- tplyr_table(iris, Sepal.Width) -l <- group_count(tab, by=vars('Label Text', Species), +l <- group_count(tab, by=quos('Label Text', Species), target_var=Species, where= Sepal.Width < 5.5, cols = Species) diff --git a/man/tplyr_table.Rd b/man/tplyr_table.Rd index d26d6270..ac9bc783 100644 --- a/man/tplyr_table.Rd +++ b/man/tplyr_table.Rd @@ -4,7 +4,7 @@ \alias{tplyr_table} \title{Create a Tplyr table object} \usage{ -tplyr_table(target, treat_var, where = TRUE, cols = vars()) +tplyr_table(target, treat_var, where = TRUE, cols = quos()) } \arguments{ \item{target}{Dataset upon which summaries will be performed} diff --git a/tests/testthat/_snaps/count.md b/tests/testthat/_snaps/count.md deleted file mode 100644 index 3e73875e..00000000 --- a/tests/testthat/_snaps/count.md +++ /dev/null @@ -1,607 +0,0 @@ -# Count layer clauses with invalid syntax give informative error - - i In index: 1. - Caused by error in `value[[3L]]()`: - ! group_count `where` condition `bad == code` is invalid. Filter error: - Error in `filter()`: - i In argument: `bad == code`. - Caused by error: - ! object 'bad' not found - -# Total rows and missing counts are displayed correctly(0.1.5 Updates) - - structure(list(row_label1 = c("6", "8", "Missing", "Total"), - var1_3 = c(" 2 (13.3)", "12 (80.0)", " 1", " 15 [100.0]" - ), var1_4 = c(" 4 (33.3)", " 0 ( 0.0)", " 8", " 12 [100.0]" - ), var1_5 = c(" 1 (20.0)", " 2 (40.0)", " 2", " 5 [100.0]" - ), ord_layer_index = c(1L, 1L, 1L, 1L), ord_layer_1 = c(1, - 2, 3, 4)), row.names = c(NA, -4L), class = c("tbl_df", "tbl", - "data.frame")) - ---- - - structure(list(row_label1 = c("6", "8", "Missing", "Not Found", - "Total"), var1_3 = c(" 2 (13.3)", "12 (80.0)", " 1", " 0", " 15 [100.0]" - ), var1_4 = c(" 4 (33.3)", " 0 ( 0.0)", " 8", " 0", " 12 [100.0]" - ), var1_5 = c(" 1 (20.0)", " 2 (40.0)", " 2", " 0", " 5 [100.0]" - ), ord_layer_index = c(1L, 1L, 1L, 1L, 1L), ord_layer_1 = c(1, - 2, 3, 4, 5)), row.names = c(NA, -5L), class = c("tbl_df", "tbl", - "data.frame")) - ---- - - structure(list(row_label1 = c("0", "Missing", "Not Found", "Total" - ), var1_3 = c("15 (100.0)", " 0", " 0", " 15 [100.0]"), var1_4 = c(" 4 (33.3)", - " 8", " 0", " 12 [100.0]"), var1_5 = c(" 0 ( 0.0)", " 5", " 0", - " 5 [100.0]"), ord_layer_index = c(1L, 1L, 1L, 1L), ord_layer_1 = c(1, - 5689, 5690, 9999)), row.names = c(NA, -4L), class = c("tbl_df", - "tbl", "data.frame")) - ---- - - structure(list(row_label1 = c("6", "8", "Missing", "Not Found", - "Total"), var1_3 = c(" 2 (13.3)", "12 (80.0)", " 1", " 0", " 15 [100.0]" - ), var1_4 = c(" 4 (33.3)", " 0 ( 0.0)", " 8", " 0", " 12 [100.0]" - ), var1_5 = c(" 1 (20.0)", " 2 (40.0)", " 2", " 0", " 5 [100.0]" - ), ord_layer_index = c(1L, 1L, 1L, 1L, 1L), ord_layer_1 = c(4, - 0, 999, 1000, 9999)), row.names = c(NA, -5L), class = c("tbl_df", - "tbl", "data.frame")) - ---- - - structure(list(row_label1 = c("6", "8", "Missing", "Total"), - var1_3 = c(" 2 (13.3)", "12 (80.0)", " 1", " 15 [100.0]" - ), var1_4 = c(" 4 (33.3)", " 0 ( 0.0)", " 8", " 12 [100.0]" - ), var1_5 = c(" 1 (20.0)", " 2 (40.0)", " 2", " 5 [100.0]" - ), ord_layer_index = c(1L, 1L, 1L, 1L), ord_layer_1 = c(1, - 2, 3, 7862)), row.names = c(NA, -4L), class = c("tbl_df", - "tbl", "data.frame")) - ---- - - structure(list(row_label1 = c("0", "Missing", "Total"), var1_3 = c("15 (100.0)", - " 0", " 15 [100.0]"), var1_4 = c(" 4 (33.3)", " 8", " 12 [100.0]" - ), var1_5 = c(" 0 ( 0.0)", " 5", " 5 [100.0]"), ord_layer_index = c(1L, - 1L, 1L), ord_layer_1 = c(1, 3, -Inf)), row.names = c(NA, -3L), class = c("tbl_df", - "tbl", "data.frame")) - ---- - - structure(list(row_label1 = c("6", "8", "Missing", "Total"), - var1_3 = c(" 2 (13.3)", "12 (80.0)", " 1", " 15 [100.0]" - ), var1_4 = c(" 4 (33.3)", " 0 ( 0.0)", " 8", " 12 [100.0]" - ), var1_5 = c(" 1 (20.0)", " 2 (40.0)", " 2", " 5 [100.0]" - ), ord_layer_index = c(1L, 1L, 1L, 1L), ord_layer_1 = c(4, - 0, 8, -6795)), row.names = c(NA, -4L), class = c("tbl_df", - "tbl", "data.frame")) - ---- - - structure(list(row_label1 = c("6", "8", "NA", "Total"), var1_3 = c(" 2 (13.3)", - "12 (80.0)", " 1 ( 6.7)", "15 (100.0)"), var1_4 = c(" 4 (33.3)", - " 0 ( 0.0)", " 8 (66.7)", "12 (100.0)"), var1_5 = c(" 1 (20.0)", - " 2 (40.0)", " 2 (40.0)", " 5 (100.0)"), ord_layer_index = c(1L, - 1L, 1L, 1L), ord_layer_1 = c(1, 2, 3, 3)), row.names = c(NA, - -4L), class = c("tbl_df", "tbl", "data.frame")) - ---- - - structure(list(row_label1 = c("2", "3", "4", "6", "8", "Missing_" - ), var1_3 = c(" 0 ( 0.0)", " 0 ( 0.0)", " 0 ( 0.0)", " 2 (13.3)", - "12 (80.0)", " 1"), var1_4 = c(" 0 ( 0.0)", " 0 ( 0.0)", " 0 ( 0.0)", - " 4 (33.3)", " 0 ( 0.0)", " 8"), var1_5 = c(" 0 ( 0.0)", " 0 ( 0.0)", - " 0 ( 0.0)", " 1 (20.0)", " 2 (40.0)", " 2"), ord_layer_index = c(1L, - 1L, 1L, 1L, 1L, 1L), ord_layer_1 = c(1, 2, 3, 4, 5, 6)), row.names = c(NA, - -6L), class = c("tbl_df", "tbl", "data.frame")) - -# set_denom_where works as expected - - structure(list(row_label1 = c("4", "8"), var1_3 = c(" 1 ( 6.7)", - "12 (80.0)"), var1_4 = c(" 8 (66.7)", " 0 ( 0.0)"), var1_5 = c(" 2 (40.0)", - " 2 (40.0)"), ord_layer_index = c(1L, 1L), ord_layer_1 = c(1, - 3)), row.names = c(NA, -2L), class = c("tbl_df", "tbl", "data.frame" - )) - ---- - - structure(list(row_label1 = c("4", "8"), var1_3 = c(" 1 ( 7.1)", - "12 (85.7)"), var1_4 = c(" 8 (200.0)", " 0 ( 0.0)"), var1_5 = c(" 2 (66.7)", - " 2 (66.7)"), ord_layer_index = c(1L, 1L), ord_layer_1 = c(1, - 3)), row.names = c(NA, -2L), class = c("tbl_df", "tbl", "data.frame" - )) - ---- - - A `denom_where` has been set with a pop_data. The `denom_where` has been ignored.You should use `set_pop_where` instead of `set_denom_where`. - - ---- - - structure(list(row_label1 = c("4", "8"), var1_3 = c(" 1 ( 7.7)", - "12 (92.3)"), var1_4 = c(" 8 (100.0)", " 0 ( 0.0)"), var1_5 = c(" 2 (50.0)", - " 2 (50.0)"), ord_layer_index = c(1L, 1L), ord_layer_1 = c(1, - 3)), row.names = c(NA, -2L), class = c("tbl_df", "tbl", "data.frame" - )) - -# Nested count layers can accept text values in the first variable - - i In index: 1. - Caused by error: - ! Inner layers must be data driven variables - -# Variable names will be coersed into symbols - - The first target variable has been coerced into a symbol. You should pass variable names unquoted. - ---- - - The second target variable has been coerced into a symbol.You should pass variable names unquoted. - -# keep_levels works as expeceted - - i In index: 1. - Caused by error in `value[[3L]]()`: - ! group_count `where` condition `TRUE` is invalid. Filter error: - Error: level passed to `kept_levels` not found: 10 20 - ---- - - i In index: 1. - Caused by error in `value[[3L]]()`: - ! group_count `where` condition `TRUE` is invalid. Filter error: - Error: level passed to `kept_levels` not found: nothere - -# nested count layers handle `set_denoms_by` as expected - - You can not pass the second variable in `vars` as a denominator. - ---- - - Code - tplyr_table(mtcars, gear, cols = vs) %>% add_layer(group_count(vars(cyl, grp)) %>% - set_denoms_by(cyl)) %>% build() %>% as.data.frame() - Output - row_label1 row_label2 var1_3_0 var1_3_1 var1_4_0 var1_4_1 - 1 4 4 0 ( 0.0%) 1 ( 9.1%) 0 ( 0.0%) 8 ( 72.7%) - 2 4 grp.4 0 ( 0.0%) 1 ( 9.1%) 0 ( 0.0%) 3 ( 27.3%) - 3 4 grp.4.5 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) 5 ( 45.5%) - 4 6 6 0 ( 0.0%) 2 ( 28.6%) 2 ( 28.6%) 2 ( 28.6%) - 5 6 grp.6 0 ( 0.0%) 0 ( 0.0%) 1 ( 14.3%) 1 ( 14.3%) - 6 6 grp.6.5 0 ( 0.0%) 2 ( 28.6%) 1 ( 14.3%) 1 ( 14.3%) - 7 8 8 12 ( 85.7%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) - 8 8 grp.8 7 ( 50.0%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) - 9 8 grp.8.5 5 ( 35.7%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) - var1_5_0 var1_5_1 ord_layer_index ord_layer_1 ord_layer_2 - 1 1 ( 9.1%) 1 ( 9.1%) 1 1 Inf - 2 1 ( 9.1%) 0 ( 0.0%) 1 1 1 - 3 0 ( 0.0%) 1 ( 9.1%) 1 1 2 - 4 1 ( 14.3%) 0 ( 0.0%) 1 2 Inf - 5 0 ( 0.0%) 0 ( 0.0%) 1 2 1 - 6 1 ( 14.3%) 0 ( 0.0%) 1 2 2 - 7 2 ( 14.3%) 0 ( 0.0%) 1 3 Inf - 8 2 ( 14.3%) 0 ( 0.0%) 1 3 1 - 9 0 ( 0.0%) 0 ( 0.0%) 1 3 2 - ---- - - Code - tplyr_table(mtcars, gear, cols = vs) %>% add_layer(group_count(vars(cyl, grp))) %>% - build() %>% as.data.frame() - Output - row_label1 row_label2 var1_3_0 var1_3_1 var1_4_0 var1_4_1 - 1 4 4 0 ( 0.0%) 1 ( 33.3%) 0 ( 0.0%) 8 ( 80.0%) - 2 4 grp.4 0 ( 0.0%) 1 ( 33.3%) 0 ( 0.0%) 3 ( 30.0%) - 3 4 grp.4.5 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) 5 ( 50.0%) - 4 6 6 0 ( 0.0%) 2 ( 66.7%) 2 (100.0%) 2 ( 20.0%) - 5 6 grp.6 0 ( 0.0%) 0 ( 0.0%) 1 ( 50.0%) 1 ( 10.0%) - 6 6 grp.6.5 0 ( 0.0%) 2 ( 66.7%) 1 ( 50.0%) 1 ( 10.0%) - 7 8 8 12 (100.0%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) - 8 8 grp.8 7 ( 58.3%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) - 9 8 grp.8.5 5 ( 41.7%) 0 ( 0.0%) 0 ( 0.0%) 0 ( 0.0%) - var1_5_0 var1_5_1 ord_layer_index ord_layer_1 ord_layer_2 - 1 1 ( 25.0%) 1 (100.0%) 1 1 Inf - 2 1 ( 25.0%) 0 ( 0.0%) 1 1 1 - 3 0 ( 0.0%) 1 (100.0%) 1 1 2 - 4 1 ( 25.0%) 0 ( 0.0%) 1 2 Inf - 5 0 ( 0.0%) 0 ( 0.0%) 1 2 1 - 6 1 ( 25.0%) 0 ( 0.0%) 1 2 2 - 7 2 ( 50.0%) 0 ( 0.0%) 1 3 Inf - 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 - - 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 - -# set_numeric_threshold works as expected - - Code - as.data.frame(build(t1)) - Output - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 - 1 8 12 ( 80.0%) 0 ( 0.0%) 2 ( 40.0%) 1 0 - 2 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 - ---- - - Code - as.data.frame(build(t2)) - Output - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 - 1 4 1 ( 6.7%) 8 ( 66.7%) 2 ( 40.0%) 1 8 - 2 8 12 ( 80.0%) 0 ( 0.0%) 2 ( 40.0%) 1 0 - 3 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 - ---- - - Code - as.data.frame(build(t3)) - Output - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 - 1 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 - ---- - - Code - as.data.frame(build(t4)) - Output - [1] row_label1 ord_layer_index - <0 rows> (or 0-length row.names) - ---- - - Code - as.data.frame(build(t5)) - Output - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 - 1 4 1 ( 6.7%) 8 ( 66.7%) 2 ( 40.0%) 1 8 - 2 8 12 ( 80.0%) 0 ( 0.0%) 2 ( 40.0%) 1 0 - 3 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 - ---- - - Code - as.data.frame(build(t6)) - Output - row_label1 var1_3 var1_4 var1_5 ord_layer_index ord_layer_1 - 1 8 12 ( 80.0%) 0 ( 0.0%) 2 ( 40.0%) 1 0 - 2 Total 15 (100.0%) 12 (100.0%) 5 (100.0%) 1 12 - ---- - - Code - as.data.frame(build(t7)) - Output - row_label1 - 1 GASTROINTESTINAL DISORDERS - 2 GASTROINTESTINAL DISORDERS - 3 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 4 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 5 INFECTIONS AND INFESTATIONS - 6 INFECTIONS AND INFESTATIONS - 7 SKIN AND SUBCUTANEOUS TISSUE DISORDERS - 8 SKIN AND SUBCUTANEOUS TISSUE DISORDERS - 9 SKIN AND SUBCUTANEOUS TISSUE DISORDERS - row_label2 var1_Placebo - 1 GASTROINTESTINAL DISORDERS 6 ( 12.8%) - 2 DIARRHOEA 3 ( 6.4%) - 3 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS 11 ( 23.4%) - 4 APPLICATION SITE PRURITUS 4 ( 8.5%) - 5 INFECTIONS AND INFESTATIONS 5 ( 10.6%) - 6 UPPER RESPIRATORY TRACT INFECTION 4 ( 8.5%) - 7 SKIN AND SUBCUTANEOUS TISSUE DISORDERS 7 ( 14.9%) - 8 ERYTHEMA 4 ( 8.5%) - 9 PRURITUS 3 ( 6.4%) - var1_Xanomeline High Dose var1_Xanomeline Low Dose ord_layer_index - 1 6 ( 7.8%) 3 ( 3.9%) 1 - 2 1 ( 1.3%) 2 ( 2.6%) 1 - 3 21 ( 27.3%) 21 ( 27.6%) 1 - 4 7 ( 9.1%) 5 ( 6.6%) 1 - 5 4 ( 5.2%) 3 ( 3.9%) 1 - 6 1 ( 1.3%) 1 ( 1.3%) 1 - 7 21 ( 27.3%) 26 ( 34.2%) 1 - 8 3 ( 3.9%) 2 ( 2.6%) 1 - 9 8 ( 10.4%) 7 ( 9.2%) 1 - ord_layer_1 ord_layer_2 - 1 1 Inf - 2 1 1 - 3 2 Inf - 4 2 1 - 5 3 Inf - 6 3 1 - 7 4 Inf - 8 4 1 - 9 4 2 - ---- - - Code - as.data.frame(build(t8)) - Output - row_label1 - 1 GASTROINTESTINAL DISORDERS - 2 GASTROINTESTINAL DISORDERS - 3 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 4 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS - 5 INFECTIONS AND INFESTATIONS - 6 INFECTIONS AND INFESTATIONS - 7 SKIN AND SUBCUTANEOUS TISSUE DISORDERS - 8 SKIN AND SUBCUTANEOUS TISSUE DISORDERS - 9 SKIN AND SUBCUTANEOUS TISSUE DISORDERS - row_label2 var1_Placebo - 1 GASTROINTESTINAL DISORDERS 6 ( 12.8%) - 2 DIARRHOEA 3 ( 6.4%) - 3 GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS 11 ( 23.4%) - 4 APPLICATION SITE PRURITUS 4 ( 8.5%) - 5 INFECTIONS AND INFESTATIONS 5 ( 10.6%) - 6 UPPER RESPIRATORY TRACT INFECTION 4 ( 8.5%) - 7 SKIN AND SUBCUTANEOUS TISSUE DISORDERS 7 ( 14.9%) - 8 ERYTHEMA 4 ( 8.5%) - 9 PRURITUS 3 ( 6.4%) - var1_Xanomeline High Dose var1_Xanomeline Low Dose ord_layer_index - 1 6 ( 7.8%) 3 ( 3.9%) 1 - 2 1 ( 1.3%) 2 ( 2.6%) 1 - 3 21 ( 27.3%) 21 ( 27.6%) 1 - 4 7 ( 9.1%) 5 ( 6.6%) 1 - 5 4 ( 5.2%) 3 ( 3.9%) 1 - 6 1 ( 1.3%) 1 ( 1.3%) 1 - 7 21 ( 27.3%) 26 ( 34.2%) 1 - 8 3 ( 3.9%) 2 ( 2.6%) 1 - 9 8 ( 10.4%) 7 ( 9.2%) 1 - ord_layer_1 ord_layer_2 - 1 3 Inf - 2 3 2 - 3 21 Inf - 4 21 5 - 5 3 Inf - 6 3 1 - 7 26 Inf - 8 26 2 - 9 26 7 - -# denom and distinct_denom values work as expected - - Code - as.data.frame(build(t1)) - Output - row_label1 var1_3 var1_4 var1_5 ord_layer_index - 1 4 1/ 15 ( 6.7) 8/ 12 (66.7) 2/ 5 (40.0) 1 - 2 6 2/ 15 (13.3) 4/ 12 (33.3) 1/ 5 (20.0) 1 - 3 8 12/ 15 (80.0) 0/ 12 ( 0.0) 2/ 5 (40.0) 1 - 4 Missing 0 0 0 1 - 5 Total 15 [100.0] 12 [100.0] 5 [100.0] 1 - ord_layer_1 - 1 8 - 2 4 - 3 0 - 4 0 - 5 12 - ---- - - Code - as.data.frame(build(t2)) - Output - row_label1 var1_3 var1_4 var1_5 ord_layer_index - 1 4 1 1 1 15 2 2 8 12 1 1 2 5 1 - 2 6 1 1 2 15 2 2 4 12 1 1 1 5 1 - 3 8 1 1 12 15 0 2 0 12 1 1 2 5 1 - ord_layer_1 - 1 1 - 2 2 - 3 3 - -# denoms with distinct population data populates as expected - - Code - as.data.frame(tab) - Output - row_label1 var1_Dosed var1_Placebo var1_Total var1_Xanomeline High Dose - 1 Any Body System 93 (55.4%) 32 (37.2%) 125 (49.2%) 43 (51.2%) - var1_Xanomeline Low Dose ord_layer_index ord_layer_1 - 1 50 (59.5%) 1 NA - -# nested count layers error out when you try to add a total row - - i In index: 1. - Caused by error: - ! You can't include total rows in nested counts. Instead, add a seperate layer for total counts. - -# Tables with pop_data can accept a layer level where - - Code - as.data.frame(build(t)) - Output - row_label1 var1_Placebo - 1 ABDOMINAL PAIN 0, [ 0] ( 0.0%) [ 0.0%] - 2 AGITATION 0, [ 0] ( 0.0%) [ 0.0%] - 3 ANXIETY 0, [ 0] ( 0.0%) [ 0.0%] - 4 APPLICATION SITE DERMATITIS 1, [ 1] ( 1.2%) [ 2.1%] - 5 APPLICATION SITE ERYTHEMA 0, [ 0] ( 0.0%) [ 0.0%] - 6 APPLICATION SITE IRRITATION 1, [ 1] ( 1.2%) [ 2.1%] - 7 APPLICATION SITE PAIN 0, [ 0] ( 0.0%) [ 0.0%] - 8 APPLICATION SITE PRURITUS 4, [ 4] ( 4.7%) [ 8.5%] - 9 APPLICATION SITE REACTION 1, [ 1] ( 1.2%) [ 2.1%] - 10 APPLICATION SITE URTICARIA 0, [ 0] ( 0.0%) [ 0.0%] - 11 APPLICATION SITE VESICLES 1, [ 1] ( 1.2%) [ 2.1%] - 12 APPLICATION SITE WARMTH 0, [ 0] ( 0.0%) [ 0.0%] - 13 ATRIAL HYPERTROPHY 1, [ 1] ( 1.2%) [ 2.1%] - 14 BLISTER 0, [ 0] ( 0.0%) [ 0.0%] - 15 BUNDLE BRANCH BLOCK RIGHT 1, [ 1] ( 1.2%) [ 2.1%] - 16 BURNING SENSATION 0, [ 0] ( 0.0%) [ 0.0%] - 17 CARDIAC FAILURE CONGESTIVE 1, [ 1] ( 1.2%) [ 2.1%] - 18 CHILLS 1, [ 2] ( 1.2%) [ 4.3%] - 19 COMPLEX PARTIAL SEIZURES 0, [ 0] ( 0.0%) [ 0.0%] - 20 CONFUSIONAL STATE 1, [ 1] ( 1.2%) [ 2.1%] - 21 CONSTIPATION 1, [ 1] ( 1.2%) [ 2.1%] - 22 CYSTITIS 0, [ 0] ( 0.0%) [ 0.0%] - 23 DERMATITIS CONTACT 0, [ 0] ( 0.0%) [ 0.0%] - 24 DIARRHOEA 2, [ 2] ( 2.3%) [ 4.3%] - 25 DIZZINESS 0, [ 0] ( 0.0%) [ 0.0%] - 26 ELECTROCARDIOGRAM T WAVE INVERSION 1, [ 1] ( 1.2%) [ 2.1%] - 27 EPISTAXIS 0, [ 0] ( 0.0%) [ 0.0%] - 28 ERYTHEMA 3, [ 4] ( 3.5%) [ 8.5%] - 29 FATIGUE 0, [ 0] ( 0.0%) [ 0.0%] - 30 HALLUCINATION, VISUAL 0, [ 0] ( 0.0%) [ 0.0%] - 31 HEART RATE INCREASED 1, [ 1] ( 1.2%) [ 2.1%] - 32 HEART RATE IRREGULAR 1, [ 1] ( 1.2%) [ 2.1%] - 33 HYPERHIDROSIS 0, [ 0] ( 0.0%) [ 0.0%] - 34 HYPONATRAEMIA 1, [ 1] ( 1.2%) [ 2.1%] - 35 HYPOTENSION 0, [ 0] ( 0.0%) [ 0.0%] - 36 INCREASED APPETITE 1, [ 1] ( 1.2%) [ 2.1%] - 37 INFLAMMATION 0, [ 0] ( 0.0%) [ 0.0%] - 38 IRRITABILITY 1, [ 1] ( 1.2%) [ 2.1%] - 39 MALAISE 0, [ 0] ( 0.0%) [ 0.0%] - 40 MYALGIA 0, [ 0] ( 0.0%) [ 0.0%] - 41 MYOCARDIAL INFARCTION 0, [ 0] ( 0.0%) [ 0.0%] - 42 NAUSEA 1, [ 1] ( 1.2%) [ 2.1%] - 43 OEDEMA PERIPHERAL 1, [ 1] ( 1.2%) [ 2.1%] - 44 PRURITUS 3, [ 3] ( 3.5%) [ 6.4%] - 45 PRURITUS GENERALISED 0, [ 0] ( 0.0%) [ 0.0%] - 46 RASH 0, [ 0] ( 0.0%) [ 0.0%] - 47 RASH MACULO-PAPULAR 0, [ 0] ( 0.0%) [ 0.0%] - 48 RASH PRURITIC 0, [ 0] ( 0.0%) [ 0.0%] - 49 SINUS BRADYCARDIA 0, [ 0] ( 0.0%) [ 0.0%] - 50 SKIN EXFOLIATION 0, [ 0] ( 0.0%) [ 0.0%] - 51 SKIN IRRITATION 0, [ 0] ( 0.0%) [ 0.0%] - 52 SUPRAVENTRICULAR EXTRASYSTOLES 1, [ 1] ( 1.2%) [ 2.1%] - 53 SYNCOPE 0, [ 0] ( 0.0%) [ 0.0%] - 54 TACHYCARDIA 1, [ 1] ( 1.2%) [ 2.1%] - 55 TRANSIENT ISCHAEMIC ATTACK 0, [ 0] ( 0.0%) [ 0.0%] - 56 UPPER RESPIRATORY TRACT INFECTION 1, [ 1] ( 1.2%) [ 2.1%] - 57 URTICARIA 0, [ 0] ( 0.0%) [ 0.0%] - 58 VOMITING 0, [ 0] ( 0.0%) [ 0.0%] - 59 WOUND 0, [ 0] ( 0.0%) [ 0.0%] - var1_Xanomeline High Dose var1_Xanomeline Low Dose ord_layer_index - 1 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 2 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 3 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 4 3, [ 3] ( 3.6%) [ 3.9%] 2, [ 2] ( 2.4%) [ 2.6%] 1 - 5 3, [ 3] ( 3.6%) [ 3.9%] 4, [ 4] ( 4.8%) [ 5.3%] 1 - 6 3, [ 4] ( 3.6%) [ 5.2%] 2, [ 2] ( 2.4%) [ 2.6%] 1 - 7 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 8 6, [ 7] ( 7.1%) [ 9.1%] 4, [ 4] ( 4.8%) [ 5.3%] 1 - 9 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 10 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 11 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 12 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 13 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 14 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 2] ( 1.2%) [ 2.6%] 1 - 15 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 16 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 17 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 18 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 19 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 20 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 21 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 22 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 23 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 24 1, [ 1] ( 1.2%) [ 1.3%] 2, [ 2] ( 2.4%) [ 2.6%] 1 - 25 1, [ 1] ( 1.2%) [ 1.3%] 3, [ 4] ( 3.6%) [ 5.3%] 1 - 26 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 27 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 28 3, [ 3] ( 3.6%) [ 3.9%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 29 0, [ 0] ( 0.0%) [ 0.0%] 2, [ 2] ( 2.4%) [ 2.6%] 1 - 30 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 31 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 32 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 33 2, [ 2] ( 2.4%) [ 2.6%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 34 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 35 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 36 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 37 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 38 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 39 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 40 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 41 1, [ 1] ( 1.2%) [ 1.3%] 2, [ 2] ( 2.4%) [ 2.6%] 1 - 42 2, [ 2] ( 2.4%) [ 2.6%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 43 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 44 8, [ 8] ( 9.5%) [ 10.4%] 6, [ 6] ( 7.1%) [ 7.9%] 1 - 45 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 2] ( 1.2%) [ 2.6%] 1 - 46 2, [ 2] ( 2.4%) [ 2.6%] 3, [ 4] ( 3.6%) [ 5.3%] 1 - 47 1, [ 2] ( 1.2%) [ 2.6%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 48 1, [ 1] ( 1.2%) [ 1.3%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 49 1, [ 1] ( 1.2%) [ 1.3%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 50 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 51 1, [ 1] ( 1.2%) [ 1.3%] 3, [ 3] ( 3.6%) [ 3.9%] 1 - 52 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 53 1, [ 1] ( 1.2%) [ 1.3%] 2, [ 2] ( 2.4%) [ 2.6%] 1 - 54 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 55 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - 56 0, [ 0] ( 0.0%) [ 0.0%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 57 1, [ 2] ( 1.2%) [ 2.6%] 1, [ 2] ( 1.2%) [ 2.6%] 1 - 58 2, [ 2] ( 2.4%) [ 2.6%] 0, [ 0] ( 0.0%) [ 0.0%] 1 - 59 0, [ 0] ( 0.0%) [ 0.0%] 1, [ 1] ( 1.2%) [ 1.3%] 1 - ord_layer_1 - 1 1 - 2 2 - 3 3 - 4 4 - 5 5 - 6 6 - 7 7 - 8 8 - 9 9 - 10 10 - 11 11 - 12 12 - 13 15 - 14 17 - 15 19 - 16 20 - 17 21 - 18 23 - 19 24 - 20 25 - 21 26 - 22 30 - 23 32 - 24 33 - 25 34 - 26 35 - 27 36 - 28 37 - 29 40 - 30 42 - 31 44 - 32 45 - 33 47 - 34 49 - 35 50 - 36 51 - 37 52 - 38 54 - 39 55 - 40 56 - 41 57 - 42 60 - 43 63 - 44 65 - 45 66 - 46 67 - 47 68 - 48 69 - 49 72 - 50 73 - 51 74 - 52 76 - 53 78 - 54 79 - 55 80 - 56 82 - 57 84 - 58 87 - 59 88 - -# Regression test to make sure cols produce correct denom - - Code - t - Output - row_label1 var1_0_F var1_0_M - 1 Subjects with at least one event 19 (35.8) [53] 13 (39.4) [33] - 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] - diff --git a/tests/testthat/_snaps/layer.md b/tests/testthat/_snaps/layer.md index 6d6e847c..3311e8c9 100644 --- a/tests/testthat/_snaps/layer.md +++ b/tests/testthat/_snaps/layer.md @@ -22,45 +22,45 @@ Must provide `tplyr_table`, `tplyr_layer`, or `tplyr_subgroup_layer` object from the `tplyr` package. -# `by` must me a string, a variable name, or multiple variables submitted using `dplyr::vars` +# `by` must me a string, a variable name, or multiple variables submitted using `rlang::quos` - Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `~list("a", "b")`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `~list("a", "b")`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `~c("a", "b")`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `~c("a", "b")`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. -# `target_var` must me a string, a variable name, or multiple variables submitted using `dplyr::vars` +# `target_var` must me a string, a variable name, or multiple variables submitted using `rlang::quos` - Invalid input to `target_var`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `target_var`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `~list("a", "b")`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `~list("a", "b")`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `~c("a", "b")`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `~c("a", "b")`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `target_var`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `target_var`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `target_var`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `target_var`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. # `target_var` must exist in target dataset diff --git a/tests/testthat/_snaps/meta_utils.md b/tests/testthat/_snaps/meta_utils.md index cf86e38e..9a374047 100644 --- a/tests/testthat/_snaps/meta_utils.md +++ b/tests/testthat/_snaps/meta_utils.md @@ -20,7 +20,7 @@ --- - add_cols must be provided using `dplyr::vars()` + add_cols must be provided using `rlang::quos()` --- diff --git a/tests/testthat/_snaps/properties_layer.md b/tests/testthat/_snaps/properties_layer.md index 71b6a457..572b8877 100644 --- a/tests/testthat/_snaps/properties_layer.md +++ b/tests/testthat/_snaps/properties_layer.md @@ -1,22 +1,22 @@ # target_var errors raise appropriately - Invalid input to `target_var`. Submit either a variable name or multiple variable names using `dplyr::vars`. + Invalid input to `target_var`. Submit either a variable name or multiple variable names using `rlang::quos`. --- - Invalid input to `~quos(filter = Species2)`. Submit either a variable name or multiple variable names using `dplyr::vars`. + Invalid input to `~quos(filter = Species2)`. Submit either a variable name or multiple variable names using `rlang::quos`. # by raises expected errors - Invalid input to `~list(Species)`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `~list(Species)`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. --- - Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `dplyr::vars`. + Invalid input to `by`. Submit either a string, a variable name, or multiple variable names using `rlang::quos`. # where throws errors as expected diff --git a/tests/testthat/test-count.R b/tests/testthat/test-count.R index c61f0d29..fc2a704a 100644 --- a/tests/testthat/test-count.R +++ b/tests/testthat/test-count.R @@ -32,25 +32,25 @@ c1 <- group_count(t1, cyl) # Add in by c2 <- group_count(t2, cyl, by = am) # Add in multiple bys -c3 <- group_count(t3, cyl, by = vars(am, vs)) +c3 <- group_count(t3, cyl, by = quos(am, vs)) # Multiple bys and different f_str -c4 <- group_count(t4, cyl, by = vars(am, vs)) %>% +c4 <- group_count(t4, cyl, by = quos(am, vs)) %>% set_format_strings(f_str("xxx", n)) # Multiple bys and total row -c5 <- group_count(t5, cyl, by = vars(am, vs)) %>% +c5 <- group_count(t5, cyl, by = quos(am, vs)) %>% add_total_row() %>% set_denoms_by(gear) # Add distinct by c6 <- group_count(t6, cyl) %>% set_distinct_by(cyl) # Multiple target_vars -c7 <- group_count(t7, vars(cyl, grp)) +c7 <- group_count(t7, quos(cyl, grp)) # Distinct count and Event count c8 <- group_count(t8, cyl) %>% set_format_strings(f_str("xx (xx.x%) [xx]", n, pct, distinct_n)) %>% set_distinct_by(am) # Change indentation -c9 <- group_count(t9, vars(cyl, grp)) %>% +c9 <- group_count(t9, quos(cyl, grp)) %>% set_indentation("") # Change row prefix c10 <- group_count(t10, cyl) %>% @@ -63,18 +63,18 @@ c12 <- group_count(t12, cyl) %>% set_format_strings(f_str("xx (xx.x%) [xx]", n, pct, distinct_n)) %>% set_result_order_var(distinct_n) %>% set_distinct_by(am) -c13 <- group_count(t13, vars(cyl, grp), by = "Test") -c14 <- group_count(t14, vars(cyl, grp)) %>% +c13 <- group_count(t13, quos(cyl, grp), by = "Test") +c14 <- group_count(t14, quos(cyl, grp)) %>% set_outer_sort_position("asc") c15 <- group_count(t15, cyl) %>% - set_distinct_by(vars(am, vs)) + set_distinct_by(quos(am, vs)) c16 <- group_count(t16, cyl) %>% - set_distinct_by(vars(am,vs)) + set_distinct_by(quos(am,vs)) #Check for warning with by, total row and no denom_by -c17 <- group_count(t17, cyl, by = vars(am, vs)) %>% +c17 <- group_count(t17, cyl, by = quos(am, vs)) %>% add_total_row() # Warning shouldn't raise here because they are both strings -c18 <- group_count(t18, cyl, by = vars("am", "vs")) %>% +c18 <- group_count(t18, cyl, by = quos("am", "vs")) %>% add_total_row() c19 <- group_count(t19, cyl, by = am) %>% set_denoms_by(am) %>% @@ -479,7 +479,7 @@ test_that("distinct is changed to distinct_n with a warning", { test_that("Nested count layers can accept text values in the first variable", { t <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars("All Cyl", cyl)) + group_count(quos("All Cyl", cyl)) ) expect_silent(build(t)) @@ -497,14 +497,14 @@ test_that("Nested count layers can accept text values in the first variable", { t2 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars(cyl, "Txt")) + group_count(quos(cyl, "Txt")) ) expect_snapshot_error(build(t2)) mtcars$cyl <- factor(as.character(mtcars$cyl), c("4", "6", "8", "25")) t2 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars("all cyl", cyl)) + group_count(quos("all cyl", cyl)) ) %>% build() @@ -522,7 +522,7 @@ test_that("Variable names will be coersed into symbols", { t2 <- tplyr_table(mtcars2, gear) %>% add_layer( - group_count(vars("all cyl", "cyl")) + group_count(quos("all cyl", "cyl")) ) expect_snapshot_warning(build(t2)) }) @@ -531,7 +531,7 @@ test_that("nested count layers can be built with character value in first positi suppressWarnings({ t1 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars("all_cyl", cyl)) %>% + group_count(quos("all_cyl", cyl)) %>% add_risk_diff( c("4", "5"), c("3", "5") @@ -557,7 +557,7 @@ test_that("keep_levels works as expeceted", { build() t2 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars("all cyl", cyl)) %>% + group_count(quos("all cyl", cyl)) %>% keep_levels("8") %>% set_format_strings(f_str("xxx (xxx%)", n, pct)) ) %>% @@ -580,7 +580,7 @@ test_that("keep_levels works as expeceted", { mtcars$grp <- paste0("grp.", as.numeric(mtcars$cyl) + rep(c(0, 0.5), 16)) t4 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars(cyl, grp)) %>% + group_count(quos(cyl, grp)) %>% keep_levels("nothere") ) expect_snapshot_error(build(t4)) @@ -592,7 +592,7 @@ test_that("nested count layers can be built with restrictive where logic", { t <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars(cyl, grp), where = grp == "grp.8.5") %>% + group_count(quos(cyl, grp), where = grp == "grp.8.5") %>% set_nest_count(TRUE) %>% set_order_count_method('bycount') %>% set_ordering_cols("3") @@ -610,14 +610,14 @@ test_that("nested count layers handle `set_denoms_by` as expected", { expect_snapshot_error({ t1 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars(cyl,grp)) %>% + group_count(quos(cyl,grp)) %>% set_denoms_by(grp) ) }) t2 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars(cyl,grp)) %>% + group_count(quos(cyl,grp)) %>% set_denoms_by(cyl) ) %>% build() @@ -629,7 +629,7 @@ test_that("nested count layers handle `set_denoms_by` as expected", { t3 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars(cyl,grp)) %>% + group_count(quos(cyl,grp)) %>% set_denoms_by(cyl, gear) ) %>% build() @@ -645,7 +645,7 @@ test_that("nested count layers handle `set_denoms_by` as expected", { # Denom for cyl == 4 is 11 tplyr_table(mtcars, gear, cols=vs) %>% add_layer( - group_count(vars(cyl,grp)) %>% + group_count(quos(cyl,grp)) %>% set_denoms_by(cyl) ) %>% build() %>% @@ -657,7 +657,7 @@ test_that("nested count layers handle `set_denoms_by` as expected", { # Denom for gear == 3, vs = 0 is 12 tplyr_table(mtcars, gear, cols=vs) %>% add_layer( - group_count(vars(cyl,grp)) + group_count(quos(cyl,grp)) ) %>% build() %>% as.data.frame() @@ -716,7 +716,7 @@ test_that("nested count layers will error out if second variable is bigger than t <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(vars(grp, cyl)) + group_count(quos(grp, cyl)) ) expect_snapshot_error(build(t)) @@ -816,7 +816,7 @@ test_that("set_numeric_threshold works as expected", { t7 <- adae %>% tplyr_table(TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) %>% + group_count(quos(AEBODSYS, AEDECOD)) %>% set_numeric_threshold(3, "n", "Placebo") ) @@ -825,7 +825,7 @@ test_that("set_numeric_threshold works as expected", { t8 <- adae %>% tplyr_table(TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) %>% + group_count(quos(AEBODSYS, AEDECOD)) %>% set_numeric_threshold(3, "n", "Placebo") %>% set_order_count_method("bycount") ) @@ -881,7 +881,7 @@ test_that("nested count layers error out when you try to add a total row", { # GH issue 92 tab <- tplyr_table(mtcars, am) %>% add_layer( - group_count(vars(cyl, grp)) %>% + group_count(quos(cyl, grp)) %>% add_total_row() ) diff --git a/tests/testthat/test-desc.R b/tests/testthat/test-desc.R index 3105340a..ac063d08 100644 --- a/tests/testthat/test-desc.R +++ b/tests/testthat/test-desc.R @@ -14,15 +14,15 @@ t8 <- tplyr_table(mtcars, gear, cols=vs) d1 <- group_desc(t1, mpg) d2 <- group_desc(t2, mpg, by = am) -d3 <- group_desc(t3, mpg, by = vars(am, vs)) +d3 <- group_desc(t3, mpg, by = quos(am, vs)) d4 <- group_desc(t4, mpg) %>% set_custom_summaries(mean_squared = mean(.var, na.rm=TRUE)**2) %>% set_format_strings( "Mean Squared" = f_str("xx.xx", mean_squared) ) -d5 <- group_desc(t5, vars(mpg, wt)) +d5 <- group_desc(t5, quos(mpg, wt)) # Update for custom summaries - two target variables -d6 <- group_desc(t6, vars(mpg, wt)) %>% +d6 <- group_desc(t6, quos(mpg, wt)) %>% set_custom_summaries(mean_squared = mean(.var, na.rm=TRUE)**2) %>% set_format_strings( "Mean Squared" = f_str("xx.xx", mean_squared) @@ -104,7 +104,7 @@ test_that("Stats as columns properly transposes the built data", { t1 <- tplyr_table(mtcars, gear) %>% add_layer( - group_desc(vars(wt, drat)) %>% + group_desc(quos(wt, drat)) %>% set_format_strings( "n" = f_str("xx", n), "sd" = f_str("xx.x", sd, empty = c(.overall = "BLAH")) @@ -124,7 +124,7 @@ test_that("Stats as columns properly transposes the built data", { # Check that cols evaluate properly as well t2 <- tplyr_table(mtcars, gear, cols=am) %>% add_layer( - group_desc(vars(wt, drat)) %>% + group_desc(quos(wt, drat)) %>% set_format_strings( "n" = f_str("xx", n), "sd" = f_str("xx.x", sd, empty = c(.overall = "BLAH")) diff --git a/tests/testthat/test-functional.R b/tests/testthat/test-functional.R index 0b224b82..77b1c5cd 100644 --- a/tests/testthat/test-functional.R +++ b/tests/testthat/test-functional.R @@ -31,7 +31,7 @@ t3 <- tplyr_table(mtcars, gear) %>% ##### T4 Complex desc layer ##### t4 <- tplyr_table(mtcars, gear) %>% add_layer( - group_desc(mpg, by = vars("am", am)) %>% + group_desc(mpg, by = quos("am", am)) %>% set_format_strings( "n" = f_str("xx", n), "Mean (SD)"= f_str("xx.x", mean), @@ -70,10 +70,10 @@ t6 <- tplyr_table(mtcars, gear, col = am) %>% add_total_group() %>% set_where(mpg > 15) %>% add_layer( - group_count(carb, by = vars("Carb count", vs)) + group_count(carb, by = quos("Carb count", vs)) ) %>% add_layer( - group_count(cyl, by = vars(vs, carb)) %>% + group_count(cyl, by = quos(vs, carb)) %>% set_format_strings(f_str("xxx", n)) ) %>% add_layer( diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R index cb4dfd83..950e08a6 100644 --- a/tests/testthat/test-layer.R +++ b/tests/testthat/test-layer.R @@ -61,32 +61,32 @@ test_that("Parent must be a `tplyr_table`, `tplyr_layer`, or `tplyr_subgroup_lay expect_snapshot_error(group_count(env())) }) -test_that("`by` must me a string, a variable name, or multiple variables submitted using `dplyr::vars`", { +test_that("`by` must me a string, a variable name, or multiple variables submitted using `rlang::quos`", { t <- tplyr_table(iris, Sepal.Width) # Safe checks expect_silent(group_count(t, target_var=Species, by="character")) expect_silent(group_count(t, target_var=Species, by=Petal.Width)) - expect_silent(group_count(t, target_var=Species, by=vars('character', Petal.Width))) + expect_silent(group_count(t, target_var=Species, by=quos('character', Petal.Width))) # Error checks expect_snapshot_error(group_count(t, target_var=Species, by=1)) expect_snapshot_error(group_count(t, target_var=Species, by=list('a', 'b'))) expect_snapshot_error(group_count(t, target_var=Species, by=c('a', 'b'))) - expect_snapshot_error(group_count(t, target_var=Species, by=vars('character', Petal.Width, 1))) - expect_snapshot_error(group_count(t, target_var=Species, by=vars('character', Petal.Width, x+y))) + expect_snapshot_error(group_count(t, target_var=Species, by=quos('character', Petal.Width, 1))) + expect_snapshot_error(group_count(t, target_var=Species, by=quos('character', Petal.Width, x+y))) }) -test_that("`target_var` must me a string, a variable name, or multiple variables submitted using `dplyr::vars`", { +test_that("`target_var` must me a string, a variable name, or multiple variables submitted using `rlang::quos`", { t <- tplyr_table(iris, Sepal.Width) # Safe checks expect_silent(group_count(t, target_var=Species)) - expect_silent(group_count(t, target_var=vars(Petal.Width, Petal.Length))) + expect_silent(group_count(t, target_var=quos(Petal.Width, Petal.Length))) # Error checks expect_snapshot_error(group_count(t, target_var=1)) expect_snapshot_error(group_count(t, target_var=list('a', 'b'))) expect_snapshot_error(group_count(t, target_var=c('a', 'b'))) - expect_snapshot_error(group_count(t, target_var=vars('character', Petal.Width, 1))) - expect_snapshot_error(group_count(t, target_var=vars('character', Petal.Width, x+y))) + expect_snapshot_error(group_count(t, target_var=quos('character', Petal.Width, 1))) + expect_snapshot_error(group_count(t, target_var=quos('character', Petal.Width, x+y))) }) @@ -96,13 +96,13 @@ test_that("`target_var` must exist in target dataset", { expect_silent(group_count(t, target_var=Species)) # Variable does not expect_snapshot_error(group_count(t, target_var=BadVar)) - expect_snapshot_error(group_count(t, target_var=vars(Species, BadVar))) + expect_snapshot_error(group_count(t, target_var=quos(Species, BadVar))) }) test_that("`by` varaibles must exist in the target dataset", { t <- tplyr_table(iris, Sepal.Width) expect_snapshot_error(group_count(t, target_var=Species, by=BadVars)) - expect_snapshot_error(group_count(t, target_var=Species, by=vars(Species, BadVars))) + expect_snapshot_error(group_count(t, target_var=Species, by=quos(Species, BadVars))) }) test_that("`where` must be programming logic (quosure of class 'call')", { @@ -149,13 +149,13 @@ test_that("Desc layers only accept numeric variables", { expect_snapshot_error({tplyr_table(ToothGrowth, dose) %>% add_layer( - group_desc(vars(len, supp)) + group_desc(quos(len, supp)) ) }) expect_snapshot_error({tplyr_table(ToothGrowth, dose) %>% add_layer( - group_desc(vars(supp, len)) + group_desc(quos(supp, len)) ) }) diff --git a/tests/testthat/test-layer_templates.R b/tests/testthat/test-layer_templates.R index 12bb30a2..567beaf3 100644 --- a/tests/testthat/test-layer_templates.R +++ b/tests/testthat/test-layer_templates.R @@ -102,7 +102,7 @@ test_that("Template errors correctly upon execution", { expect_snapshot_error( tplyr_table(adsl, TRT01P) %>% add_layer( - use_template('test2', RACE, add_params = vars(USUBJID)) + use_template('test2', RACE, add_params = quos(USUBJID)) ) ) @@ -135,7 +135,7 @@ test_that("Template errors correctly upon execution", { use_template('test2', RACE, add_params = list( sort_meth = "bycount", sort_col = Placebo, - test = vars(a, b, c) + test = quos(a, b, c) )) ) ) diff --git a/tests/testthat/test-meta.R b/tests/testthat/test-meta.R index 3400c209..b750bb0e 100644 --- a/tests/testthat/test-meta.R +++ b/tests/testthat/test-meta.R @@ -57,7 +57,7 @@ t2 <- tplyr_table(adae, TRTA) %>% ) ) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) + group_count(quos(AEBODSYS, AEDECOD)) ) dat2 <- suppressWarnings(t2 %>% build(metadata=TRUE)) @@ -65,7 +65,7 @@ dat2 <- suppressWarnings(t2 %>% build(metadata=TRUE)) # Table to test out character outer for count layers t3 <- tplyr_table(adsl, TRT01A) %>% add_layer( - group_count(vars("Outer string", RACE)) + group_count(quos("Outer string", RACE)) ) dat3 <- t3 %>% @@ -74,7 +74,7 @@ dat3 <- t3 %>% # Table for testing of Shift layers t4 <- tplyr_table(adlb, TRTA, where = AVISIT != "") %>% add_layer( - group_shift(vars(row = BNRIND, column=ANRIND), by=AVISIT) + group_shift(quos(row = BNRIND, column=ANRIND), by=AVISIT) ) dat4 <- t4 %>% diff --git a/tests/testthat/test-num_fmt.R b/tests/testthat/test-num_fmt.R index a6d0b075..d12fbb30 100644 --- a/tests/testthat/test-num_fmt.R +++ b/tests/testthat/test-num_fmt.R @@ -67,7 +67,7 @@ test_that("Hug character formatting applies properly for desc layers", { # Single hug character, desc layer, manual x <- tplyr_table(y, TRTA) %>% add_layer( - group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% + group_desc(AVAL, by=quos(PARAMCD, AVISIT)) %>% set_format_strings( TEST = f_str("xxx.x (XX.x)", mean, sd, empty="NA") ) %>% @@ -81,7 +81,7 @@ test_that("Hug character formatting applies properly for desc layers", { # Multi hug character, desc layer, manual x <- tplyr_table(y, TRTA) %>% add_layer( - group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% + group_desc(AVAL, by=quos(PARAMCD, AVISIT)) %>% set_format_strings( TEST = f_str("xxx.x {(XX.x)}", mean, sd, empty="NA") ) %>% @@ -95,7 +95,7 @@ test_that("Hug character formatting applies properly for desc layers", { # Single hug character, desc layer, auto x <- tplyr_table(y, TRTA) %>% add_layer( - group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% + group_desc(AVAL, by=quos(PARAMCD, AVISIT)) %>% set_format_strings( TEST = f_str("xxx.x (A.x)", mean, sd, empty="NA") ) %>% @@ -109,7 +109,7 @@ test_that("Hug character formatting applies properly for desc layers", { # Multi hug character, desc layer, auto x <- tplyr_table(y, TRTA) %>% add_layer( - group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% + group_desc(AVAL, by=quos(PARAMCD, AVISIT)) %>% set_format_strings( TEST = f_str("xxx.x {(A.x)}", mean, sd, empty="NA") ) %>% @@ -126,7 +126,7 @@ test_that("Hug character formatting applies properly for shift layers", { # Shift layer, single hug char, manual and auto x <- tplyr_table(adlb, TRTA, where=VISIT %in% c("SCREENING 1", "UNSCHEDULED 1.1")) %>% add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) %>% + group_shift(quos(row = BNRIND, column = ANRIND), by = quos(PARAM, VISIT)) %>% set_format_strings(f_str("(A) (XXX.x%)", n, pct)) ) %>% build() %>% @@ -137,7 +137,7 @@ test_that("Hug character formatting applies properly for shift layers", { # Shift layer, multi hug char, manual and auto x <- tplyr_table(adlb, TRTA, where=VISIT %in% c("SCREENING 1", "UNSCHEDULED 1.1")) %>% add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) %>% + group_shift(quos(row = BNRIND, column = ANRIND), by = quos(PARAM, VISIT)) %>% set_format_strings(f_str("((A)) {(XXX.x%)}", n, pct)) ) %>% build() %>% diff --git a/tests/testthat/test-opts.R b/tests/testthat/test-opts.R index 388e2dde..52fbce22 100644 --- a/tests/testthat/test-opts.R +++ b/tests/testthat/test-opts.R @@ -437,7 +437,7 @@ test_that("Quantile switch works properly", { test_that("Shift layer defaults are created as expected", { t <- tplyr_table(mtcars, gear) - s1 <- group_shift(t, vars(row = cyl, column = mpg)) + s1 <- group_shift(t, quos(row = cyl, column = mpg)) expect_equal(gather_defaults(s1)[[1]], f_str("a", n)) }) @@ -451,7 +451,7 @@ test_that("Shift layer defaults can be changed" ,{ t <- tplyr_table(mtcars, gear) - s1 <- group_shift(t, vars(row = cyl, column = mpg)) + s1 <- group_shift(t, quos(row = cyl, column = mpg)) expect_equal(gather_defaults(s1)[[1]], f_str("xxxx (xxxx.xxx%) *****", n, pct)) @@ -463,7 +463,7 @@ test_that("Shift layer defaults can be changed" ,{ test_that("Shift layer defaults can be overridden", { t <- tplyr_table(mtcars, gear) - s1 <- group_shift(t, vars(row = cyl, column = mpg)) %>% + s1 <- group_shift(t, quos(row = cyl, column = mpg)) %>% set_format_strings(f_str("xx (xx.xx%)", n, pct)) expect_equal(gather_defaults(s1)[[1]], f_str("a", n)) diff --git a/tests/testthat/test-properties_layer.R b/tests/testthat/test-properties_layer.R index e30566fc..b5a0c18f 100644 --- a/tests/testthat/test-properties_layer.R +++ b/tests/testthat/test-properties_layer.R @@ -33,7 +33,7 @@ test_that("by binds as expected", { set_by(tab, Species2) expect_equal(get_by(tab), quos(Species2)) - set_by(tab, vars(Species2, Sepal.Width)) + set_by(tab, quos(Species2, Sepal.Width)) expect_equal(unname(map_chr(get_by(tab), as_name)), c("Species2", "Sepal.Width")) }) @@ -42,8 +42,8 @@ test_that("by raises expected errors", { group_count(Species) expect_snapshot_error(set_by(tab, list(Species))) - expect_snapshot_error(set_by(tab, vars(Species, list()))) - expect_snapshot_error(set_by(tab, vars(Species, 2))) + expect_snapshot_error(set_by(tab, quos(Species, list()))) + expect_snapshot_error(set_by(tab, quos(Species, 2))) }) ##### where tests ##### diff --git a/tests/testthat/test-shift.R b/tests/testthat/test-shift.R index 7d31bc02..7dcb3ae5 100644 --- a/tests/testthat/test-shift.R +++ b/tests/testthat/test-shift.R @@ -12,15 +12,15 @@ t4 <- tplyr_table(mtcars2, gear) t5 <- tplyr_table(mtcars, gear) -s1 <- group_shift(t1, vars(row = cyl, column = cyl2)) %>% +s1 <- group_shift(t1, quos(row = cyl, column = cyl2)) %>% set_format_strings(f_str("a", n)) -s2 <- group_shift(t2, vars(row = cyl, column = cyl2)) %>% +s2 <- group_shift(t2, quos(row = cyl, column = cyl2)) %>% set_format_strings(f_str("a (xx.xx%)", n, pct)) -s3 <- group_shift(t3, vars(row = cyl, column = cyl2)) %>% +s3 <- group_shift(t3, quos(row = cyl, column = cyl2)) %>% set_format_strings(f_str("a (xx.xx%)", n, pct)) %>% set_denoms_by(cyl) -s4 <- group_shift(t4, vars(row = cyl, column = cyl2)) -s5 <- group_shift(t5, vars(row = cyl, column = cyl2)) %>% +s4 <- group_shift(t4, quos(row = cyl, column = cyl2)) +s5 <- group_shift(t5, quos(row = cyl, column = cyl2)) %>% set_denom_where(vs == 1) %>% set_format_strings(f_str("xx (xx.x%)", n, pct)) @@ -73,7 +73,7 @@ test_that("group_shift outputs the expected formatted data", { test_that("Shift layer clauses with invalid syntax give informative error", { t <- tplyr_table(mtcars, gear) %>% add_layer( - group_shift(vars(row=vs, column=am), where=bad == code) + group_shift(quos(row=vs, column=am), where=bad == code) ) expect_snapshot_error(build(t)) diff --git a/tests/testthat/test-sort.R b/tests/testthat/test-sort.R index c77458dd..bb40b320 100644 --- a/tests/testthat/test-sort.R +++ b/tests/testthat/test-sort.R @@ -22,7 +22,7 @@ test_that("A group_count layer can be ordered properly with factors", { t3 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(cyl, by = vars(am, vs)) + group_count(cyl, by = quos(am, vs)) ) b_t3 <- build(t3) %>% arrange(ord_layer_1, ord_layer_2, ord_layer_3) @@ -38,7 +38,7 @@ test_that("A group_count layer can be ordered properly with factors", { test_that("A group_count layer can be ordered properly by counts", { t1 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(cyl, by = vars(am,vs)) %>% + group_count(cyl, by = quos(am,vs)) %>% set_order_count_method("bycount") ) b_t1 <- build(t1) %>% @@ -56,7 +56,7 @@ test_that("A group_count layer can be ordered properly by counts", { t2 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(cyl, by = vars(am, vs)) %>% + group_count(cyl, by = quos(am, vs)) %>% set_order_count_method("bycount") %>% set_ordering_cols("3") ) @@ -79,7 +79,7 @@ test_that("A group_count layer can be ordered properly by a VARN", { mtcars$cylN <- mtcars$cyl t1 <- tplyr_table(mtcars, gear) %>% add_layer( - group_count(cyl, by = vars(vs, am)) %>% + group_count(cyl, by = quos(vs, am)) %>% set_order_count_method("byvarn") ) b_t1 <- build(t1) %>% @@ -102,20 +102,20 @@ test_that("A nested group_count layer can be ordered properly", { t <- tplyr_table(iris, treat) %>% add_layer( - group_count(vars(Species, grp)) + group_count(quos(Species, grp)) ) b_t <- build(t) t2 <- tplyr_table(iris, treat) %>% add_layer( - group_count(vars(Species, grp)) %>% + group_count(quos(Species, grp)) %>% set_order_count_method("bycount", break_ties = "asc") ) b_t2 <- build(t2) t3 <- tplyr_table(iris, treat) %>% add_layer( - group_count(vars(Species, grp)) %>% + group_count(quos(Species, grp)) %>% set_order_count_method("bycount", break_ties = "desc") ) b_t3 <- build(t3) @@ -152,7 +152,7 @@ adsl1 <- tplyr_table(adsl, TRT01A, cols = AGEGR1) %>% add_total_group() %>% add_treat_grps("T1&T2" = c("Xanomeline High Dose", "Xanomeline Low Dose")) %>% add_layer( - group_count(vars(EOSSTT, DCDECOD)) %>% + group_count(quos(EOSSTT, DCDECOD)) %>% set_ordering_cols(Placebo, `65-80`) %>% set_result_order_var(n) %>% set_order_count_method(c("byvarn", "byvarn")) @@ -169,7 +169,7 @@ adsl2 <- tplyr_table(adsl, TRT01A, cols = AGEGR1) %>% add_total_group() %>% add_treat_grps("T1&T2" = c("Xanomeline High Dose", "Xanomeline Low Dose")) %>% add_layer( - group_count(vars(EOSSTT, DCDECOD)) %>% + group_count(quos(EOSSTT, DCDECOD)) %>% set_ordering_cols(Placebo, `65-80`) %>% set_result_order_var(n) %>% set_order_count_method(c("bycount", "bycount")) @@ -186,7 +186,7 @@ adsl3 <- tplyr_table(adsl, TRT01A, cols = AGEGR1) %>% add_total_group() %>% add_treat_grps("T1&T2" = c("Xanomeline High Dose", "Xanomeline Low Dose")) %>% add_layer( - group_count(vars(EOSSTT, DCDECOD)) %>% + group_count(quos(EOSSTT, DCDECOD)) %>% set_ordering_cols(Placebo, `65-80`) %>% set_result_order_var(n) %>% set_order_count_method(c("byfactor", "byfactor")) diff --git a/uat/test_cases.R b/uat/test_cases.R index 1735a878..03d27bab 100644 --- a/uat/test_cases.R +++ b/uat/test_cases.R @@ -379,12 +379,12 @@ test_that('T9',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adsl, TRT01P) %>% add_layer( - group_count(vars(EOSSTT, DCDECOD)) %>% + group_count(quos(EOSSTT, DCDECOD)) %>% set_format_strings(f_str("xxx", n)) %>% keep_levels("COMPLETED", "DEATH") ) %>% add_layer( - group_count(vars("Discontinuation", DCDECOD)) %>% + group_count(quos("Discontinuation", DCDECOD)) %>% set_format_strings(f_str("xxx", n)) %>% keep_levels("COMPLETED", "DEATH") ) @@ -1119,7 +1119,7 @@ test_that('T20',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adae, TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) %>% + group_count(quos(AEBODSYS, AEDECOD)) %>% add_risk_diff(c('Xanomeline High Dose','Placebo')) ) %>% add_layer( @@ -1127,19 +1127,19 @@ test_that('T20',{ add_risk_diff(c('Xanomeline High Dose','Placebo')) ) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD), by = SEX) %>% + group_count(quos(AEBODSYS, AEDECOD), by = SEX) %>% add_risk_diff(c('Xanomeline High Dose','Placebo')) ) %>% add_layer( - group_count(vars("CODED TERM", AEDECOD)) %>% + group_count(quos("CODED TERM", AEDECOD)) %>% add_risk_diff(c('Xanomeline High Dose','Placebo')) ) %>% add_layer( - group_count(vars("CODED TERM", AEDECOD), by = SEX) %>% + group_count(quos("CODED TERM", AEDECOD), by = SEX) %>% add_risk_diff(c('Xanomeline High Dose','Placebo')) ) %>% add_layer( - group_count(vars("CODED TERM", AEDECOD), by = "TERMED") %>% + group_count(quos("CODED TERM", AEDECOD), by = "TERMED") %>% add_risk_diff(c('Xanomeline High Dose','Placebo')) ) @@ -1817,7 +1817,7 @@ test_that('T29',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adlb, TRTA, where=(PARAMCD == "BILI" & AVISIT == "Week 2")) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND), where=(ANRIND != "" & BNRIND != "")) %>% + group_shift(quos(row=ANRIND, column=BNRIND), where=(ANRIND != "" & BNRIND != "")) %>% set_format_strings(f_str("xxx (xxx.x%)", n, pct)) ) @@ -1876,7 +1876,7 @@ test_that('T30',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adlb, TRTA, where=(PARAMCD == "BILI" & AVISIT == "Week 2" & ANRIND != "" & BNRIND != "")) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND), by=SEX) + group_shift(quos(row=ANRIND, column=BNRIND), by=SEX) ) build(t) test_30 <- get_numeric_data(t)[[1]] @@ -1918,7 +1918,7 @@ test_that('T31',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adlb, TRTA, where=(PARAMCD == "BILI" & AVISIT == "Week 2" & ANRIND != "" & BNRIND != "")) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND), by=vars(RACE, SEX)) + group_shift(quos(row=ANRIND, column=BNRIND), by=quos(RACE, SEX)) ) build(t) test_31 <- get_numeric_data(t)[[1]] @@ -1960,7 +1960,7 @@ test_that('T32',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adlb, TRTA, where=(PARAMCD == "BILI" & AVISIT == "Week 2")) %>% add_layer( - group_shift(vars(row=ANRIND_FACTOR, column=BNRIND_FACTOR), where=(ANRIND != "" & BNRIND != "")) %>% + group_shift(quos(row=ANRIND_FACTOR, column=BNRIND_FACTOR), where=(ANRIND != "" & BNRIND != "")) %>% set_format_strings(f_str("xxx (xxx.x%)", n, pct)) %>% set_denom_where(TRUE) ) @@ -2020,7 +2020,7 @@ test_that('T33',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adlb, TRTA, where=(PARAMCD == "BILI" & AVISIT == "Week 2" & ANRIND != "" & BNRIND != "")) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND)) %>% + group_shift(quos(row=ANRIND, column=BNRIND)) %>% set_format_strings(f_str("xxx (xxx.x%)",n,pct)) ) @@ -2074,7 +2074,7 @@ test_that('T34',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adlb, TRTA) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND)) %>% + group_shift(quos(row=ANRIND, column=BNRIND)) %>% set_format_strings(f_str("xxx (xxx.x%)",n,pct)) ) @@ -2126,7 +2126,7 @@ test_that('T35',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adlb, TRTA, where=(PARAMCD == "BILI" & AVISIT == "Week 2" & ANRIND != "" & BNRIND != "")) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND)) %>% + group_shift(quos(row=ANRIND, column=BNRIND)) %>% set_format_strings(f_str("xxx (xxx.x%)",n,pct)) ) @@ -2180,7 +2180,7 @@ test_that('T36',{ set_pop_data(adsl) %>% set_pop_treat_var(TRT01P) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND), + group_shift(quos(row=ANRIND, column=BNRIND), where=(PARAMCD == "BILI" & AVISIT == "Week 2")) %>% set_format_strings(f_str("xxx (xxx.x%)",n,pct)) ) @@ -2236,7 +2236,7 @@ test_that('T37',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adlb, TRTA) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND), by=vars(PARAMCD, AVISIT)) %>% + group_shift(quos(row=ANRIND, column=BNRIND), by=quos(PARAMCD, AVISIT)) %>% set_format_strings(f_str("xxx (xxx.x%)",n,pct)) %>% set_denoms_by(TRTA, PARAMCD, AVISIT) ) @@ -2328,7 +2328,7 @@ test_that('T39',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adsl, TRT01P) %>% add_layer( - group_count(RACE, by = vars("Ethnicity", ETHNIC, "Race")) + group_count(RACE, by = quos("Ethnicity", ETHNIC, "Race")) ) test_39 <- build(t) @@ -2744,7 +2744,7 @@ test_that('T46',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adae, TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD), where = (AOCC02FL == 'Y')) %>% + group_count(quos(AEBODSYS, AEDECOD), where = (AOCC02FL == 'Y')) %>% set_order_count_method("bycount") %>% set_ordering_cols("Xanomeline High Dose") ) @@ -3083,10 +3083,10 @@ test_that('T50',{ t <- tplyr_table(adlb, TRTA, where=(PARAMCD == "BILI" & AVISIT == "Week 2" & ANRIND != "" & BNRIND != "")) %>% set_shift_layer_formats(f_str('xxxx (xxx.x%)',n,pct)) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND)) + group_shift(quos(row=ANRIND, column=BNRIND)) ) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND)) %>% + group_shift(quos(row=ANRIND, column=BNRIND)) %>% set_format_strings(f_str("xxx",n)) ) @@ -3285,7 +3285,7 @@ test_that('T53',{ t <- tplyr_table(adlb, TRTA, where=(PARAMCD == "BILI" & AVISIT == "Week 2" & ANRIND != "" & BNRIND != "")) %>% add_layer( - group_shift(vars(row=ANRIND, column=BNRIND)) + group_shift(quos(row=ANRIND, column=BNRIND)) ) test_53 <- build(t) @@ -3694,7 +3694,7 @@ test_that('T60',{ #outputs should be sent to "~/uat/output" folder t <- tplyr_table(adae, TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) %>% + group_count(quos(AEBODSYS, AEDECOD)) %>% set_format_strings(f_str('xxx', n)) ) %>% build() %>% @@ -3831,7 +3831,7 @@ test_that('T62',{ set_pop_treat_var(TRT01P) %>% set_distinct_by(USUBJID) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) %>% + group_count(quos(AEBODSYS, AEDECOD)) %>% add_risk_diff(c('Treated','Placebo')) ) @@ -3918,7 +3918,7 @@ test_that('T63',{ set_pop_treat_var(TRT01P) %>% set_distinct_by(USUBJID) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) %>% + group_count(quos(AEBODSYS, AEDECOD)) %>% add_risk_diff(c('Treated','Placebo')) ) diff --git a/vignettes/Tplyr.Rmd b/vignettes/Tplyr.Rmd index 5c2068b9..9921747a 100644 --- a/vignettes/Tplyr.Rmd +++ b/vignettes/Tplyr.Rmd @@ -278,7 +278,7 @@ tplyr_table(adsl, TRT01P) %>% ``` -**Tplyr** summarizes both variables and merges them together. This makes creating tables where you need to compare BASE, AVAL, and CHG next to each other nice and simple. Note the use of `dplyr::vars()` - in any situation where you'd like to use multiple variable names in a parameter, use `dplyr::vars()` to specify the variables. You can use text strings in the calls to `dplyr::vars()` as well. +**Tplyr** summarizes both variables and merges them together. This makes creating tables where you need to compare BASE, AVAL, and CHG next to each other nice and simple. Note the use of `rlang::quos()` - in any situation where you'd like to use multiple variable names in a parameter, use `rlang::quos()` to specify the variables. You can use text strings in the calls to `rlang::quos()` as well. ## Count Layers @@ -323,7 +323,7 @@ tplyr_table(adae, TRTA) %>% kable() ``` -Here we again use `dplyr::vars()` to specify multiple target variables. When used in a count layer, **Tplyr** knows automatically that the first variable is a grouping variable for the second variable, and counts shall be produced for both then merged together. +Here we again use `rlang::quos()` to specify multiple target variables. When used in a count layer, **Tplyr** knows automatically that the first variable is a grouping variable for the second variable, and counts shall be produced for both then merged together. ## Shift Layers diff --git a/vignettes/count.Rmd b/vignettes/count.Rmd index ca77ee72..58edc6b7 100644 --- a/vignettes/count.Rmd +++ b/vignettes/count.Rmd @@ -91,7 +91,7 @@ As can be seen above, when using parenthesis hugging, the width of a specified f Certain summary tables present counts within groups. One example could be in a disposition table where a disposition reason of "Other" summarizes what those other reasons were. A very common example is an Adverse Event table that displays counts for body systems, and then the events within those body systems. This is again a nuanced situation - there are two variables being summarized: The body system counts, and the advert event counts. -One way to approach this would be creating two summaries. One summarizing the body system, and another summarizing the preferred terms by body system, and then merging the two together. But we don't want you to have to do that. Instead, we handle this complexity for you. This is done in `group_count()` by submitting two target variables with `dplyr::vars()`. The first variable should be your grouping variable that you want summarized, which we refer to as the "Outside" variable, and the second should have the narrower scope, which we call the "Inside" variable. +One way to approach this would be creating two summaries. One summarizing the body system, and another summarizing the preferred terms by body system, and then merging the two together. But we don't want you to have to do that. Instead, we handle this complexity for you. This is done in `group_count()` by submitting two target variables with `rlang::quos()`. The first variable should be your grouping variable that you want summarized, which we refer to as the "Outside" variable, and the second should have the narrower scope, which we call the "Inside" variable. 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`. diff --git a/vignettes/metadata.Rmd b/vignettes/metadata.Rmd index 9edf5cf4..838cae20 100644 --- a/vignettes/metadata.Rmd +++ b/vignettes/metadata.Rmd @@ -67,7 +67,7 @@ get_meta_subset(t, 'c2_1', 'var1_Placebo', add_cols = vars(USUBJID, SEX)) %>% kable() ``` -Variables should be provided using `dplyr::vars()`, just like the `cols` argument on `tplyr_table()` and the `by` arguments in each layer type. +Variables should be provided using `rlang::quos()`, just like the `cols` argument on `tplyr_table()` and the `by` arguments in each layer type. As mentioned, the input source data can be extracted for any result cell created by Tplyr. So let's say we want to know the subjects relevant for the descriptive statistics around age in the Xanomeline High Dose group: diff --git a/vignettes/table.Rmd b/vignettes/table.Rmd index 0d4ab526..d34c2ca7 100644 --- a/vignettes/table.Rmd +++ b/vignettes/table.Rmd @@ -50,7 +50,7 @@ tplyr_table(adsl, TRT01P, where= SAFFL =="Y", cols = SEX) %>% kable() ``` -In the example above, the `where` parameter is passed forward into both the `RACE` and `AGE` layers. Furthermore, note how the `cols` parameter works. By default, the target variables from the layers are transposed by the `treat_var` variables. The `cols` argument adds an additional variable to transpose by, and the values of these variable are added as a suffix to the variable name. You are able to use multiple `cols` variables just like `by`, by using `dplyr::vars()`. But use with caution - as depending on the distinct variable values in the dataset, this could get quite wide. +In the example above, the `where` parameter is passed forward into both the `RACE` and `AGE` layers. Furthermore, note how the `cols` parameter works. By default, the target variables from the layers are transposed by the `treat_var` variables. The `cols` argument adds an additional variable to transpose by, and the values of these variable are added as a suffix to the variable name. You are able to use multiple `cols` variables just like `by`, by using `rlang::quos()`. But use with caution - as depending on the distinct variable values in the dataset, this could get quite wide. _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._ From 52a7080ad5414a4931f78357d091e4423bf89613 Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Fri, 15 Dec 2023 23:39:14 +0000 Subject: [PATCH 4/5] vars update --- R/assertions.R | 4 ++-- vignettes/Tplyr.Rmd | 10 +++++----- vignettes/count.Rmd | 4 ++-- vignettes/denom.Rmd | 6 +++--- vignettes/desc.Rmd | 2 +- vignettes/desc_layer_formatting.Rmd | 6 +++--- vignettes/general_string_formatting.Rmd | 2 +- vignettes/metadata.Rmd | 2 +- vignettes/riskdiff.Rmd | 2 +- vignettes/shift.Rmd | 4 ++-- vignettes/sort.Rmd | 12 ++++++------ vignettes/table.Rmd | 2 +- 12 files changed, 28 insertions(+), 28 deletions(-) diff --git a/R/assertions.R b/R/assertions.R index ce2c322f..8efd5f30 100644 --- a/R/assertions.R +++ b/R/assertions.R @@ -176,13 +176,13 @@ unpack_vars <- function(quo_list, allow_character=TRUE) { # Unpack the `quo_list` group to ensure that the type is `list_of` # It had to be a 1 item list, so check if that element is a `call` - # The only valid use of a `call` is to provide multiple variables using `vars` + # The only valid use of a `call` is to provide multiple variables using `quos` c <- quo_get_expr(quo_list[[1]]) if (is.call(c)) { # If it's a call, we need to pull it out a level quo_list <- tryCatch({ # If it's in here, the call has to be to rlang::quos - if (call_name(c) != "vars") abort("Multiple variables should be using rlang::quos") + if (call_name(c) != "quos") abort("Multiple variables should be using rlang::quos") # Evaluate the quosure sort_vars getting the expression eval(c, envir=caller_env()) diff --git a/vignettes/Tplyr.Rmd b/vignettes/Tplyr.Rmd index 9921747a..fac387ad 100644 --- a/vignettes/Tplyr.Rmd +++ b/vignettes/Tplyr.Rmd @@ -65,7 +65,7 @@ t Users of **Tplyr** interface with `tplyr_layer()` objects using the `group_` family of functions. This family specifies the type of summary that is to be performed within a layer. `count` layers are used to create summary counts of some discrete variable. `shift` layers summarize the counts for different changes in states. Lastly, `desc` layers create descriptive statistics. - **Count Layers** - - Count layers allow you to easily create summaries based on counting distinct or non-distinct occurrences of values within a variable. Additionally, this layer allows you to create n (%) summaries where you're also summarizing the proportion of instances a value occurs compared to some denominator. Count layers are also capable of producing counts of nested relationships. For example, if you want to produce counts of an overall outside group, and then the subgroup counts within that group, you can simply specify the target variable as `vars(OutsideVariable, InsideVariable)`. This allows you to do tables like Adverse Events where you want to see the Preferred Terms within Body Systems, all in one layer. Count layers can also distinguish between distinct and non-distinct counts. Using some specified by variable, you can count the unique occurrences of some variable within the specified by grouping, including the target. This allows you to do a summary like unique subjects and their proportion experiencing some adverse event, and the number of total occurrences of that adverse event. + - Count layers allow you to easily create summaries based on counting distinct or non-distinct occurrences of values within a variable. Additionally, this layer allows you to create n (%) summaries where you're also summarizing the proportion of instances a value occurs compared to some denominator. Count layers are also capable of producing counts of nested relationships. For example, if you want to produce counts of an overall outside group, and then the subgroup counts within that group, you can simply specify the target variable as `quos(OutsideVariable, InsideVariable)`. This allows you to do tables like Adverse Events where you want to see the Preferred Terms within Body Systems, all in one layer. Count layers can also distinguish between distinct and non-distinct counts. Using some specified by variable, you can count the unique occurrences of some variable within the specified by grouping, including the target. This allows you to do a summary like unique subjects and their proportion experiencing some adverse event, and the number of total occurrences of that adverse event. - **Descriptive Statistics Layers** - Descriptive statistics layers perform summaries on continuous variables. There are a number of summaries built into **Tplyr** already that you can perform, including n, mean, median, standard deviation, variance, min, max, interquartile range, Q1, Q3, and missing value counts. From these available summaries, the default presentation of a descriptive statistics layer will output 'n', 'Mean (SD)', 'Median', 'Q1, Q3', 'Min, Max', and 'Missing'. You can change these summaries using `set_format_strings()`, and you can also add your own summaries using `set_custom_summaries()`. This allows you to easily implement any additional summary statistics you want presented. - **Shift Layers** @@ -78,7 +78,7 @@ cnt dsc <- group_desc(t, AGE) dsc -shf <- group_shift(t, vars(row=COMP8FL, column=COMP24FL)) +shf <- group_shift(t, quos(row=COMP8FL, column=COMP24FL)) shf ``` @@ -271,7 +271,7 @@ Sometimes there's a need to present multiple variables summarized side by side. ```{r desc2} tplyr_table(adsl, TRT01P) %>% add_layer( - group_desc(vars(AGE, AVGDD), by = "Age and Avg. Daily Dose") + group_desc(quos(AGE, AVGDD), by = "Age and Avg. Daily Dose") ) %>% build() %>% kable() @@ -316,7 +316,7 @@ Adverse event tables often call for counting AEs of something like a body system ```{r count_nested} tplyr_table(adae, TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) + group_count(quos(AEBODSYS, AEDECOD)) ) %>% build() %>% head() %>% @@ -336,7 +336,7 @@ adlb$BNRIND <- factor(adlb$BNRIND, c("L", "N", "H")) tplyr_table(adlb, TRTA, where = PARAMCD == "CK") %>% add_layer( - group_shift(vars(row=BNRIND, column=ANRIND), by=PARAM) %>% + group_shift(quos(row=BNRIND, column=ANRIND), by=PARAM) %>% set_format_strings(f_str("xx (xxx%)", n, pct)) ) %>% build() %>% diff --git a/vignettes/count.Rmd b/vignettes/count.Rmd index 58edc6b7..4885a72c 100644 --- a/vignettes/count.Rmd +++ b/vignettes/count.Rmd @@ -98,7 +98,7 @@ The example below demonstrates how to do a nested summary. Look at the first row ```{r} tplyr_table(adae, TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) + group_count(quos(AEBODSYS, AEDECOD)) ) %>% build() %>% head() %>% @@ -110,7 +110,7 @@ This accomplishes what we needed, but it's not exactly the presentation you migh ```{r} tplyr_table(adae, TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) %>% + group_count(quos(AEBODSYS, AEDECOD)) %>% set_nest_count(TRUE) %>% set_indentation("--->") ) %>% diff --git a/vignettes/denom.Rmd b/vignettes/denom.Rmd index 3caefcc2..f96d7b9c 100644 --- a/vignettes/denom.Rmd +++ b/vignettes/denom.Rmd @@ -132,7 +132,7 @@ A major part of the shift API is the control of the denominators used in the cal ```{r} tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) %>% + group_shift(quos(row = BNRIND, column = ANRIND), by = quos(PARAM, AVISIT)) %>% set_format_strings(f_str("xx (xxx.x%)", n, pct)) %>% # This is the default, the 3x3 box formed by the target variables set_denoms_by(TRTA, PARAM, AVISIT) @@ -148,7 +148,7 @@ In the next example, the percentage denominators are calculated row-wise, each r ```{r} tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) %>% + group_shift(quos(row = BNRIND, column = ANRIND), by = quos(PARAM, AVISIT)) %>% set_format_strings(f_str("xx (xxx.x%)", n, pct)) %>% set_denoms_by(TRTA, PARAM, AVISIT, BNRIND) # Each row made by TRTA, BNRIND ) %>% @@ -163,7 +163,7 @@ While not practical, in this last example the denominators are changed to be bas ```{r} tplyr_table(adlb, TRTA, where = PARAMCD == "CK") %>% add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) %>% + group_shift(quos(row = BNRIND, column = ANRIND), by = quos(PARAM, AVISIT)) %>% set_format_strings(f_str("xx (xx.xx%)", n, pct)) %>% set_denoms_by(TRTA, ANRIND) # Use the column total as the denominator ) %>% diff --git a/vignettes/desc.Rmd b/vignettes/desc.Rmd index 3e7b0a52..c9b2b095 100644 --- a/vignettes/desc.Rmd +++ b/vignettes/desc.Rmd @@ -139,7 +139,7 @@ Let's look at an example. ```{r multi-custom} tplyr_table(adsl, TRT01P) %>% add_layer( - group_desc(vars(AGE, HEIGHTBL), by = "Sepal Length") %>% + group_desc(quos(AGE, HEIGHTBL), by = "Sepal Length") %>% set_custom_summaries( geometric_mean = exp(sum(log(.var[.var > 0]), na.rm=TRUE) / length(.var)) ) %>% diff --git a/vignettes/desc_layer_formatting.Rmd b/vignettes/desc_layer_formatting.Rmd index 0bad68a8..a82cd025 100644 --- a/vignettes/desc_layer_formatting.Rmd +++ b/vignettes/desc_layer_formatting.Rmd @@ -134,7 +134,7 @@ This was a basic situation, but if you're paying close attention, you may have s ```{r precision3} tplyr_table(adlb, TRTA) %>% add_layer( - group_desc(vars(AVAL, CHG, BASE), by = PARAMCD) %>% + group_desc(quos(AVAL, CHG, BASE), by = PARAMCD) %>% set_format_strings( 'Mean (SD)' = f_str('a.a+1 (a.a+2)', mean, sd, empty="NA"), cap = c(int=3, dec=2) @@ -237,7 +237,7 @@ Note that if a certain number of integers are alotted, space will be left for th ```{r manual_hugging} tplyr_table(adlb, TRTA, PARAMCD == "CK") %>% add_layer( - group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% + group_desc(AVAL, by=quos(PARAMCD, AVISIT)) %>% set_format_strings( TEST = f_str("xxx.x (XXX.x)", mean, sd, empty="NA") ) %>% @@ -253,7 +253,7 @@ Similarly, the same functionality works with auto precision by using a capital A ```{r auto_hugging} tplyr_table(adlb, TRTA, PARAMCD == "CK") %>% add_layer( - group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% + group_desc(AVAL, by=quos(PARAMCD, AVISIT)) %>% set_format_strings( TEST = f_str("a.a (A.a)", mean, sd, empty="NA") ) %>% diff --git a/vignettes/general_string_formatting.Rmd b/vignettes/general_string_formatting.Rmd index caa4754b..79bc38b7 100644 --- a/vignettes/general_string_formatting.Rmd +++ b/vignettes/general_string_formatting.Rmd @@ -171,7 +171,7 @@ Consider the following example. ```{r example_6} tplyr_table(adlb, TRTA, where=PARAMCD %in% c("CA", "URATE")) %>% add_layer( - group_desc(AVAL, by=vars(PARAMCD, AVISIT)) %>% + group_desc(AVAL, by=quos(PARAMCD, AVISIT)) %>% set_format_strings( 'Mean (SD)' = f_str('a.a (a.a+1)', mean, sd) ) %>% diff --git a/vignettes/metadata.Rmd b/vignettes/metadata.Rmd index 838cae20..233145b4 100644 --- a/vignettes/metadata.Rmd +++ b/vignettes/metadata.Rmd @@ -63,7 +63,7 @@ get_meta_subset(t, 'c2_1', 'var1_Placebo') %>% By using the `row_id` and column, the dataframe is pulled right out for us. Notice that `USUBJID` was included by default, even though **Tplyr** there's no reference anywhere in the `tplyr_table()` to the variable `USUBJID`. This is because `get_meta_subset()` has an additional argument `add_cols` that allows you to specify additional columns you want included in the resulting dataframe, and has a default of USUBJID. So let's say we want additionally include the variable `SEX`. ```{r add_vars} -get_meta_subset(t, 'c2_1', 'var1_Placebo', add_cols = vars(USUBJID, SEX)) %>% +get_meta_subset(t, 'c2_1', 'var1_Placebo', add_cols = quos(USUBJID, SEX)) %>% kable() ``` diff --git a/vignettes/riskdiff.Rmd b/vignettes/riskdiff.Rmd index 296338da..c6c4edc6 100644 --- a/vignettes/riskdiff.Rmd +++ b/vignettes/riskdiff.Rmd @@ -140,7 +140,7 @@ t <- tplyr_table(adae, TRTA, where= AEBODSYS == "SKIN AND SUBCUTANEOUS TISSUE DI set_pop_treat_var(TRT01A) %>% set_pop_where(TRUE) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) %>% + group_count(quos(AEBODSYS, AEDECOD)) %>% set_distinct_by(USUBJID) %>% add_risk_diff( c('Xanomeline High Dose', 'Placebo'), diff --git a/vignettes/shift.Rmd b/vignettes/shift.Rmd index 05094358..ec230fef 100644 --- a/vignettes/shift.Rmd +++ b/vignettes/shift.Rmd @@ -43,7 +43,7 @@ Let's look at an example. ```{r} tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) + group_shift(quos(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) ) %>% build() %>% head(20) %>% @@ -61,7 +61,7 @@ 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") %>% add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) + group_shift(quos(row = BNRIND, column = ANRIND), by = vars(PARAM, VISIT)) ) %>% build() %>% head(20) %>% diff --git a/vignettes/sort.Rmd b/vignettes/sort.Rmd index 57d3a38e..64c87910 100644 --- a/vignettes/sort.Rmd +++ b/vignettes/sort.Rmd @@ -300,7 +300,7 @@ Nested count layers add one more piece to the puzzle. As a reminder, nested coun ```{r} tplyr_table(adae, TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) + group_count(quos(AEBODSYS, AEDECOD)) ) %>% build() %>% head() %>% @@ -315,7 +315,7 @@ These result variables will always be the last two order variables output by **T ```{r} tplyr_table(adae, TRTA) %>% add_layer( - group_count(vars(AEBODSYS, AEDECOD)) %>% + group_count(quos(AEBODSYS, AEDECOD)) %>% set_outer_sort_position("asc") ) %>% build() %>% @@ -332,7 +332,7 @@ Another consideration of nested sorting is whether or not you want to sort both ```{r} tplyr_table(adsl, TRT01A) %>% add_layer( - group_count(vars(EOSSTT, DCDECOD)) %>% + group_count(quos(EOSSTT, DCDECOD)) %>% set_order_count_method(c("byfactor", "bycount")) ) %>% build() %>% @@ -348,7 +348,7 @@ If only one method is provided, that method will automatically be applied to bot tplyr_table(adsl, TRT01A) %>% add_total_group() %>% add_layer( - group_count(vars(EOSSTT, DCDECOD)) %>% + group_count(quos(EOSSTT, DCDECOD)) %>% set_order_count_method("bycount") %>% #set_order_count_method("bycount", "bycount") %>% This is functionally the same. set_ordering_cols(Total) @@ -366,7 +366,7 @@ Shift tables keep things relatively simple when it comes to sorting and use the ```{r} tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) + group_shift(quos(row = BNRIND, column = ANRIND), by = quos(PARAM, AVISIT)) ) %>% build() %>% select(-starts_with('var1')) %>% @@ -387,7 +387,7 @@ adlb$ANRIND <- factor(adlb$ANRIND, levels=c("L", "N", "H")) tplyr_table(adlb, TRTA, where=PARAMCD == "CK") %>% add_layer( - group_shift(vars(row = BNRIND, column = ANRIND), by = vars(PARAM, AVISIT)) + group_shift(quos(row = BNRIND, column = ANRIND), by = quos(PARAM, AVISIT)) ) %>% build() %>% select(-starts_with('var1')) %>% diff --git a/vignettes/table.Rmd b/vignettes/table.Rmd index d34c2ca7..4631f669 100644 --- a/vignettes/table.Rmd +++ b/vignettes/table.Rmd @@ -55,7 +55,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(adsl, TRT01P, where= SAFFL =="Y", cols = quos(SEX, RACE)) %>% add_layer( group_desc(AGE, by = "Age (Years)") ) %>% From d556719fdf07f73045c0f77693eb84eaa4d0acda Mon Sep 17 00:00:00 2001 From: Shiyu Chen Date: Sat, 16 Dec 2023 00:20:30 +0000 Subject: [PATCH 5/5] _snaps files changes --- tests/testthat/_snaps/desc.md | 33 ---------------- tests/testthat/_snaps/functional.md | 6 --- tests/testthat/_snaps/get_numeric.md | 24 ------------ tests/testthat/_snaps/meta.md | 57 ---------------------------- tests/testthat/_snaps/meta_utils.md | 28 -------------- 5 files changed, 148 deletions(-) delete mode 100644 tests/testthat/_snaps/desc.md delete mode 100644 tests/testthat/_snaps/functional.md delete mode 100644 tests/testthat/_snaps/meta_utils.md diff --git a/tests/testthat/_snaps/desc.md b/tests/testthat/_snaps/desc.md deleted file mode 100644 index 1c7e893a..00000000 --- a/tests/testthat/_snaps/desc.md +++ /dev/null @@ -1,33 +0,0 @@ -# Desc layer clauses with invalid syntax give informative error - - i In index: 1. - Caused by error in `value[[3L]]()`: - ! group_desc `where` condition `bad == code` is invalid. Filter error: - Error in `filter()`: - i In argument: `bad == code`. - Caused by error: - ! object 'bad' not found - -# Stats as columns properly transposes the built data - - # A tibble: 3 x 7 - row_label1 var1_n var1_sd var2_n var2_sd ord_layer_index ord_layer_1 - - 1 3 "15" " 0.8" "15" " 0.3" 1 1 - 2 4 "12" " 0.6" "12" " 0.3" 1 2 - 3 5 " 5" " 0.8" " 5" " 0.4" 1 3 - ---- - - Code - as.data.frame(d2) - Output - row_label1 var1_n_0 var1_sd_0 var1_n_1 var1_sd_1 var2_n_0 var2_sd_0 var2_n_1 - 1 3 15 0.8 BLAH 15 0.3 - 2 4 4 0.2 8 0.5 4 0.1 8 - 3 5 BLAH 5 0.8 BLAH 5 - var2_sd_1 ord_layer_index ord_layer_1 - 1 BLAH 1 1 - 2 0.3 1 2 - 3 0.4 1 3 - diff --git a/tests/testthat/_snaps/functional.md b/tests/testthat/_snaps/functional.md deleted file mode 100644 index 412df417..00000000 --- a/tests/testthat/_snaps/functional.md +++ /dev/null @@ -1,6 +0,0 @@ -# all test tables can be built without errors or warnings - - i In argument: `col_i = fct_expand(...)`. - Caused by error: - ! object 'col_i' not found - diff --git a/tests/testthat/_snaps/get_numeric.md b/tests/testthat/_snaps/get_numeric.md index ff71d6b5..d48456d6 100644 --- a/tests/testthat/_snaps/get_numeric.md +++ b/tests/testthat/_snaps/get_numeric.md @@ -22,27 +22,3 @@ Provided layer index is out of range -# Error handling - statistic - - If `where` is provided, `layer_name` and `statistic` must be specified - ---- - - If `where` is provided, `layer_name` and `statistic` must be specified - ---- - - Layer(s) blah do(es) not exist - ---- - - Layer(s) am, blah do(es) not exist - ---- - - Provided layer index is out of range - ---- - - Provided layer index is out of range - diff --git a/tests/testthat/_snaps/meta.md b/tests/testthat/_snaps/meta.md index 19c02cb6..a2c71ab9 100644 --- a/tests/testthat/_snaps/meta.md +++ b/tests/testthat/_snaps/meta.md @@ -22,60 +22,3 @@ Names must be provided as a list of names -# Metadata extraction and extension error properly - - t must be a tplyr_table object - ---- - - t does not contain a metadata dataframe. Make sure the tplyr_table was built with `build(metadata=TRUE)` - ---- - - The provided metadata dataset must have a column named row_id - ---- - - row_id values in the provided metadata dataset are duplicates of row_id values in the Tplyr metadata. All row_id values must be unique. FALSE - -# Metadata extraction and extension work properly - - Code - as.data.frame(get_metadata(t)) - Output - row_id row_label1 var1_3 - 1 d1_1 n ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE - 2 d2_1 Mean (SD) ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE - 3 d3_1 Median ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE - 4 d4_1 Q1, Q3 ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE - 5 d5_1 Min, Max ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE - 6 d6_1 Missing ~gear, ~wt, gear == c("3"), ~TRUE, ~TRUE - 7 x1_1 NULL - var1_4 - 1 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE - 2 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE - 3 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE - 4 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE - 5 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE - 6 ~gear, ~wt, gear == c("4"), ~TRUE, ~TRUE - 7 NULL - var1_5 - 1 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE - 2 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE - 3 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE - 4 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE - 5 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE - 6 ~gear, ~wt, gear == c("5"), ~TRUE, ~TRUE - 7 NULL - -# Metadata print method is accurate - - Code - print(x) - Output - tplyr_meta: 3 names, 4 filters - Names: - a, b, c - Filters: - a == 1, b == 2, c == 3, x == "a" - diff --git a/tests/testthat/_snaps/meta_utils.md b/tests/testthat/_snaps/meta_utils.md deleted file mode 100644 index 9a374047..00000000 --- a/tests/testthat/_snaps/meta_utils.md +++ /dev/null @@ -1,28 +0,0 @@ -# Metadata extractors error properly - - Invalid row_id selected. row_id must be provided as a string present in built Tplyr table. - ---- - - Invalid row_id selected. row_id must be provided as a string present in built Tplyr table. - ---- - - column must provided as a character string and a valid result column present in the built Tplyr dataframe - ---- - - column must provided as a character string and a valid result column present in the built Tplyr dataframe - ---- - - Specified column must be a result column - ---- - - add_cols must be provided using `rlang::quos()` - ---- - - If querying metadata without a tplyr_table, a target must be provided -