From 51a27df770cc87a352737f72a83ed362b0fc920a Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Wed, 21 Oct 2020 00:01:49 -0400 Subject: [PATCH 01/17] in progress --- R/tbl_regression.R | 3 ++- R/utils-tbl_regression.R | 19 +++++++++++++++++-- 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/R/tbl_regression.R b/R/tbl_regression.R index 2de10de414..ad4b3bc4e8 100644 --- a/R/tbl_regression.R +++ b/R/tbl_regression.R @@ -165,7 +165,8 @@ tbl_regression.default <- function(x, label = NULL, exponentiate = FALSE, table_body <- tidy_prep(x, tidy_fun = tidy_fun, exponentiate = exponentiate, conf.level = conf.level, intercept = intercept, - label = label, show_single_row = !!show_single_row) + label = label, show_single_row = !!show_single_row, + include = !!include) # saving evaluated `label`, and `show_single_row` func_inputs$label <- diff --git a/R/utils-tbl_regression.R b/R/utils-tbl_regression.R index 78e637e7ce..dd75619697 100644 --- a/R/utils-tbl_regression.R +++ b/R/utils-tbl_regression.R @@ -15,7 +15,22 @@ vctr_2_tibble <- function(x) { # prepares the tidy object to be printed with broom.helpers tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label, - show_single_row) { + show_single_row, include) { + df_tidy <- + broom.helpers::tidy_plus_plus( + x = x, + tidy_fun = tidy_fun, + exponentiate = exponentiate, + variable_labels = {{ label }}, + show_single_row = {{ show_single_row }}, + intercept = intercept, + include = {{ include }}, + conf.level = conf.level, + conf.int = TRUE, + add_estimate_to_reference_rows = FALSE, + add_header_rows = TRUE + ) + # run initial tidy ----------------------------------------------------------- df_tidy_1 <- tryCatch({ tidy_fun(x, exponentiate = exponentiate, conf.level = conf.level, conf.int = TRUE) @@ -81,7 +96,7 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label, } # final tidying before returning --------------------------------------------- - df_tidy_6 %>% + df_tidy %>% mutate( N = nrow(gtsummary_model_frame(x)), row_type = ifelse(.data$header_row | is.na(.data$header_row), "label", "level") From af7e4f0510a2897aaa5a332f9219f08b111ec43b Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Thu, 22 Oct 2020 00:47:32 -0400 Subject: [PATCH 02/17] in progress --- R/utils-tbl_regression.R | 66 +++------------------------------------- 1 file changed, 5 insertions(+), 61 deletions(-) diff --git a/R/utils-tbl_regression.R b/R/utils-tbl_regression.R index dd75619697..5eee938f35 100644 --- a/R/utils-tbl_regression.R +++ b/R/utils-tbl_regression.R @@ -18,7 +18,7 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label, show_single_row, include) { df_tidy <- broom.helpers::tidy_plus_plus( - x = x, + model = x, tidy_fun = tidy_fun, exponentiate = exponentiate, variable_labels = {{ label }}, @@ -28,71 +28,15 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label, conf.level = conf.level, conf.int = TRUE, add_estimate_to_reference_rows = FALSE, - add_header_rows = TRUE + add_header_rows = TRUE, + strict = TRUE ) - # run initial tidy ----------------------------------------------------------- - df_tidy_1 <- tryCatch({ - tidy_fun(x, exponentiate = exponentiate, conf.level = conf.level, conf.int = TRUE) - }, - error = function(e) { - usethis::ui_oops(paste0( - "There was an error calling {usethis::ui_code('tidy_fun')}.\n", - "Most likely, this is because the argument passed in {usethis::ui_code('tidy_fun=')} \n", - "was misspelled, does not exist, is not compatible with your object, \n", - "or was missing necessary arguments. See error message below. \n" - )) - stop(as.character(e), call. = FALSE) - }) - - # checking reserved names in the tidy data frame - if (any(c("rowname", "groupname_col") %in% names(df_tidy_1))) { - paste("The resulting tibble from the initial tidying of the model", - "(likely from the tidier passed in `tidy_fun=`)", - "contains a column named 'rowname' or 'groupname_col'.", - "These column names result in special print behavior in the", - "{gt} package, and may cause errors or malformed tables.") %>% - stringr::str_wrap() %>% - rlang::inform() - } - - # attach model object to tidy tibble ----------------------------------------- - df_tidy_2 <- broom.helpers::tidy_attach_model(x = df_tidy_1, model = x) - - # remove intercept from output ----------------------------------------------- - if (!intercept) df_tidy_2 <- broom.helpers::tidy_remove_intercept(df_tidy_2) - - # identify variables in model ------------------------------------------------ - df_tidy_3 <- broom.helpers::tidy_identify_variables(df_tidy_2) %>% - # if intercept remains filling in the variable name withe intercept - dplyr::mutate(variable = dplyr::coalesce(.data$variable, .data$term)) - if (all(is.na(df_tidy_3$variable))) { # when variables are all missing, print this - usethis::ui_oops("Review the GitHub issue linked below for a possible solution.") - usethis::ui_code_block("https://github.com/ddsjoberg/gtsummary/issues/231") - } - - # creating label and show_single_row named lists ----------------------------- - label <- unique(df_tidy_3$variable) %>% vctr_2_tibble() %>% - tidyselect_to_list(x = {{ label }}, arg_name = "label") - show_single_row <- unique(df_tidy_3$variable) %>% vctr_2_tibble() %>% - var_input_to_string(arg_name = "show_single_row", select_input = {{show_single_row}}) - - # add reference row ---------------------------------------------------------- - df_tidy_4 <- broom.helpers::tidy_add_reference_rows(df_tidy_3) - - # add header rows to categorical variables - df_tidy_5 <- - broom.helpers::tidy_add_variable_labels(df_tidy_4, labels = label) - - # add header rows to categorical variables ----------------------------------- - df_tidy_6 <- - broom.helpers::tidy_add_header_rows(df_tidy_5, strict = TRUE, - show_single_row = show_single_row) # add reference row value, requested ----------------------------------------- if (get_theme_element("tbl_regression-lgl:add_ref_est", default = FALSE)) { - df_tidy_6 <- - broom.helpers::tidy_add_estimate_to_reference_rows(df_tidy_6, exponentiate = exponentiate) + df_tidy <- + broom.helpers::tidy_add_estimate_to_reference_rows(df_tidy, exponentiate = exponentiate) } # final tidying before returning --------------------------------------------- From aaa679489c501f10857b1310a211096223f36765 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Sun, 25 Oct 2020 20:17:13 -0400 Subject: [PATCH 03/17] updating for bh selectors --- NAMESPACE | 5 + R/add_glance_source_note.R | 26 ++-- R/add_global_p.R | 16 ++- R/add_p.R | 78 +++++++--- R/add_stat.R | 11 +- R/add_stat_label.R | 19 ++- R/as_flex_table.R | 10 +- R/as_gt.R | 16 ++- R/as_hux_table.R | 8 +- R/as_kable.R | 16 ++- R/as_kable_extra.R | 8 +- R/as_tibble.R | 16 ++- R/deprecated.R | 90 ++++++++++++ R/gtsummary-package.R | 2 + R/inline_text.R | 70 +++++---- R/modify.R | 23 ++- R/modify_table_header.R | 8 +- R/select_helpers.R | 75 ++-------- R/tbl_cross.R | 24 ++-- R/tbl_regression.R | 33 +++-- R/tbl_summary.R | 41 ++++-- R/tbl_survfit.R | 17 ++- R/tbl_svysummary.R | 17 ++- R/tbl_uvregression.R | 39 +++-- R/utils-gtsummary_core.R | 203 --------------------------- R/utils-tbl_summary.R | 23 +++ man/deprecated.Rd | 18 +++ man/select_helpers.Rd | 35 ++--- tests/testthat/test-select_helpers.R | 50 +------ 29 files changed, 519 insertions(+), 478 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8c68f3afc7..28229900a5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -118,6 +118,11 @@ export(theme_gtsummary_mean_sd) export(tidy_bootstrap) export(tidy_standardize) export(vars) +importFrom(broom.helpers,.formula_list_to_named_list) +importFrom(broom.helpers,.generic_selector) +importFrom(broom.helpers,.select_to_varnames) +importFrom(broom.helpers,all_categorical) +importFrom(broom.helpers,all_dichotomous) importFrom(dplyr,"%>%") importFrom(dplyr,all_of) importFrom(dplyr,any_of) diff --git a/R/add_glance_source_note.R b/R/add_glance_source_note.R index ab40f50271..ec38c4bb9d 100644 --- a/R/add_glance_source_note.R +++ b/R/add_glance_source_note.R @@ -46,8 +46,9 @@ add_glance_source_note <- function(x, include = everything(), label = NULL, stop("`x=` must be class 'tbl_regression'") # prepping table ------------------------------------------------------------- + df_glance_orig <- broom::glance(x$model_obj, ...) df_glance <- - broom::glance(x$model_obj, ...) %>% + df_glance_orig %>% tidyr::pivot_longer(cols = everything(), names_to = "statistic_name", values_to = "statistic") @@ -72,18 +73,27 @@ add_glance_source_note <- function(x, include = everything(), label = NULL, mutate(label = map_chr(.data$label, ~translate_text(.x, language))) # evaluating tidyselects ----------------------------------------------------- - include <- var_input_to_string( - data = vctr_2_tibble(df_results$statistic_name), arg_name = "include", - select_single = FALSE, select_input = {{include}} - ) + include <- + .select_to_varnames( + select = {{ include }}, + data = df_glance_orig, + arg_name = "include" + ) label <- - tidyselect_to_list(vctr_2_tibble(df_results$statistic_name), label, arg_name = "label") + .formula_list_to_named_list( + x = label, + data = df_glance_orig, + arg_name = "label" + ) if (rlang::is_function(fmt_fun)) fmt_fun <- everything() ~ fmt_fun fmt_fun <- - tidyselect_to_list(vctr_2_tibble(df_results$statistic_name), fmt_fun, arg_name = "fmt_fun") - + .formula_list_to_named_list( + x = fmt_fun, + data = df_glance_orig, + arg_name = "fmt_fun" + ) # updating df_results with new information ----------------------------------- if (!is.null(label)) { diff --git a/R/add_global_p.R b/R/add_global_p.R index 8aa457677e..1085221bca 100644 --- a/R/add_global_p.R +++ b/R/add_global_p.R @@ -76,8 +76,12 @@ add_global_p.tbl_regression <- function(x, type <- type %||% get_theme_element("add_global_p-str:type", default = "III") # converting to character vector --------------------------------------------- - include <- var_input_to_string(data = vctr_2_tibble(unique(x$table_body$variable)), - select_input = !!rlang::enquo(include)) + include <- + .select_to_varnames( + select = {{ include }}, + var_info = x$table_body, + arg_name = "include" + ) # if no terms are provided, stop and return x if (length(include) == 0) { @@ -220,8 +224,12 @@ add_global_p.tbl_uvregression <- function(x, type = NULL, include = everything() type <- type %||% get_theme_element("add_global_p-str:type", default = "III") # converting to character vector --------------------------------------------- - include <- var_input_to_string(data = vctr_2_tibble(unique(x$table_body$variable)), - select_input = !!rlang::enquo(include)) + include <- + .select_to_varnames( + select = {{ include }}, + var_info = x$table_body, + arg_name = "include" + ) # capturing dots in expression dots <- rlang::enexprs(...) diff --git a/R/add_p.R b/R/add_p.R index 869d9243fb..a507c3bdc5 100644 --- a/R/add_p.R +++ b/R/add_p.R @@ -105,15 +105,28 @@ add_p.tbl_summary <- function(x, test = NULL, pvalue_fun = NULL, gts_mapper("add_p(pvalue_fun=)") # converting bare arguments to string ---------------------------------------- - group <- var_input_to_string(data = x$inputs$data, - select_input = !!rlang::enquo(group), - arg_name = "group", select_single = TRUE) - include <- var_input_to_string(data = select(x$inputs$data, any_of(x$meta_data$variable)), - select_input = !!rlang::enquo(include), - arg_name = "include") - exclude <- var_input_to_string(data = select(x$inputs$data, any_of(x$meta_data$variable)), - select_input = !!rlang::enquo(exclude), - arg_name = "exclude") + group <- + .select_to_varnames( + select = {{ group }}, + data = x$inputs$data, + var_info = x$table_body, + arg_name = "group", + select_single = TRUE + ) + include <- + .select_to_varnames( + select = {{ include }}, + data = select(x$inputs$data, any_of(x$meta_data$variable)), + var_info = x$table_body, + arg_name = "include" + ) + exclude <- + .select_to_varnames( + select = {{ exclude }}, + data = select(x$inputs$data, any_of(x$meta_data$variable)), + var_info = x$table_body, + arg_name = "exclude" + ) # group argument ------------------------------------------------------------- if (!is.null(group)) { @@ -139,10 +152,13 @@ add_p.tbl_summary <- function(x, test = NULL, pvalue_fun = NULL, # test ----------------------------------------------------------------------- # parsing into a named list - test <- tidyselect_to_list( - select(x$inputs$data, any_of(x$meta_data$variable)), - test, .meta_data = x$meta_data, arg_name = "test" - ) + test <- + .formula_list_to_named_list( + x = test, + data = select(x$inputs$data, any_of(x$meta_data$variable)), + var_info = meta_data_to_var_info(x$meta_data), + arg_name = "test" + ) # checking pvalue_fun are functions if (!is.function(pvalue_fun)) { @@ -425,8 +441,19 @@ add_p.tbl_survfit <- function(x, test = "logrank", test.args = NULL, } # converting test and test.args to named list -------------------------------- - test <- tidyselect_to_list(vctr_2_tibble(x$meta_data$variable), test, arg_name = "test") - test.args <- tidyselect_to_list(vctr_2_tibble(x$meta_data$variable), test.args, arg_name = "test.args") + test <- + .formula_list_to_named_list( + x = test, + var_info = x$table_body, + arg_name = "test" + ) + + test.args <- + .formula_list_to_named_list( + x = test.args, + var_info = x$table_body, + arg_name = "test.args" + ) # adding pvalue to meta data ------------------------------------------------- meta_data <- @@ -677,9 +704,13 @@ add_p.tbl_svysummary <- function(x, test = NULL, pvalue_fun = NULL, # converting bare arguments to string ---------------------------------------- - include <- var_input_to_string(data = select(x$inputs$data$variables, any_of(x$meta_data$variable)), - select_input = !!rlang::enquo(include), - arg_name = "include") + include <- + .select_to_varnames( + select = {{ include }}, + data = select(x$inputs$data$variables, any_of(x$meta_data$variable)), + var_info = x$table_body, + arg_name = "include" + ) # checking that input x has a by var if (is.null(x$df_by)) { @@ -691,10 +722,13 @@ add_p.tbl_svysummary <- function(x, test = NULL, pvalue_fun = NULL, # test ----------------------------------------------------------------------- # parsing into a named list - test <- tidyselect_to_list( - select(x$inputs$data$variables, any_of(x$meta_data$variable)), - test, .meta_data = x$meta_data, arg_name = "test" - ) + test <- + .formula_list_to_named_list( + x = test, + data = select(x$inputs$data$variables, any_of(x$meta_data$variable)), + var_info = x$table_body, + arg_name = "test" + ) # checking pvalue_fun are functions if (!is.function(pvalue_fun)) { diff --git a/R/add_stat.R b/R/add_stat.R index 995f6eee8b..d49bd83113 100644 --- a/R/add_stat.R +++ b/R/add_stat.R @@ -107,10 +107,13 @@ add_stat <- function(x, fns, fmt_fun = NULL, header = "**Statistic**", } # convert fns to named list -------------------------------------------------- - fns <- tidyselect_to_list( - select(x$inputs$data, any_of(x$meta_data$variable)), - fns, .meta_data = x$meta_data, arg_name = "fns" - ) + fns <- + .formula_list_to_named_list( + x = fns, + data = select(x$inputs$data, any_of(x$meta_data$variable)), + var_info = x$table_body, + arg_name = "fns" + ) # setting new column name ---------------------------------------------------- stat_col_name <- diff --git a/R/add_stat_label.R b/R/add_stat_label.R index 968edfce2e..8b03df0f55 100644 --- a/R/add_stat_label.R +++ b/R/add_stat_label.R @@ -87,11 +87,22 @@ add_stat_label <- function(x, location = NULL, label = NULL) { stat_label <- as.list(x$meta_data$stat_label) %>% set_names(x$meta_data$variable) # converting input to named list if (!is_survey(x$inputs$data)) - label <- tidyselect_to_list(x$inputs$data[x$meta_data$variable], label, - .meta_data = x$meta_data, arg_name = "label") + label <- + .formula_list_to_named_list( + x = label, + data = x$inputs$data[x$meta_data$variable], + var_info = meta_data_to_var_info(x$meta_data), + arg_name = "label" + ) else - label <- tidyselect_to_list(x$inputs$data$variables[x$meta_data$variable], label, - .meta_data = x$meta_data, arg_name = "label") + label <- + .formula_list_to_named_list( + x = label, + data = x$inputs$data$variables[x$meta_data$variable], + var_info = meta_data_to_var_info(x$meta_data), + arg_name = "label" + ) + # updating the default values with values in label stat_label <- imap(stat_label, ~label[[.y]] %||% .x) diff --git a/R/as_flex_table.R b/R/as_flex_table.R index 4375ab4fad..b38e59adf1 100644 --- a/R/as_flex_table.R +++ b/R/as_flex_table.R @@ -77,9 +77,13 @@ as_flex_table <- function(x, include = everything(), return_calls = FALSE, .init = flextable_calls ) - # converting to charcter vector ---------------------------------------------- - include <- var_input_to_string(data = vctr_2_tibble(names(flextable_calls)), - select_input = !!rlang::enquo(include)) + # converting to character vector --------------------------------------------- + include <- + .select_to_varnames( + select = {{ include }}, + var_info = names(flextable_calls), + arg_name = "include" + ) # return calls, if requested ------------------------------------------------- if (return_calls == TRUE) return(flextable_calls[include]) diff --git a/R/as_gt.R b/R/as_gt.R index 8805563460..9afab96c50 100644 --- a/R/as_gt.R +++ b/R/as_gt.R @@ -82,10 +82,18 @@ as_gt <- function(x, include = everything(), return_calls = FALSE, exclude = NUL ) # converting to charcter vector ---------------------------------------------- - include <- var_input_to_string(data = vctr_2_tibble(names(gt_calls)), - select_input = !!rlang::enquo(include)) - exclude <- var_input_to_string(data = vctr_2_tibble(names(gt_calls)), - select_input = !!rlang::enquo(exclude)) + include <- + .select_to_varnames( + select = {{ include }}, + var_info = names(gt_calls), + arg_name = "include" + ) + exclude <- + .select_to_varnames( + select = {{ exclude }}, + var_info = names(gt_calls), + arg_name = "exclude" + ) # this ensures list is in the same order as names(x$gt_calls) include <- names(gt_calls) %>% intersect(include) diff --git a/R/as_hux_table.R b/R/as_hux_table.R index 21f82ebaef..452a7752ba 100644 --- a/R/as_hux_table.R +++ b/R/as_hux_table.R @@ -64,8 +64,12 @@ as_hux_table <- function(x, include = everything(), return_calls = FALSE, ) # converting to character vector ---------------------------------------------- - include <- var_input_to_string(data = vctr_2_tibble(names(huxtable_calls)), - select_input = !!rlang::enquo(include)) + include <- + .select_to_varnames( + select = {{ include }}, + var_info = names(huxtable_calls), + arg_name = "include" + ) # return calls, if requested ------------------------------------------------- if (return_calls == TRUE) return(huxtable_calls[include]) diff --git a/R/as_kable.R b/R/as_kable.R index 43d0abfa42..3c60f8019a 100644 --- a/R/as_kable.R +++ b/R/as_kable.R @@ -52,10 +52,18 @@ as_kable <- function(x, include = everything(), return_calls = FALSE, if (return_calls == TRUE) return(kable_calls) # converting to charcter vector ---------------------------------------------- - include <- var_input_to_string(data = vctr_2_tibble(names(kable_calls)), - select_input = !!rlang::enquo(include)) - exclude <- var_input_to_string(data = vctr_2_tibble(names(kable_calls)), - select_input = !!rlang::enquo(exclude)) + include <- + .select_to_varnames( + select = {{ include }}, + var_info = names(kable_calls), + arg_name = "include" + ) + exclude <- + .select_to_varnames( + select = {{ exclude }}, + var_info = names(kable_calls), + arg_name = "exclude" + ) # making list of commands to include ----------------------------------------- # this ensures list is in the same order as names(x$kable_calls) diff --git a/R/as_kable_extra.R b/R/as_kable_extra.R index e6b213d309..df4419885b 100644 --- a/R/as_kable_extra.R +++ b/R/as_kable_extra.R @@ -55,8 +55,12 @@ as_kable_extra <- function(x, include = everything(), return_calls = FALSE, ) # converting to charcter vector ---------------------------------------------- - include <- var_input_to_string(data = vctr_2_tibble(names(kable_extra_calls)), - select_input = !!rlang::enquo(include)) + include <- + .select_to_varnames( + select = {{ include }}, + var_info = names(kable_extra_calls), + arg_name = "include" + ) # making list of commands to include ----------------------------------------- # this ensures list is in the same order as names(x$kable_calls) diff --git a/R/as_tibble.R b/R/as_tibble.R index 0c4477d848..8320ebf2af 100644 --- a/R/as_tibble.R +++ b/R/as_tibble.R @@ -40,10 +40,18 @@ as_tibble.gtsummary <- function(x, include = everything(), col_labels = TRUE, tibble_calls <- table_header_to_tibble_calls(x = x, col_labels = col_labels) # converting to character vector --------------------------------------------- - include <- var_input_to_string(data = vctr_2_tibble(names(tibble_calls)), - select_input = !!rlang::enquo(include)) - exclude <- var_input_to_string(data = vctr_2_tibble(names(tibble_calls)), - select_input = !!rlang::enquo(exclude)) + include <- + .select_to_varnames( + select = {{ include }}, + var_info = names(tibble_calls), + arg_name = "include" + ) + exclude <- + .select_to_varnames( + select = {{ exclude }}, + var_info = names(tibble_calls), + arg_name = "exclude" + ) # making list of commands to include ----------------------------------------- # this ensures list is in the same order as names(x$kable_calls) diff --git a/R/deprecated.R b/R/deprecated.R index da3f604d6a..3fae2dc87f 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -90,3 +90,93 @@ as_flextable <- function(...) { as_flex_table(...) } +# v1.3.6 ----------------------------------------------------------------------- +#' @rdname deprecated +#' @export +all_numeric <- function() { + lifecycle::deprecate_stop( + "1.3.6", "gtsummary::all_numeric()", + details = paste0( + "The {tidyselect} and {dplyr} packages have implemented functions to ", + "select variables by class and type, and the {gtsummary} version is ", + "now deprecated.\n\n", + "Use `where(is.numeric)` instead." + + ) + ) +} + +#' @rdname deprecated +#' @export +all_character <- function() { + lifecycle::deprecate_stop( + "1.3.6", "gtsummary::all_character()", + details = paste0( + "The {tidyselect} and {dplyr} packages have implemented functions to ", + "select variables by class and type, and the {gtsummary} version is ", + "now deprecated.\n\n", + "Use `where(is.character)` instead." + + ) + ) +} + +#' @rdname deprecated +#' @export +all_integer <- function() { + lifecycle::deprecate_stop( + "1.3.6", "gtsummary::all_integer()", + details = paste0( + "The {tidyselect} and {dplyr} packages have implemented functions to ", + "select variables by class and type, and the {gtsummary} version is ", + "now deprecated.\n\n", + "Use `where(is.integer)` instead." + + ) + ) +} + +#' @rdname deprecated +#' @export +all_double <- function() { + lifecycle::deprecate_stop( + "1.3.6", "gtsummary::all_double()", + details = paste0( + "The {tidyselect} and {dplyr} packages have implemented functions to ", + "select variables by class and type, and the {gtsummary} version is ", + "now deprecated.\n\n", + "Use `where(is.double)` instead." + + ) + ) +} + +#' @rdname deprecated +#' @export +all_logical <- function() { + lifecycle::deprecate_stop( + "1.3.6", "gtsummary::all_logical()", + details = paste0( + "The {tidyselect} and {dplyr} packages have implemented functions to ", + "select variables by class and type, and the {gtsummary} version is ", + "now deprecated.\n\n", + "Use `where(is.logical)` instead." + + ) + ) +} + +#' @rdname deprecated +#' @export +all_factor <- function() { + lifecycle::deprecate_stop( + "1.3.6", "gtsummary::all_factor()", + details = paste0( + "The {tidyselect} and {dplyr} packages have implemented functions to ", + "select variables by class and type, and the {gtsummary} version is ", + "now deprecated.\n\n", + "Use `where(is.factor)` instead." + + ) + ) +} diff --git a/R/gtsummary-package.R b/R/gtsummary-package.R index e323228250..3c3f4191d8 100644 --- a/R/gtsummary-package.R +++ b/R/gtsummary-package.R @@ -11,6 +11,8 @@ #' @importFrom glue glue as_glue glue_collapse #' @importFrom stringr fixed word str_extract_all str_remove_all str_starts #' str_split str_detect str_remove str_replace_all str_wrap str_sub str_locate +#' @importFrom broom.helpers .formula_list_to_named_list .select_to_varnames +#' .generic_selector #' @keywords internal "_PACKAGE" diff --git a/R/inline_text.R b/R/inline_text.R index ce0ff78757..1a96f5b8c6 100644 --- a/R/inline_text.R +++ b/R/inline_text.R @@ -53,9 +53,15 @@ inline_text.tbl_summary <- # checking variable input -------------------------------------------------- variable <- - var_input_to_string( - data = vctr_2_tibble(x$meta_data$variable), arg_name = "variable", - select_single = TRUE, select_input = !!variable + .select_to_varnames( + select = !!variable, + data = switch(class(x[1]), + "tbl_summary" = x$inputs$data, + "tbl_cross" = x$inputs$data, + "tbl_svysummary" = x$inputs$data$variables), + var_info = x$table_body, + arg_name = "variable", + select_single = TRUE ) # selecting variable row from meta_data @@ -90,9 +96,11 @@ inline_text.tbl_summary <- # selecting proper column name column <- - var_input_to_string( - data = vctr_2_tibble(col_lookup_table$input), arg_name = "column", - select_single = TRUE, select_input = !!column + .select_to_varnames( + select = !!column, + var_info = col_lookup_table$input, + arg_name = "column", + select_single = TRUE ) column <- col_lookup_table %>% @@ -126,10 +134,11 @@ inline_text.tbl_summary <- } else { level <- - var_input_to_string( - data = vctr_2_tibble(filter(result, .data$row_type != "label") %>% - pull(.data$label)), - arg_name = "level", select_single = TRUE, select_input = !!level + .select_to_varnames( + select = !!level, + var_info = filter(result, .data$row_type != "label")$label, + arg_name = "level", + select_single = TRUE ) result <- @@ -232,9 +241,12 @@ inline_text.tbl_regression <- # select variable ---------------------------------------------------------- variable <- - var_input_to_string( - data = vctr_2_tibble(unique(x$table_body$variable)), arg_name = "variable", - select_single = TRUE, select_input = !!variable + .select_to_varnames( + select = !!variable, + data = NULL, + var_info = x$table_body, + arg_name = "variable", + select_single = TRUE ) # grabbing rows matching variable @@ -249,10 +261,11 @@ inline_text.tbl_regression <- } else { level <- - var_input_to_string( - data = vctr_2_tibble(filter(result, .data$row_type != "label") %>% - pull(.data$label)), - arg_name = "level", select_single = TRUE, select_input = !!level + .select_to_varnames( + select = !!level, + var_info = filter(result, .data$row_type != "label")$label, + arg_name = "level", + select_single = TRUE ) result <- @@ -590,11 +603,13 @@ inline_text.tbl_cross <- # row_level ---------------------------------------------------------------- # converting row_level to a string - row_level <- var_input_to_string( - data = vctr_2_tibble(unique(x$table_body$label)), - select_input = {{ row_level }}, - arg_name = "row_level", select_single = TRUE - ) + row_level <- + .select_to_varnames( + select = {{ row_level }}, + var_info = x$table_body$label, + arg_name = "row_level", + select_single = TRUE + ) # assessing if user selected total row if (!is.null(row_level) && row_level == x$inputs$margin_text && "..total.." %in% x$meta_data$variable) { @@ -626,9 +641,11 @@ inline_text.tbl_cross <- # selecting proper column name col_level <- - var_input_to_string( - data = vctr_2_tibble(col_lookup_table$input), arg_name = "col_level", - select_single = TRUE, select_input = {{ col_level }} + .select_to_varnames( + select = {{ col_level }}, + var_info = col_lookup_table$input, + arg_name = "col_level", + select_single = TRUE ) col_level <- col_lookup_table %>% @@ -636,6 +653,9 @@ inline_text.tbl_cross <- slice(1) %>% pull(.data$column_name) + # replacing passed data with, tbl_data (only data used in table) ----------- + x$inputs$data <- x$tbl_data + # evaluating inline_text for tbl_summary ----------------------------------- expr( inline_text.tbl_summary(x, variable = !!variable, level = !!row_level, diff --git a/R/modify.R b/R/modify.R index ad18ed345b..f4f89bfc33 100644 --- a/R/modify.R +++ b/R/modify.R @@ -91,9 +91,12 @@ modify_header <- function(x, update = NULL, stat_by = NULL, text_interpret = c("md", "html"), ...) { # converting update arg to a tidyselect list --------------------------------- update <- - tidyselect_to_list(x$table_body, {{ update }}, arg_name = "update") %>% - # adding the ... to the update list - c(list(...)) + .formula_list_to_named_list( + x = update, + var_info = x$table_header$column, + arg_name = "update" + ) %>% + c(list(...)) # adding the ... to the update list # running modify_header_internal function ------------------------------------ rlang::call2( @@ -116,7 +119,12 @@ modify_footnote <- function(x, update, abbreviation = FALSE) { } # converting update arg to a tidyselect list --------------------------------- - update <- tidyselect_to_list(x$table_body, {{ update }}, arg_name = "update") + update <- + .formula_list_to_named_list( + x = {{ update }}, + var_info = x$table_header$column, + arg_name = "update" + ) # updating footnote ---------------------------------------------------------- footnote_column_name <- ifelse(abbreviation == TRUE, "footnote_abbrev", "footnote") @@ -154,7 +162,12 @@ modify_spanning_header <- function(x, update) { } # converting update arg to a tidyselect list --------------------------------- - update <- tidyselect_to_list(x$table_body, {{ update }}, arg_name = "update") + update <- + .formula_list_to_named_list( + x = {{ update }}, + var_info = x$table_header$column, + arg_name = "update" + ) # updating footnote ---------------------------------------------------------- # convert named list to a tibble diff --git a/R/modify_table_header.R b/R/modify_table_header.R index 1cc19d9ec7..323b860ee1 100644 --- a/R/modify_table_header.R +++ b/R/modify_table_header.R @@ -56,10 +56,12 @@ modify_table_header <- function(x, column, label = NULL, hide = NULL, align = NU # convert column input to string --------------------------------------------- column <- - var_input_to_string( - data = vctr_2_tibble(x$table_header$column), arg_name = "column", - select_single = FALSE, select_input = {{ column }} + .select_to_varnames( + select = {{ column }}, + var_info = x$table_header$column, + arg_name = "column" ) + # if no columns selected, returning unaltered if (is.null(column)) return(x) diff --git a/R/select_helpers.R b/R/select_helpers.R index 963fcc93c2..9c0db6d5f5 100644 --- a/R/select_helpers.R +++ b/R/select_helpers.R @@ -22,83 +22,30 @@ #' type = all_dichotomous() ~ "categorical" #' ) -# THE ENVIRONMENTS ARE CREATED IN `utils-gtsummary_core.R` all_continuous <- function(continuous2 = TRUE) { if (continuous2) con_types <- c("continuous", "continuous2") else con_types <- "continuous" - meta_data_env$summary_type %>% - keep(meta_data_env$summary_type %in% con_types) %>% - names() + .generic_selector("variable", "var_type", + .data$var_type %in% con_types, + fun_name = "all_continuous") } #' @rdname select_helpers #' @export all_continuous2 <- function() { - meta_data_env$summary_type %>% - keep(meta_data_env$summary_type %in% "continuous2") %>% - names() + .generic_selector("variable", "var_type", + .data$var_type %in% "continuous2", + fun_name = "all_continuous") } +# broom.helpers ---------------------------------------------------------------- #' @rdname select_helpers #' @export -all_categorical <- function(dichotomous = TRUE) { - # return variable names if dichotomous included - if (dichotomous) { - x <- - keep(meta_data_env$summary_type, ~ . %in% c("categorical", "dichotomous")) %>% - names() - return(x) - } - - # return variable names if dichotomous NOT included - meta_data_env$summary_type %>% - keep(meta_data_env$summary_type == "categorical") %>% - names() -} - -#' @rdname select_helpers -#' @export -all_dichotomous <- function() { - meta_data_env$summary_type %>% - keep(meta_data_env$summary_type == "dichotomous") %>% - names() -} +#' @importFrom broom.helpers all_dichotomous +broom.helpers::all_dichotomous #' @rdname select_helpers #' @export -all_numeric <- function() { - which(data_env$numeric) -} - -#' @rdname select_helpers -#' @export -all_character <- function() { - which(data_env$character) -} - -#' @rdname select_helpers -#' @export -all_integer <- function() { - which(data_env$integer) -} - -#' @rdname select_helpers -#' @export -all_double <- function() { - which(data_env$double) -} - -#' @rdname select_helpers -#' @export -all_logical <- function() { - which(data_env$logical) -} - -#' @rdname select_helpers -#' @export -all_factor <- function() { - which(data_env$factor) -} - - +#' @importFrom broom.helpers all_categorical +broom.helpers::all_categorical diff --git a/R/tbl_cross.R b/R/tbl_cross.R index 507a498eb7..268974b1a9 100644 --- a/R/tbl_cross.R +++ b/R/tbl_cross.R @@ -68,15 +68,21 @@ tbl_cross <- function(data, data <- data %>% ungroup() # converting inputs to string ------------------------------------------------ - row <- var_input_to_string( - data = data, select_input = !!rlang::enquo(row), - arg_name = "row", select_single = TRUE - ) + row <- + .select_to_varnames( + select = {{ row }}, + data = data, + arg_name = "row", + select_single = TRUE + ) - col <- var_input_to_string( - data = data, select_input = !!rlang::enquo(col), - arg_name = "col", select_single = TRUE - ) + col <- + .select_to_varnames( + select = {{ col }}, + data = data, + arg_name = "col", + select_single = TRUE + ) # matching arguments --------------------------------------------------------- missing <- match.arg(missing) @@ -114,7 +120,7 @@ tbl_cross <- function(data, } # get labels ----------------------------------------------------------------- - label <- tidyselect_to_list(data, label) + label <- .formula_list_to_named_list(x = label, data = data) new_label <- list() new_label[[row]] <- label[[row]] %||% attr(data[[row]], "label") %||% row diff --git a/R/tbl_regression.R b/R/tbl_regression.R index ad4b3bc4e8..e460f726d7 100644 --- a/R/tbl_regression.R +++ b/R/tbl_regression.R @@ -170,19 +170,32 @@ tbl_regression.default <- function(x, label = NULL, exponentiate = FALSE, # saving evaluated `label`, and `show_single_row` func_inputs$label <- - unique(table_body$variable) %>% - vctr_2_tibble() %>% - tidyselect_to_list(x = {{ label }}, arg_name = "label") + .formula_list_to_named_list( + x = label, + var_info = table_body, + arg_name = "label" + ) + func_inputs$show_single_row <- - unique(table_body$variable) %>% - vctr_2_tibble() %>% - var_input_to_string(arg_name = "show_single_row", select_input = {{show_single_row}}) + .select_to_varnames( + select = !!show_single_row, + var_info = table_body, + arg_name = "show_single_row" + ) # including and excluding variables indicated - include <- var_input_to_string(data = vctr_2_tibble(unique(table_body$variable)), - arg_name = "include", select_input = !!include) - exclude <- var_input_to_string(data = vctr_2_tibble(unique(table_body$variable)), - arg_name = "exclude", select_input = !!exclude) + include <- + .select_to_varnames( + select = !!include, + var_info = table_body, + arg_name = "include" + ) + exclude <- + .select_to_varnames( + select = !!exclude, + var_info = table_body, + arg_name = "exclude" + ) include <- include %>% setdiff(exclude) diff --git a/R/tbl_summary.R b/R/tbl_summary.R index da22292329..da5b39a9de 100644 --- a/R/tbl_summary.R +++ b/R/tbl_summary.R @@ -207,8 +207,10 @@ tbl_summary <- function(data, by = NULL, label = NULL, statistic = NULL, data <- data %>% ungroup() # converting bare arguments to string ---------------------------------------- - by <- var_input_to_string(data = data, select_input = !!rlang::enquo(by), - arg_name = "by", select_single = TRUE) + by <- .select_to_varnames(select = {{ by }}, + data = data, + arg_name = "by", + select_single = TRUE) # matching arguments --------------------------------------------------------- missing <- match.arg(missing, choices = c("ifany", "always", "no")) @@ -284,10 +286,12 @@ tbl_summary <- function(data, by = NULL, label = NULL, statistic = NULL, df_stats = df_stats, missing = missing, missing_text = missing_text ) } - ) + ), + var_class = map_chr(.data$class, pluck, 1) ) %>% - pull(.data$tbl_stats) %>% - purrr::reduce(bind_rows) + select(var_type = .data$summary_type, .data$var_class, .data$var_label, .data$tbl_stats) %>% + unnest(.data$tbl_stats) %>% + select(.data$variable, .data$var_type, .data$var_class, .data$var_label, everything()) # table of column headers ---------------------------------------------------- table_header <- @@ -365,7 +369,7 @@ removing_variables_with_unsupported_types <- function(data, include, classes_exp # for survey objects pass the full survey object to `survey` argument, and `design$variables` to `data` argument generate_metadata <- function(data, value, by, classes_expected, type, label, statistic, digits, percent, sort, survey = NULL) { # converting tidyselect formula lists to named lists ------------------------- - value <- tidyselect_to_list(data, value, arg_name = "value") + value <- .formula_list_to_named_list(x = value, data = data, arg_name = "value") # creating a table with meta data about each variable ------------------------ meta_data <- tibble( @@ -386,7 +390,10 @@ generate_metadata <- function(data, value, by, classes_expected, type, label, st # updating type of user supplied one if (!is.null(type)) { # converting tidyselect formula lists to named lists - type <- tidyselect_to_list(data, type, .meta_data = meta_data, arg_name = "type") + type <- .formula_list_to_named_list(x = type, + data = data, + var_info = meta_data_to_var_info(meta_data) , + arg_name = "type") # updating meta data object with new types meta_data <- @@ -400,10 +407,22 @@ generate_metadata <- function(data, value, by, classes_expected, type, label, st } # converting tidyselect formula lists to named lists ------------------------- - label <- tidyselect_to_list(data, label, .meta_data = meta_data, arg_name = "label") - statistic <- tidyselect_to_list(data, statistic, .meta_data = meta_data, arg_name = "statistic") - digits <- tidyselect_to_list(data, digits, .meta_data = meta_data, arg_name = "digits") - sort <- tidyselect_to_list(data, sort, .meta_data = meta_data) + label <- .formula_list_to_named_list(x = label, + data = data, + var_info = meta_data_to_var_info(meta_data) , + arg_name = "label") + statistic <- .formula_list_to_named_list(x = statistic, + data = data, + var_info = meta_data_to_var_info(meta_data) , + arg_name = "statistic") + digits <- .formula_list_to_named_list(x = digits, + data = data, + var_info = meta_data_to_var_info(meta_data) , + arg_name = "digits") + sort <- .formula_list_to_named_list(x = sort, + data = data, + var_info = meta_data_to_var_info(meta_data) , + arg_name = "sort") # assigning variable characteristics ----------------------------------------- if (is.null(survey)) { diff --git a/R/tbl_survfit.R b/R/tbl_survfit.R index 31a7e03798..93b2352ccf 100644 --- a/R/tbl_survfit.R +++ b/R/tbl_survfit.R @@ -242,10 +242,13 @@ tbl_survfit.list <- function(x, times = NULL, probs = NULL, ) # apply labels - label <- tidyselect_to_list( - .data = vctr_2_tibble(unique(meta_data$variable)), - x = label, arg_name = "label" - ) + label <- + .formula_list_to_named_list( + x = label, + var_info = meta_data_to_var_info(meta_data), + arg_name = "label" + ) + meta_data <- meta_data %>% mutate( @@ -267,7 +270,11 @@ tbl_survfit.list <- function(x, times = NULL, probs = NULL, } # table_header --------------------------------------------------------------- - table_body <- map_dfr(meta_data$table_body, ~.x) + table_body <- + meta_data %>% + select(.data$var_label, .data$table_body) %>% + unnest(.data$table_body) %>% + select(.data$variable, .data$var_label, everything()) table_header <- tibble(column = names(table_body)) %>% table_header_fill_missing() diff --git a/R/tbl_svysummary.R b/R/tbl_svysummary.R index 35cddb77c1..edcf2cfb6e 100644 --- a/R/tbl_svysummary.R +++ b/R/tbl_svysummary.R @@ -150,8 +150,13 @@ tbl_svysummary <- function(data, by = NULL, label = NULL, statistic = NULL, get_theme_element("tbl_summary-arg:percent", default = "column") # converting bare arguments to string ---------------------------------------- - by <- var_input_to_string(data = data$variables, select_input = !!rlang::enquo(by), - arg_name = "by", select_single = TRUE) + by <- + .select_to_varnames( + select = {{ by }}, + data = data$variables, + arg_name = "by", + select_single = TRUE + ) # matching arguments --------------------------------------------------------- missing <- match.arg(missing, choices = c("ifany", "always", "no")) @@ -221,10 +226,12 @@ tbl_svysummary <- function(data, by = NULL, label = NULL, statistic = NULL, df_stats = df_stats, missing = missing, missing_text = missing_text ) } - ) + ), + var_class = map_chr(.data$class, pluck, 1) ) %>% - pull(.data$tbl_stats) %>% - purrr::reduce(bind_rows) + select(var_type = .data$summary_type, .data$var_class, .data$var_label, .data$tbl_stats) %>% + unnest(.data$tbl_stats) %>% + select(.data$variable, .data$var_type, .data$var_class, .data$var_label, everything()) # table of column headers ---------------------------------------------------- table_header <- diff --git a/R/tbl_uvregression.R b/R/tbl_uvregression.R index 57df5b5fbd..cd4a2ce3af 100644 --- a/R/tbl_uvregression.R +++ b/R/tbl_uvregression.R @@ -137,13 +137,13 @@ tbl_uvregression <- function(data, method, y = NULL, x = NULL, method.args = NUL y <- rlang::enexpr(y) x <- tryCatch({ - var_input_to_string(data = data, select_input = !!x, arg_name = "x") + .select_to_varnames(select = !!x, data = data, arg_name = "x") }, error = function(e) { rlang::expr_text(x) }) y <- tryCatch({ - var_input_to_string(data = data, select_input = !!y, arg_name = "y") + .select_to_varnames(select = !!y, data = data, arg_name = "y") }, error = function(e) { rlang::expr_text(y) }) @@ -158,13 +158,24 @@ tbl_uvregression <- function(data, method, y = NULL, x = NULL, method.args = NUL stop("Select only a single column in argument `x=` or `y=`.", call. = FALSE) } - include <- var_input_to_string(data = data, select_input = !!rlang::enquo(include), - arg_name = "include") - exclude <- var_input_to_string(data = data, select_input = !!rlang::enquo(exclude), - arg_name = "exclude") - show_single_row <- var_input_to_string(data = data, - select_input = !!rlang::enquo(show_single_row), - arg_name = "show_single_row") + include <- + .select_to_varnames( + select = {{ include }}, + data = data, + arg_name = "include" + ) + exclude <- + .select_to_varnames( + select = {{ exclude }}, + data = data, + arg_name = "exclude" + ) + show_single_row <- + .select_to_varnames( + select = {{ show_single_row }}, + data = data, + arg_name = "show_single_row" + ) # checking formula correctly specified --------------------------------------- if (!rlang::is_string(formula)) { @@ -189,8 +200,14 @@ tbl_uvregression <- function(data, method, y = NULL, x = NULL, method.args = NUL } # converting tidyselect formula lists to named lists ------------------------- - label <- tidyselect_to_list(data, label, .meta_data = NULL, arg_name = "label") - # all sepcifed labels must be a string of length 1 + label <- + .formula_list_to_named_list( + x = label, + data = data, + arg_name = "label" + ) + + # all specified labels must be a string of length 1 if (!every(label, ~ rlang::is_string(.x))) { stop("Each `label` specified must be a string of length 1.", call. = FALSE) } diff --git a/R/utils-gtsummary_core.R b/R/utils-gtsummary_core.R index 6d43a272ef..af45689d81 100644 --- a/R/utils-gtsummary_core.R +++ b/R/utils-gtsummary_core.R @@ -244,212 +244,9 @@ modify_header_internal <- function(x, stat_by = NULL, ..., x } -#' Convert tidyselect to variable list -#' -#' Functions takes a list of tidyselect formulas, e.g. `list(starts_with("age") ~ "continuous")`, -#' and returns a named list, e.g. `list(age = "continuous")`. -#' -#' @param .data data with variables to select from -#' @param x list of tidyselect formulas -#' @param .meta_data meta data from tbl_summary. Default is NULL -#' @param arg_name name of argument where selector is called -#' (aids in error messaging). Default is NULL -#' @param select_single Logical indicating if only a single column can be selected -#' @noRd -#' @keywords internal - -tidyselect_to_list <- function(.data, x, .meta_data = NULL, - arg_name = NULL, select_single = FALSE) { - # if NULL provided, return NULL ---------------------------------------------- - if (is.null(x)) { - return(NULL) - } - - # converting to list if single element passed -------------------------------- - if (inherits(x, "formula")) { - x <- list(x) - } - - # returning named list if passed --------------------------------------------- - if (!is.null(names(x)) && # names are non-null - length(names(x)) == length(x) && # name of every element of list - sum(names(x) == "") == 0) { # no names are blank - return(x) - } - - # check class of input ------------------------------------------------------- - # each element must be a formula - is_formula <- purrr::map_lgl(x, ~ inherits(.x, "formula")) - - if (!all(is_formula)) { - example_text <- - switch( - arg_name %||% "not_specified", - "type" = paste("type = list(age ~ \"continuous\", all_integer() ~ \"categorical\")", - collapse = "\n"), - "label" = paste("label = list(age ~ \"Age, years\", response ~ \"Tumor Response\")", - collapse = "\n"), - "statistic" = paste(c("statistic = list(all_continuous() ~ \"{mean} ({sd})\", all_categorical() ~ \"{n} / {N} ({p}%)\")", - "statistic = list(age ~ \"{median}\")"), - collapse = "\n"), - "digits" = paste(c("digits = list(age ~ 2)", - "digits = list(all_continuous() ~ 2)"), - collapse = "\n"), - "value" = paste(c("value = list(grade ~ \"III\")", - "value = list(all_logical() ~ FALSE)"), - collapse = "\n"), - "test" = paste(c("test = list(all_continuous() ~ \"t.test\")", - "test = list(age ~ \"kruskal.test\")"), - collapse = "\n") - ) %||% - paste(c("label = list(age ~ \"Age, years\")", - "statistic = list(all_continuous() ~ \"{mean} ({sd})\")", - "type = list(c(response, death) ~ \"categorical\")"), - collapse = "\n") - - # printing error for argument input - error_text <- ifelse( - !is.null(arg_name), - glue::glue("There was a problem with the `{arg_name}=` argument input. "), - glue::glue("There was a problem with one of the function argument inputs. ") - ) - stop(glue::glue( - "{error_text}", - "Below is an example of correct syntax.\n\n", - "{example_text}" - ), call. = FALSE) - } - - # converting all inputs to named list ---------------------------------------- - named_list <- - purrr::map( - x, - function(x) { - # for each formula extract lhs and rhs --------------------------------- - lhs <- var_input_to_string(data = .data, # convert lhs selectors to character - select_input = !!rlang::f_lhs(x), - meta_data = .meta_data, - arg_name = arg_name, - select_single = select_single, - env = rlang::f_env(x)) - - # evaluate RHS of formula in the original formula environment - rhs <- eval_rhs(x) - - # converting rhs and lhs into a named list - purrr::map(lhs, ~ list(rhs) %>% rlang::set_names(.x)) %>% - purrr::flatten() - } - ) %>% - purrr::flatten() - - # removing duplicates (using the last one listed if variable occurs more than once) - tokeep <- - names(named_list) %>% - rev() %>% - purrr::negate(duplicated)() %>% - rev() - named_list[tokeep] -} -#' Convert NSE or SE selectors to character -#' -#' The function accepts a mix of bare (aka symbol input), tidyselect, -#' multiple tidyselectors wrapped in vars(), -#' gtsummary selectors, string, or character vector inputs. NULL inputs -#' return NULL. -#' @param data a data frame from which columns are selected -#' @param var_input selector statement -#' @param meta_data optional argument for use with `all_categorical()`, -#' `all_dichotomous()`, and `all_continuous()` -#' -#' @return character vector of selected variable names -#' @keywords internal -#' @noRd -#' @examples -#' var_input_to_string(mtcars, select_input = vars(hp, mpg)) -#' var_input_to_string(mtcars, select_input = mpg) -#' var_input_to_string(mtcars, select_input = "mpg") -#' var_input_to_string(mtcars, select_input = c("hp", "mpg")) -#' var_input_to_string(mtcars, select_input = c(hp, mpg)) -#' var_input_to_string(mtcars, select_input = NULL) -#' var_input_to_string(mtcars, select_input = vars(everything(), -mpg)) -#' var_input_to_string(mtcars, select_input = c(everything(), -mpg)) -var_input_to_string <- function(data, meta_data = NULL, arg_name = NULL, - select_single = FALSE, select_input, env = NULL) { - - select_input <- rlang::enquo(select_input) - # if NULL passed, return NULL - if (rlang::quo_is_null(select_input)) { - return(NULL) - } - if (!is.null(env)) attr(select_input, ".Environment") <- env - - # converting to list before passing along to next function - select_input_list <- as.list(rlang::quo_get_expr(select_input)) - - # checking if the passed enquo begins with the vars() function - if (!rlang::quo_is_symbol(select_input) && # if not a symbol (ie name) - identical(eval(select_input_list[[1]]), dplyr::vars)) # and function is dplyr::vars - { - # first item of the list is vars(), removing and passing to tidyselect_to_string() - return(tidyselect_to_string(...data... = data, ...meta_data... = meta_data, - arg_name = arg_name, select_single = select_single, - !!!select_input_list[-1])) - } - - tidyselect_to_string(...data... = data, ...meta_data... = meta_data, - arg_name = arg_name, select_single = select_single, - !!select_input) -} - -# this function handles a single tidyselect function, or bare input -# do not call this function directly. do not pass a vars() -tidyselect_to_string <- function(...data..., ...meta_data... = NULL, - arg_name = NULL, select_single = FALSE, ...) { - - dots_enquo <- rlang::enquos(...) - - # scoping data to use gtsummary select functions - scoped_data(...data...) - if(!is.null(...meta_data...)) scoped_meta_data(...meta_data...) - - tryCatch({ - result <- - rlang::call2(dplyr::select, .data = ...data...[0, , drop = FALSE], !!!dots_enquo) %>% - rlang::eval_tidy() %>% - colnames() - - # if `!!!dots_enquo` resolves to a NULL object, the above call will return - # `character(0)`. If this occurs, return a NULL object - if (identical(result, character(0))) return(NULL) - }, - error = function(e) { - if (!is.null(arg_name)) - error_msg <- glue::glue("Error in `{arg_name}=` argument input. Select from ", - "{paste(sQuote(names(...data...)), collapse = ', ')}") - else error_msg <- as.character(e) - stop(error_msg, call. = FALSE) - }) - - # assuring only a single column is selected - if (select_single == TRUE && length(result) != 1) { - stop(glue::glue( - "Error in `{arg_name}=` argument input--select only a single column. ", - "The following columns were selected, ", - "{paste(sQuote(result), collapse = ', ')}" - ), call. = FALSE) - } - result -} - -# simple function to evaluate the RHS of a formula in the formula's environment -eval_rhs <- function(x) { - rlang::f_rhs(x) %>% rlang::eval_tidy(env = rlang::f_env(x)) -} - # select helpers environments -------------------------------------------------- # setting environments data_env <- rlang::new_environment() diff --git a/R/utils-tbl_summary.R b/R/utils-tbl_summary.R index 1cc9ddbb71..3a1f07278f 100644 --- a/R/utils-tbl_summary.R +++ b/R/utils-tbl_summary.R @@ -1290,3 +1290,26 @@ has_na <- function(data, variable) { sum(is.na(data[[variable]])) > 0 } } + +# convert a tbl_summary meta_data object to a var_info tibble +meta_data_to_var_info <- function(meta_data) { + var_info <- + meta_data %>% + select(any_of(c("variable", "summary_type", "class", "var_label"))) + + if ("class" %in% names(var_info)){ + var_info <- + var_info %>% + mutate(var_class = map_chr(.data$class, pluck, 1)) %>% + select(-.data$class) + } + if ("summary_type" %in% names(var_info)) + var_info <- select(var_info, var_type = .data$summary_type, everything()) + + var_info +} + +# simple function to evaluate the RHS of a formula in the formula's environment +eval_rhs <- function(x) { + rlang::f_rhs(x) %>% rlang::eval_tidy(env = rlang::f_env(x)) +} diff --git a/man/deprecated.Rd b/man/deprecated.Rd index 285f23ccb2..95ad5c7d21 100644 --- a/man/deprecated.Rd +++ b/man/deprecated.Rd @@ -12,6 +12,12 @@ \alias{tbl_summary_} \alias{add_p_} \alias{as_flextable} +\alias{all_numeric} +\alias{all_character} +\alias{all_integer} +\alias{all_double} +\alias{all_logical} +\alias{all_factor} \title{Deprecated functions} \usage{ add_comparison(...) @@ -33,6 +39,18 @@ tbl_summary_(...) add_p_(...) as_flextable(...) + +all_numeric() + +all_character() + +all_integer() + +all_double() + +all_logical() + +all_factor() } \description{ \Sexpr[results=rd, stage=render]{lifecycle::badge("deprecated")} diff --git a/man/select_helpers.Rd b/man/select_helpers.Rd index b55f654387..d971ee0b31 100644 --- a/man/select_helpers.Rd +++ b/man/select_helpers.Rd @@ -1,38 +1,18 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/select_helpers.R +\docType{import} \name{select_helpers} \alias{select_helpers} \alias{all_continuous} \alias{all_continuous2} -\alias{all_categorical} +\alias{reexports} \alias{all_dichotomous} -\alias{all_numeric} -\alias{all_character} -\alias{all_integer} -\alias{all_double} -\alias{all_logical} -\alias{all_factor} +\alias{all_categorical} \title{Select helper functions} \usage{ all_continuous(continuous2 = TRUE) all_continuous2() - -all_categorical(dichotomous = TRUE) - -all_dichotomous() - -all_numeric() - -all_character() - -all_integer() - -all_double() - -all_logical() - -all_factor() } \arguments{ \item{continuous2}{Logical indicating whether to include continuous2 variables. @@ -60,3 +40,12 @@ select_ex1 <- type = all_dichotomous() ~ "categorical" ) } +\keyword{internal} +\description{ +These objects are imported from other packages. Follow the links +below to see their documentation. + +\describe{ + \item{broom.helpers}{\code{\link[broom.helpers:select_helpers]{all_categorical}}, \code{\link[broom.helpers:select_helpers]{all_dichotomous}}} +}} + diff --git a/tests/testthat/test-select_helpers.R b/tests/testthat/test-select_helpers.R index 956c4687d5..5a400f242d 100644 --- a/tests/testthat/test-select_helpers.R +++ b/tests/testthat/test-select_helpers.R @@ -3,42 +3,37 @@ testthat::skip_on_cran() test_that("test-select helpers", { expect_equal( - var_input_to_string(mtcars, select_input = vars(hp, mpg)), + .select_to_varnames(select = vars(hp, mpg), data = mtcars), dplyr::select(mtcars, hp, mpg) %>% colnames() ) expect_equal( - var_input_to_string(mtcars, select_input = mpg), + .select_to_varnames(select = mpg, data = mtcars), dplyr::select(mtcars, mpg) %>% colnames() ) expect_equal( - var_input_to_string(mtcars, select_input = "mpg"), + .select_to_varnames(select = "mpg", data = mtcars), dplyr::select(mtcars, "mpg") %>% colnames() ) expect_equal( - var_input_to_string(mtcars, select_input = "mpg"), - dplyr::select(mtcars, "mpg") %>% colnames() - ) - - expect_equal( - var_input_to_string(mtcars, select_input = c("hp", "mpg")), + .select_to_varnames(select = c("hp", "mpg"), data = mtcars), dplyr::select(mtcars, c("hp", "mpg")) %>% colnames() ) expect_equal( - var_input_to_string(mtcars, select_input = c(hp, mpg)), + .select_to_varnames(select = c(hp, mpg), data = mtcars), dplyr::select(mtcars, c(hp, mpg)) %>% colnames() ) expect_equal( - var_input_to_string(mtcars, select_input = NULL), + .select_to_varnames(select = NULL, data = mtcars), NULL ) expect_equal( - var_input_to_string(mtcars, select_input = vars(dplyr::everything(), -mpg)), + .select_to_varnames(select = vars(dplyr::everything(), -mpg), data = mtcars), dplyr::select(mtcars, dplyr::everything(), -mpg) %>% colnames() ) @@ -56,20 +51,6 @@ test_that("test-select helpers", { {.$summary_type == .$var_label} %>% all() ) - expect_true( - tbl_summary( - trial, - label = list( - all_character() ~ "character", - all_factor() ~ "factor", - all_numeric() ~ "numeric", - all_integer() ~ "integer" - ) - ) %>% - purrr::pluck("meta_data") %>% - {.$class == .$var_label} %>% - all() - ) stage_variable = "stage" expect_equal( @@ -80,23 +61,6 @@ test_that("test-select helpers", { c("trt", "grade", stage_variable) ) - # var_input_to_string(mtcars, select_input = vars(everything(), -mpg) - expect_error( - tbl_summary(trial, type = all_character() ~ "categorical"), NA - ) - - expect_error( - tbl_summary(trial, type = all_double() ~ "continuous"), NA - ) - - expect_error( - tbl_summary(trial, type = all_factor() ~ "categorical"), NA - ) - - expect_error( - tbl_summary(trial, type = all_integer() ~ "categorical"), NA - ) - expect_error( tbl_summary(trial, statistic = all_continuous() ~ "{mean}"), NA ) From dd4e490fbb797d8aebde6072b7be29f9b25614d7 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Mon, 26 Oct 2020 00:36:00 -0400 Subject: [PATCH 04/17] select_helper updates --- DESCRIPTION | 2 ++ NAMESPACE | 5 ++-- R/deprecated.R | 17 ++++++------ R/select_helpers.R | 62 ++++++++++++++++++++++++++++++++++--------- inst/WORDLIST | 2 ++ man/select_helpers.Rd | 40 +++++++++++++++++----------- 6 files changed, 89 insertions(+), 39 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index badc6ecc61..cf366ab19a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -97,6 +97,8 @@ VignetteBuilder: knitr RdMacros: lifecycle +Remotes: + larmarange/broom.helpers Encoding: UTF-8 Language: en-US LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 28229900a5..419ddaf50a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -49,10 +49,13 @@ export(all_categorical) export(all_character) export(all_continuous) export(all_continuous2) +export(all_contrasts) export(all_dichotomous) export(all_double) export(all_factor) export(all_integer) +export(all_interaction) +export(all_intercepts) export(all_logical) export(all_numeric) export(all_of) @@ -121,8 +124,6 @@ export(vars) importFrom(broom.helpers,.formula_list_to_named_list) importFrom(broom.helpers,.generic_selector) importFrom(broom.helpers,.select_to_varnames) -importFrom(broom.helpers,all_categorical) -importFrom(broom.helpers,all_dichotomous) importFrom(dplyr,"%>%") importFrom(dplyr,all_of) importFrom(dplyr,any_of) diff --git a/R/deprecated.R b/R/deprecated.R index 3fae2dc87f..a205cfc030 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -8,6 +8,11 @@ #' @keywords internal NULL +# tentative deprecation schedule +# "warn" for at least 9 month +# "stop" after 12 months +# "delete" after 18 months? + # v1.1.0 ----------------------------------------------------------------------- #' @rdname deprecated #' @export @@ -21,7 +26,7 @@ add_global <- function(...) { lifecycle::deprecate_stop("1.1.0", "gtsummary::add_global()", "add_global_p()") } -# v1.2.0 ----------------------------------------------------------------------- +# v1.2.0 (2019-08-19) ---------------------------------------------------------- #' @rdname deprecated #' @export @@ -53,7 +58,7 @@ tab_style_bold_levels <- function(...) { lifecycle::deprecate_stop("1.2.0", "gtsummary::tab_style_bold_levels()", "bold_levels()") } -# v1.2.5 ----------------------------------------------------------------------- +# v1.2.5 (2020-02-11) ---------------------------------------------------------- #' @rdname deprecated #' @export tbl_summary_ <- function(...) { @@ -68,7 +73,7 @@ add_p_ <- function(...) { add_p(...) } -# v1.3.3 ----------------------------------------------------------------------- +# v1.3.3 (2020-08-11) ---------------------------------------------------------- #' @rdname deprecated #' @export as_flextable <- function(...) { @@ -101,7 +106,6 @@ all_numeric <- function() { "select variables by class and type, and the {gtsummary} version is ", "now deprecated.\n\n", "Use `where(is.numeric)` instead." - ) ) } @@ -116,7 +120,6 @@ all_character <- function() { "select variables by class and type, and the {gtsummary} version is ", "now deprecated.\n\n", "Use `where(is.character)` instead." - ) ) } @@ -131,7 +134,6 @@ all_integer <- function() { "select variables by class and type, and the {gtsummary} version is ", "now deprecated.\n\n", "Use `where(is.integer)` instead." - ) ) } @@ -146,7 +148,6 @@ all_double <- function() { "select variables by class and type, and the {gtsummary} version is ", "now deprecated.\n\n", "Use `where(is.double)` instead." - ) ) } @@ -161,7 +162,6 @@ all_logical <- function() { "select variables by class and type, and the {gtsummary} version is ", "now deprecated.\n\n", "Use `where(is.logical)` instead." - ) ) } @@ -176,7 +176,6 @@ all_factor <- function() { "select variables by class and type, and the {gtsummary} version is ", "now deprecated.\n\n", "Use `where(is.factor)` instead." - ) ) } diff --git a/R/select_helpers.R b/R/select_helpers.R index 9c0db6d5f5..31efcac2ca 100644 --- a/R/select_helpers.R +++ b/R/select_helpers.R @@ -1,17 +1,19 @@ #' Select helper functions #' -#' Set of functions to supplement the {tidyselect} set of functions for selecting -#' columns of data frames. `all_continuous()`, `all_continuous2()`, `all_categorical()`, and -#' `all_dichotomous()` may only be used with `tbl_summary()`, where each variable -#' has been classified into one of these three groups. All other helpers -#' are available throughout the package. +#' @description Set of functions to supplement the {tidyselect} set of +#' functions for selecting columns of data frames (and other items as well). +#' - `all_continuous()` selects continuous variables +#' - `all_continuous2()` selects only type `"continuous2"` +#' - `all_categorical()` selects categorical (including `"dichotomous"`) variables +#' - `all_dichotomous()` selects only type `"dichotomous"` +#' - `all_interaction()` selects interaction terms from a regression model +#' - `all_intercepts()` selects intercept terms from a regression model +#' - `all_contrasts()` selects variables in regression model based on their type of contrast #' @name select_helpers -#' @rdname select_helpers #' @param dichotomous Logical indicating whether to include dichotomous variables. #' Default is `TRUE` #' @param continuous2 Logical indicating whether to include continuous2 variables. #' Default is `TRUE` -#' @export #' @return A character vector of column names selected #' @examples #' select_ex1 <- @@ -21,7 +23,10 @@ #' statistic = all_continuous() ~ "{mean} ({sd})", #' type = all_dichotomous() ~ "categorical" #' ) +NULL +#' @rdname select_helpers +#' @export all_continuous <- function(continuous2 = TRUE) { if (continuous2) con_types <- c("continuous", "continuous2") else con_types <- "continuous" @@ -39,13 +44,46 @@ all_continuous2 <- function() { fun_name = "all_continuous") } -# broom.helpers ---------------------------------------------------------------- #' @rdname select_helpers #' @export -#' @importFrom broom.helpers all_dichotomous -broom.helpers::all_dichotomous +all_dichotomous <- function() { + .generic_selector("variable", "var_type", + .data$var_type %in% "dichotomous", + fun_name = "all_dichotomous") +} + +#' @rdname select_helpers +#' @export +all_categorical <- function(dichotomous = TRUE) { + types <- switch(dichotomous, c("categorical", "dichotomous")) %||% "categorical" + + .generic_selector("variable", "var_type", + .data$var_type %in% types, + fun_name = "all_categorical") +} + +#' @rdname select_helpers +#' @export +all_interaction <- function() { + .generic_selector("variable", "var_type", + .data$var_type %in% "interaction", + fun_name = "all_interaction") +} + +#' @rdname select_helpers +#' @export +all_intercepts <- function() { + .generic_selector("variable", "var_type", + .data$var_type %in% "intercept", + fun_name = "all_intercepts") +} #' @rdname select_helpers #' @export -#' @importFrom broom.helpers all_categorical -broom.helpers::all_categorical +all_contrasts <- function(type = c("treatment", "sum", "poly", "helmert")) { + type <- match.arg(type) + + .generic_selector("variable", "contrasts", + .data$contrasts %in% type, + fun_name = "all_contrasts") +} diff --git a/inst/WORDLIST b/inst/WORDLIST index 943315c733..7eb98838f3 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -26,6 +26,7 @@ lifecycle Lifecycle lm lme +lmer logLik mL NEJM @@ -42,6 +43,7 @@ saddlepoint SHA sig survfit +survreg svychisq svyranktest svysummary diff --git a/man/select_helpers.Rd b/man/select_helpers.Rd index d971ee0b31..2cd1100ad6 100644 --- a/man/select_helpers.Rd +++ b/man/select_helpers.Rd @@ -1,18 +1,29 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/select_helpers.R -\docType{import} \name{select_helpers} \alias{select_helpers} \alias{all_continuous} \alias{all_continuous2} -\alias{reexports} \alias{all_dichotomous} \alias{all_categorical} +\alias{all_interaction} +\alias{all_intercepts} +\alias{all_contrasts} \title{Select helper functions} \usage{ all_continuous(continuous2 = TRUE) all_continuous2() + +all_dichotomous() + +all_categorical(dichotomous = TRUE) + +all_interaction() + +all_intercepts() + +all_contrasts(type = c("treatment", "sum", "poly", "helmert")) } \arguments{ \item{continuous2}{Logical indicating whether to include continuous2 variables. @@ -25,11 +36,17 @@ Default is \code{TRUE}} A character vector of column names selected } \description{ -Set of functions to supplement the {tidyselect} set of functions for selecting -columns of data frames. \code{all_continuous()}, \code{all_continuous2()}, \code{all_categorical()}, and -\code{all_dichotomous()} may only be used with \code{tbl_summary()}, where each variable -has been classified into one of these three groups. All other helpers -are available throughout the package. +Set of functions to supplement the {tidyselect} set of +functions for selecting columns of data frames (and other items as well). +\itemize{ +\item \code{all_continuous()} selects continuous variables +\item \code{all_continuous2()} selects only type \code{"continuous2"} +\item \code{all_categorical()} selects categorical (including \code{"dichotomous"}) variables +\item \code{all_dichotomous()} selects only type \code{"dichotomous"} +\item \code{all_interaction()} selects interaction terms from a regression model +\item \code{all_intercepts()} selects intercept terms from a regression model +\item \code{all_contrasts()} selects variables in regression model based on their type of contrast +} } \examples{ select_ex1 <- @@ -40,12 +57,3 @@ select_ex1 <- type = all_dichotomous() ~ "categorical" ) } -\keyword{internal} -\description{ -These objects are imported from other packages. Follow the links -below to see their documentation. - -\describe{ - \item{broom.helpers}{\code{\link[broom.helpers:select_helpers]{all_categorical}}, \code{\link[broom.helpers:select_helpers]{all_dichotomous}}} -}} - From f1599c52243f010946e701d474df38022df8f162 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Mon, 26 Oct 2020 01:09:46 -0400 Subject: [PATCH 05/17] doc updates --- R/select_helpers.R | 13 ++++++++++++- man/select_helpers.Rd | 10 ++++++++++ 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/R/select_helpers.R b/R/select_helpers.R index 31efcac2ca..95c399132b 100644 --- a/R/select_helpers.R +++ b/R/select_helpers.R @@ -14,6 +14,8 @@ #' Default is `TRUE` #' @param continuous2 Logical indicating whether to include continuous2 variables. #' Default is `TRUE` +#' @param type type of contrast to select. Must be one of +#' `c("treatment", "sum", "poly", "helmert")` #' @return A character vector of column names selected #' @examples #' select_ex1 <- @@ -23,6 +25,10 @@ #' statistic = all_continuous() ~ "{mean} ({sd})", #' type = all_dichotomous() ~ "categorical" #' ) +#' @section Example Output: +#' \if{html}{Example 1} +#' +#' \if{html}{\figure{select_ex1.png}{options: width=55\%}} NULL #' @rdname select_helpers @@ -82,8 +88,13 @@ all_intercepts <- function() { #' @export all_contrasts <- function(type = c("treatment", "sum", "poly", "helmert")) { type <- match.arg(type) + contr.type <- switch(type, + "treatment" = "contr.treatment", + "sum" = "contr.sum", + "poly" = "contr.poly", + "helmert" = "contr.helmert") .generic_selector("variable", "contrasts", - .data$contrasts %in% type, + .data$contrasts %in% contr.type, fun_name = "all_contrasts") } diff --git a/man/select_helpers.Rd b/man/select_helpers.Rd index 2cd1100ad6..ed5e49cf08 100644 --- a/man/select_helpers.Rd +++ b/man/select_helpers.Rd @@ -31,6 +31,9 @@ Default is \code{TRUE}} \item{dichotomous}{Logical indicating whether to include dichotomous variables. Default is \code{TRUE}} + +\item{type}{type of contrast to select. Must be one of +\code{c("treatment", "sum", "poly", "helmert")}} } \value{ A character vector of column names selected @@ -48,6 +51,13 @@ functions for selecting columns of data frames (and other items as well). \item \code{all_contrasts()} selects variables in regression model based on their type of contrast } } +\section{Example Output}{ + +\if{html}{Example 1} + +\if{html}{\figure{select_ex1.png}{options: width=55\%}} +} + \examples{ select_ex1 <- trial \%>\% From afc94bc2515498def57cd6751f48d993b5fc29a5 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Mon, 26 Oct 2020 19:10:32 -0400 Subject: [PATCH 06/17] Update select_helpers.R --- R/select_helpers.R | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/R/select_helpers.R b/R/select_helpers.R index 95c399132b..e2267de098 100644 --- a/R/select_helpers.R +++ b/R/select_helpers.R @@ -14,8 +14,8 @@ #' Default is `TRUE` #' @param continuous2 Logical indicating whether to include continuous2 variables. #' Default is `TRUE` -#' @param type type of contrast to select. Must be one of -#' `c("treatment", "sum", "poly", "helmert")` +#' @param type type of contrast to select. Must be one or more of +#' `c("treatment", "sum", "poly", "helmert")`. Default is all. #' @return A character vector of column names selected #' @examples #' select_ex1 <- @@ -87,12 +87,15 @@ all_intercepts <- function() { #' @rdname select_helpers #' @export all_contrasts <- function(type = c("treatment", "sum", "poly", "helmert")) { - type <- match.arg(type) - contr.type <- switch(type, - "treatment" = "contr.treatment", - "sum" = "contr.sum", - "poly" = "contr.poly", - "helmert" = "contr.helmert") + type <- match.arg(type, several.ok = TRUE) + contr.type <- + map_chr(type, + ~switch(.x, + "treatment" = "contr.treatment", + "sum" = "contr.sum", + "poly" = "contr.poly", + "helmert" = "contr.helmert") + ) .generic_selector("variable", "contrasts", .data$contrasts %in% contr.type, From 7b44e1c2ef3bc0d0dee31a24354b671a89369a6e Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Mon, 26 Oct 2020 22:00:58 -0400 Subject: [PATCH 07/17] adding theme elemets for tidy_plus_plus --- R/sysdata.rda | Bin 10193 -> 10373 bytes R/utils-tbl_regression.R | 17 ++++- data-raw/gtsummary_theme_elements.csv | 105 ++++++++++++++------------ 3 files changed, 70 insertions(+), 52 deletions(-) diff --git a/R/sysdata.rda b/R/sysdata.rda index 5fcc62f6d446b77b79ce38d9d230429bf12ce715..26b557a383137998b851413f8494cc9427f372dd 100644 GIT binary patch literal 10373 zcmV;0D0qj*T~Gtib2U?GoQAPr4Gr#VbB5T_b0`8pDZ0aws*)Ki zGRf@79kN!<0M)Qw$3T!l)Q?V;b%2euz1^3)yia26H)QMpWkjh!fm9qN5dcKVHcc{U zGzOYAJrgP9$$?F&wK8m}(`6owPY?va6HO0ON2%&)^*ts{G;Kpb z41u83$OO@((8;J8YEKl?)Bpyah-vCPD0-Rz0009(1JnQj00HVUG|)XjG&RfdK%G0U0zjBM8uG zPfV%#PfR9;rYZWSo}*%(lhoRS5vQmC^*u&_G|&$y&>o-wG-zZGP|yHtjSo%#ltd^i ztt~a?4J3|-R-=?^BY}mBSW0BZRZ`-`0RrM6uS>+?@cqYSaNz<6IDvvlSEi^*_C^Je zf%63AqQcpA)-i~e#Wf#n3IWB58BPWZF^)4oo}_(w_$YE zS?mi}Rh4Yu&<3U&lXbQGi*BZUyw|-X)XwKN-Sb@eY|RZRJ-P{0abx?Kl6OO8>@gY+ zWRNfabWfwAf=M092%zn)pYj@SxRd4bSg19C2_h;mf`D)H1r#DMK-5rTDZ2Q1wrUei zCvak-U=RzKsosD~z6>n9_G74+iU95sM1kqwASxDnV#5IIX3b;hpnn9xpXl3DorBQDgOxzl6$e8e9 zjH4*l$*e`wUf9A}AV}di|3r#burM5{WXgou<<3bv!%Oij^hR zTr;pn`%8k1I_YA$>1#?4c`(}B#i&PyA0tgaOXejp(|LO_iZZlP`2@Rl!o#*VoJ@@) z&X9VSQrii)|BV8TQ#kdOhrs8qC8!q z*h{MlIPG_Y;#j9aYo`_c3e7jMAtUBAk=ym-*!MkRNgzJ?`8ayr=VP`qu%VdC`>Kd6 zOQS&MZpR-sNHTv|aeE@x3B@+exlk5CR{6F8u6RAzAZG+%k{0o`+ByJ)teD`M@F}8{ z>*^(m1B#pU>#`F3Gda&Vu7!bPv&ml_ZmOv#i!=-5iDaJZluDL_`D&i=yHe`y*~59@zobWTf?3{fu)7^p&U<%hFVb=LZ`n#Ss{>diiO@?=x&%2J&r5ot-&fs%F5;ng^_7oMs5(+p(RYD9@6X(ET%7_SpfdoKgjDiUifTAlPsEPoj z7)XFI5m_VP<&R2db67BN_=gA_r6 zus~5FL>MXq7>WoaMl4n&Mhc3=K@njTR1zwHu|)w8V4@LGQCP(yASiKeg1Q8;j zil~ef77G*@r~-=t5Mdz2P+smMvj>7f6zMw}ASs-3$p`>K_5KciUdK1_e|E-qpA|g9 zsKq|TDQTUWE7^lQ>yYe*@iR097_1avF^Z<(onfMG_T)9?h)rcX1s1%1PXiMMm!;z< z5}jdj{0r*)@FjewMAnv8uxZ zx>3NO#Glww3W7|7L&ng<1SL6?qC?-WL7lHA?PuTEv6+( z#7kz-(hMX8Mp0V_a#W-a2ngYj7tYhx1`5qGWsh^R8&N73qclLT7NP?27{}*lbHApO z5LprO>4q0mjGn0w^aBPM#y7q3BAX?)C&8zhbiT$`K+qNeq|z=Mbl<8$Fa{Sg@-hae zZQD{5rwI@cKqP=X+wTETYew_~gqG^4%Ful<%Q{g~`>%ItGr*A8)MAU}DP3!{VJB@^ zkW)rPu~<{LD$vMmd`gN6PqFY}h*0Hmd=~@yJ262r;HI(UGj&ZGW>_c@aYB8h6T`i- z`ICKR+%mzU8j4PP{;j4HtALACvtU3M0el)lsX#>a3#dARIznieR5*fEwJULVCHYLw zQm9-QaCKKrUU|X`20#%Z5UC6FoVS)n_;DmKN;CYafZ0Z|`?$K&!&~-bJ)U>WU0p*w zQB+ev+!3UQ$u8fvC67?Gw=?@8V*Vf)vv0AeQIv zI;QmiL!lIPDXx3#H;gS`K= zyWO5fPGeQbaH$svk1Mg@+q_7K`0w!`z#g}NWL^_S)lMI!g}#6l2bNxRYcfkmo3hWF z%w9%d@3RClZ7`KYod8clp6aTbYZERaSb;h7!}3`xVM_M4Qx$L_|?9@A+4Ju1mE=k5R-C zQ_t{|`c8_clK8&Q#}G@{9iV}Yo*KHoZn-!kg?a)-z|eShBYcP|C@x87cL zkjuzrYY90;%xtOP7?G(_}F0+I2Vnce(vqj-;Kb&l{ZH4g{ zf!+UV`X`>h1{V>GRHV*sX3=fYv4=|x4o;z? zKB(>`t)=>q(FG%zuP8ivFB?s3muW3G)h8oCMNEAIo=#B7#qN-v+F{N6qq7YP{PzpvWPV$P^R^Avf4OC5+!&! z2b!qJS~Ng30mjl5mp%nvr#Vxg9f1xWS};z~^0Tnhe|`D)-tPy4z~IJ(=&`RGJ*Ma4 z^c`^AxqG~Fn!>zbxQtyGolkeiazv!_e*a(a`eN)G1);85%Cug#MG83dJ?8d0KBnrG zwo?q(t>2gDrTwK+v%JlU4ZY9wBSx7VzW z2>_Z3cXFJra^<7(u=dAGx-?z6vZZ}2xFkX}UmgkR!moWDk@}xDa||@KAK7HsVqQ%# zJ%rJqkWr6iD%uoB?2>s8LB}+$bSi!N34iOZJd<;qIC>imenC7z(vbRaG@b z6nN`e-*?CCI!zm7k4y#k_sSr1o-Vj}a7&7sJh;`jSuUgthd$%qoO|=xT?N6n$z(2V zCT4D&Noa;rm1tc$iAilqtW?D9HyTdg8jaJ)mAA~NUoEnQetm$?gtY?u1^Y*tfDB?8 zxlJ1GOl=aXqyDWB2Bh_)zqxIp1jx&(%&PcEQB|b%3C5n8#0_0wP}bJtwF89SUbxVS z1x>=C1zi#f1^C@Cm=!5xgYoE*fW|Q~fSGw>E>)mdUcr)F0MyHnqa@BzOsHHNSd|G0 z*1+rN_tkw$ww+d35cbZAnbsV~#G0z=vIyz`&2x6vgb|(}H?(3C|a5#PjICr{j z*~>&Y?@T6Y?@T zf>XX&qtvGPj0IC}0W#0Q^xqz7SymjI|FE01r?>EvDfb zb}N=OkZ)nVo|;GSD3QNGxGPoclTb8%8RkK~*-6{+tIUiMF>7iucJFhZTUgf6s|T-V zQ(J4eXnG_cu#q1h)cKdNN zn_LwZ>2&m{Zc|}-zzVDiq~|%<5xc*CRsqO!fn_}%X(iP;Wgi>s4}N3%YiMY%Prc}U zff_+VM**N-8U;6tj6q_hJfp-C5XI; z5Pd>SVW{Sq8QBKmBZLz`G=c291byoWHB23$d;hThx4(~@UX*tBPz`MlL{cOpSdRD) zk|0tBCFHU<1{-jB@MpKv{2_WF^FANbRc6G3X+1_V%beb9m0emwUv+`+38kFtsY2l8 zg{a*(H17&51OlK@RaGL$<1xbw9)77#DaNZ%(hNY(FrZcuy{w5GrK-|g+K$lGz=C4{ zS5Uh46p-I1QQZ$hp@mWsKAL}D6BMzF0wIZZnglRp(%>zlihvyrX!d7Y%yRoKvu_~c zaP|hhj1fhGY!cRx*j6xTQbRfkt|v2@LDSmxvH`k*(N?iREhNm?x4)^Rw;-xWC>KLE zO%hEEB*oU)RqInFLRX~26`lo@GE8&r#25%UAwXhP*$jr;aKRHW zbeG%}$emgQ*<++hSX{QVL?&xM1qeG@rU`$a+KhD|;=B*Kf)?Fu9+87`q2IVWeSk7% z^t9o#68q|n2==ddT$hgp!FOZJFf}yT(v%Ao%DCD_4{qIGjv)Ly&C8&I1-Xh$8Ok|9 z(Jq!6>0U{exnX>Q;$j=uQECk);*4d^CjqaTB!Xl`0Fh905jBxveB`7q*hvL>&_%)y zFe(PMDD`TC)iSloWAn7UHiE=S=?civvKz-_Y9|a_?Eb3~lMwp&0EBR;;#Gl!Sq#g^9Fa^O$N%o))~g1tda~WVN-1 zs72O;%4}aIe3V8y$eH0ee1ge0SguO|>qkKyG4K~9lF}ViI#7&^X2_89KlhMo{TB%{Is2Oo3FxR1L(ha4r zjS37TihT*>F-FYx$+jyUe5|2R+c0nqze8mc0Gi+>x|++JkfFjGxN3U4AF9w(OlV;7NVMp6roU{p`jFFwIx*~DS@_2 z1!NdNpb!bADTG2}F;vsgJCZgjQ(h*V^^8j|14}uRAsMe^HBbU#2?D8oK~V%FjatOS zHYC^#Rc!F}trS7Vf~3WG88|oOBH&-$e@`il#^@1xH4q9V2JlP)f#?i`U+nQ9-|-&7 z_yjtBKbi1xO+++-Lyji0>g$E$S+W(_RjUv`vc+V8ZxX4lMRE?HxobESc@m~jFEOmU zQzjBaCm=Y=G4{LRs2;FrNK{JkX$+AjVCfi*cQK#_1ge7cih~EOR7H6(kcC2_GzJQz z1cPu_CG@!(5eS4r<=gJ$Qm7Gf1_7C1E*_4e!QY|)%?+8^SdV^g2o$N_DJ9Nz%(5s8u>s7C(=*{lx@q5lE^yjyIMc`-H&JqwA z76Uu!B5eBhF1nRF{Yqe_xki$ZOVpx4Eq%raRbAe_x(nArnQX=dK;aC!NFfCznMOVw z^1zs@P)&^{Hf8sSN<{<|MybIjkI@(_!67;$c0efr)m5=Bp{nJA%miQ*w%~YTTlzcKm##e-vd=k;^^VpCg-rclR#^fAabW^(uGP2zGGF9qp*cjguilBOicsJ za#AFdkQ^p}_QQvnnX!qDi!(S;0T;|>v0ch(5%Pq=Qtjx4Vlt5+E(0)KwY9b}jiqCw z3%9Vm(8k>11enmc`FQLLaLi9{nm)|WYuZ;4Apvid-XjNku(u%iVI*(?ST8H=h_G2Y zEMRnS9j;)@CMs;NtL=Kfnb`Kf3rVhRfI%XX2qO>}3=OhMHEAZq)(j1t)JF2bvQVio zL@BceN`5!(r-#9aS-(Vy_N(h@S@;?wuzR(VM^igpL)v^kk9iVYV`<)Hj?OkM&Nlin zCioDTfQqmNkV#Xw0RzrR%O%Or4ofd-Ou>l2zROjdj_m^m0b`xjzr)0$TB%7R&(NyiCR8QPBLmFHsK7~pSqp$M z1WkM}0@Pe36{s0dunjBHwN%%iaCFR_6AggXp9Ux~Nv}j(&z-5XYs=?Ap@t?of(f~9p9H5xUuR^Gh5Dg>`mY*)^roxQ8d=I6Q-`bZofQHi$n+!P<%nxH)G789=dlGO}nYObP^rIyjgUh@I&ki80Sq zq?C(ft3w?Y#EF^B%1e8}vVYBh*`5ZHYm4DyWeWDm~UP z1eiy~L_}$C<1dcRPRQ^1{+k-Ih*>6$|R^f*^VNx zFF~ex$|0M(J^gt7-4*y9g$_9}0*E@gG_{o24rgy{3&dOUSd(Xl=%&$dF?_}%o~mdPPdMn)q+%QlyFqLZU+ZRS9} zCPSI^$p>yoQv?-ZU4lSGds4@rRFzOQAczDX0VQL)BOSmT3`FlNgd7OiIjC{#ixseE zPIxvc9diCoI&;jMvroi2W5Vm$K-5uDf~5t3LGnDWAO0awD?u)Af&qFV;5~$YKZH~V zzRBb&`Ufa0lre(6|KYb*UrI_Lbw;Hy0MP(EnB~C+Kra}91%O}<1VSMp+~wk-;u>)r z#8XpHGM}L0p@-`Us~V8|gC_S1Yzz}ZpiO`s#YuDkuoQq9zi)>F!iZ!wq>8b=2;;^o z*fC%c7!vaaB1z_V4DWLc`9S^iK*~Ax z5U39l&x@#@*7a*Td4fW!t2Ot*d z-GHi0Kp@bXDNbQd4${~+7TT)b5k>@DGa&%N4Nw8iaI4mj7;w9+*XJEfP_7_2sd<*D zR57i|%n>m!_jTB%^%YP26E3_wNBr;*T*ix)0Jv86$~FeTe~N(UZbBrR45_zTeSo6y0^Ug7#R@zTo+7oMT|I7|k=FD+&03M3+k5zVt{!f>t;t(5?V zQ4Ld?4;!2BOI*4Q#xI@HT!C<$o}YU=NPfZ*;0PJ6^~-pXhlKPP5WzM|1~IlIL`t9n zfUX24jj@kyjGOQS#Spp!gJ6d1+5Fo_^KyK86ATS09It75L6k@7` zfC3N*s0*q^5lpI@Ac2amJKSwA6agrg77(M36h^~@CTWMOJMKg}HOm$4!-3!p@z{#*En_w|T98n@7gQW|_Q%DKF zb7toacycl53$aB9NRS0_3`|!N|Mz&R%*6mA!WAYX#Eoej)&MMQy6?V6MLc7n1PT$j z*Mbm0rUFyFqzl$1Z&~|WTLZA^VT@qd@icOxl`Tv2&>G?FICM*=~8=7okJUEn~q9cTJ6h>J9~g9qnSNK#`Zf%FMy5nmV#AR{J_ z?07ZA#D@*q5Z%sdRw#@_L{UhQBnB`R3>gcv$|9jr1j=i3@!?z#gd!^dM2$fJfCMZr zh9F=EgTgobgHsp|(X7rtE&mOu#a%?=>Hx4suONN8jDf8j9B(XF2CO>ZN?8!GtJ$H$ z0QRi_+YXiA^hkQ2CUArxbpg&q#&9e^fMCEEK-(aYG>7&2jTHoHWkPZufAeR_ncFzQ z3}0=9!*x`A(stT4Q1U-lDtE+*!l&dOruV zbL&e#f%8&3E*@9Nc{Z;OhhGNjg`l`3;1TvdZ`cooPTkn=W%l1~rC(AIU;*`17cn*I zADQ5)&(gNmBzXppo?@Ym=pzo8=X6{s4Gac=Xcv&&X)0|JBv~mMgJpw4Ca+`%4gxk1 zeHkuU;HyGC){(T%h<2(eUJM}e-FRu{9i{;#X^*tF$JDwkWwANOtJ>Q zM1@~aV>z-$mV|0NFtQLSnN8Wh)xgf<1)x$AUpftHYC1S~+E=&j05}mw7#}1Z^Xx42 zrfSLpTp_uxG))|)n`Fl7LdQZR(KbG(?`5T2BN|*Et6OH(20+~qs?lKtfH)cYz|#Ch z$nbc!UCDnsH=QFtZjK{ns%$hQ8V!V|zl%_~)mJJJ&7jmmw94`%M|%_smAOS#QAVgf z*J-+NHI7}PbiI{#URR?yJYdEhsFn?hnTR@%U$gCZXRM#Sa`1C$zVD%4K0phw~iMdzMm8^-F}XwE`VFK5FjDF+X5KG$!>VaU8$CM-;G z>3R_~G_&v#6JL?XqE_q#>#+jiU@aFYj0mk|N9V7}4$kYliM_!okP_oP#$gMKP|Th; zllg0~Z5l){vH^t&Zbp{Me?4puh7!s$5+dM`N3|8fB0_Q=@g3=Rfk8}nI!QozVIOh+ zxBJ-3^BOFKd7${-2QwfI-mZu?xv;zvClCVs0wZzHB?GDHHqg6F@mLwQl)!ol8+QZ< zaeHqgbJk z%2=WTPKdNERawj4R5Mle(VAUc-2m|F{ndKq%>U>sO?c$ zyFv>Hh7_SLXTpwK6jOu{$|x?*Ew5oqsC(=|x=3UUf&t%lwO%!r!$E}^k)xPvK*FhUn3ogCW3@{IHM(qALY6`aZ7dLS zhQdq(MCLFoiG>W-%u%2u(>U!kW{7CwHicBg3=kNxaLJ>*bpsydAwbR}K}_qQ$y2;E zSeMzX*LmJ^+h)G_SE{J1nuSSY;(S5>%$C97qP!iwAu8~E^I6K$22K@KMbn)N zxQkYHLC@&@-)qF{ezGnG8v;@V46{0Q!d<}wTa!mT*uH!L{kza-g9mR=DHpA&Dw@b+ z5fiwm?g6ai6CR6#(4j^b%*VPfWA zH*(RP33=(&#&O*YdBA1EV`%$oHpm>IDD3fZ26Ne(yfv){h2+XX?)E2Uatp*nZ9Lpa zK9Ua2$Tu#?A1wv<>HL^EtLv?b^VC&0_OtG-43!eLMuo*2SNVS1mQS&LnJ~}+!nv;N z%(}pKc{U*U@W;Qri}c2c`NlwVlJJj&4@rYfv8bvq8HJa9F(pmEs%Y-3NxZye;<8Tj z@D5GVmsp>}FNe^(o3#3iqjO~KV<}8mqTbZMz7q&cQt<(;N(_@oYBBE@N}dwm5g}O) zT`Ox23$nI!ZI*3_(O`I13|AXV2JjA^qIrG3-?_-B%64GYm`d28O)zL0659Z^s;1rRPZgurYn3*S&Q)+CZ)H5o2dW}ySqiQ^-rkX>dYKc^Lq!13+j7fY1N{000bt&;S4klt7vY)bf+a zrk)}*L8+rm)X2osXhDz%q|-r=F)}m*Ajkj)hJXf*2AUZfWYE!|$)TE?P!c2v6CgmC zjV4W^U`glz5_)Edq)*XJ4K&YGdY&kHjR&aHAoi*Hqd;l;pfq}is1H*{nE(NxJw}=U zX{dO$|J=ZswvGG> z16T+U@CX6*gaUkVJqjr@_OwV{BtH`jsSO^lR>bX4)pK_>7dZS{sCSIfrLSUvmD2kS zJL@Z}R_)5ZGy$Q8gy6QRmjX^2gIlbUpf5&e72S&4_OCy}CWwd? zxR;%tw8Upg>I*~~1zm=jx~nY~6b1T*6^SJn;KF38UyjR0xwDJhf|3#wp~}c{z?d^* zu5gAi%>!L3T&mUWkS22K|hyXfzNSpCB97b69d6o8^DAgGD}q!>tmF%elL5J?zD0~Hvk1VvylV;HE5 zBt|ksk%}UaMgkE9k|4xjBB02u7_o}QR2ZTR6@mhZ5+K1@7{pLgBNi(XEEN@qf+E5w zs3cX8Q9wixQ3$B0tYVQ66hVNDL|GOBh$;w*EEERP%j-HsRF;AY9w9c&+?7^Mx$bMjaE7|f4hXWuY z8$HvDcix{v+b`H~hXi-`G3+0k<6>aa^ZaE3Q>-ped3`@53MN&>&$FAR`S&M2%_SAn zbz0w6^Cb2~DyB*&F7w0KpjX8H-kb-=5lS7R%el9xYS6Gv@0)N~AGuA2`csvV2J-Z^ zYdy=OYi{cUHFRx~Z&D`lM%F01>X zIpCh>04ziLcSXUHgJyu z`!VZm3s)GUJrFK0nTjf{qv6ezzWZuc%npZ-6aSAbE)=C>(u)6~2#v6>0G3I81A~8qG5K}w? z=B6d(Ymy;^;yDmji!dQk)I}rmDJ$Idv{l6 z&UQ9ygbsWhQ?$u*>dP)BwXm@+*KKvMGP3tgS4G39Tp~WNM#8szu!Q(;aiU)j+r$|U z9iwm2+a2FoTMJoT10K!xE0ng@W$;op=U1Vc^(y;VPXXL zj!)cVjw+Ix*$$jICv*B;7r^N$LUIUn;#_oXBS`4EdR5KGq`pn;7l{F*S(U9~W_ zOLTgnge_3OGg_`5AyvhNG{F!?3L+ezN2jZfe;wDY)S>)!P)h>`$kEgcq*z!qFh;I? z!7;nU@mS>q+%qzW-mZ=y?E=qbF!7}lI!CLX;zY&>g3k5mXuAOt{-rln8OvS){XTUE zkjt^~N*_>k{fF7$^6v%mab8|@kjuzrYXWaq1yZcTs3PoGEQ2u7nCVBwob8PkNh~Up zl~~oeXI$qm4B?KR?BC+58LG1ZyWUQ`-kx5kn5yiLJacS_<#^Wb(fVQfuIRNXPVw40 z_29=!jQZQGMYl%A3W^YvZbd>p%P~=ffVnZQp|=nUjJswFi4Z01k}x#%@umAD)OfN} zOgn=-_S`OKGPR+nC?0{9Lu5eG!!JufVT}@yn==z*qToRV$9s@IYWpF;dim z%Pw9uS*ABxH7KM?QLLm}MMQ#nP$KhO?OR^`i$dYH=6+Kg>?t{& zyOJ^?xl;Dd;p9qdM3Ti!PtxAfK7VOC-SkWSW?f2>*#f~rSkHXB0iW7ILqaW$lr|2#uzKL^I}k&$?0L3<<*nLKW`krd zoeU}LR4ojdaHtp-UZL0CrX(Q-5C#<*3qb<Cv^}@AG+~nmPE%a)eLL4N zcg|+VuS1#$S+xbZ(go$AQUz5JQ=KYm^^JgwVRhMSTN-5RkmFp0tB|##BE8iZ$i`th z=V!MVutrjaw?!H8CI@R+ahSmD0O6|aCN$D6L;(zB>Id7*giPf}%9GX;0*e)tA0-Q2 z5Y{sfq#7AQ7^#_?hpq*NCleU%yUna{(ciZEN+GiT&wZ;Qp?XvB?NGkNf#A0=2ZFK{ zT%Pb?L;>sIP3o-9*@@el@b|EX;B!-gSg0jC<%&ms1~Bkc2Eqi%T6!7N0y%}4ZM>a< zdW4HX7#I$CPVameKqD<<#DD|O5KD2qMw?a38pt@HZ9|z;dDPZZ1GP}E+=d#&0bSlB?ncmjTP5K^*5cH)+MM!7 zeFJN6v*phFy++P!4h8!TI@*#ZU0pH7DNG*{V`@}JDz(Z*CWt+Qo}bj`y41-PFfRx`B1~bVfXb*gi5tN*hLAmWy&rbM4JHoIyq~lF z$CDjBEfLt+KsGcy;*lk=M@SQHlp2H=%ify99azlXS3a%}t{z-HA4$_(=YoXNbhyhG zIlbB{yA*`F+X3y#rJVbgg`vueQMKIa>hhUaEiVM57mtV}2w1z4 z{Tp_GZ=<8KI_OT&`oixSGi!?OwyM(|H92?KMFx4+ zq%nrHfflw-7b?Y|gU-lEa&>ty&8Qj>E>KE}g^I}uq=+h_It63Tlq`XzW`|O+Q4p?) zFepgMc~XF06{Yl%f`JY+B7j50!Kk&R9VuBnlw$XEsIO(17iB==3sP7Q2))i!a2m6c zk!09qf>PXvfXPkEK%6kJVAQb%Fij%Urle+imt0g97%HH4$dm?Uy=u_`5*MV!hF7uy zph3!o0f|>+GL5uD1WbX;zXVq)JmLb|Bh`vbp0gB+$UbPV_Ygwe zv4hZH+^Bah4$o8!nVtJEF1v{tquRaUa$X!41>Ij9z}C}alnWKgxf(_fcI|()5Pdt% z=RpSf3QQTwIYH4byA71DQf01KUn1gS8`)83tRDIeJDg4fXEaF!$ch0Xpyny$SYHZK z7i1)Yyy`9xasg1-r5=q?dL~xK;nCl?76MN|tc>=MVYW0U3|#E~yAqQS`gj0@aH!+B zHq5iJ0_!>hr}?!mk=z&b%2+$tl34-SXjmh~VM@i4EEY+{DpW`?sl(o|7YO$&BpS7H z9dPAq9=}l6U14qm8Euj;g#u77Ongtlxj-V}R5$~Zs)5MF4Ot_HvnlkGwXB5Q1TUJ?}e*skm-*C=@l( zcUx$hNC62310Ap-G^K1KVj$MUmAt7G0#hTLXR+&+81bbr*{N*I8%t**6c|Yq z`cu|0jheQ}wwr0|^)5ssy2KtKff{Jv*UHH>nlS)@;6jrKgM>ls1LHgSB)eCQgbUy4 zymBWjL=eNCLKFxX!3GE%8W;&d26wg)nYOj&X(7X?VxfnlQ2ZflbW$!VY&N#W480{P zqk*LZ2FM$BCc3yL?BkdW3xf^SxY(Z5h+^zZiyq_%AqR-jZ0RqIAr?f5lk)pPR4D?# zk7bWtE=uD#kPlKWKt`_S&4E02<}MQrA?TcYS=L>yNxYVCPFnYU^UPJVhIANeL+zLLuO-%a0MceNs&$M z-DJWB%nXH$z+~X!$VI@vG5#J?8I8~)^lKm#N)8}Q0YJkPVi9v^pib2@4&+l_o)=~m zBOpovg#m13g`=iz1$C;`h#%czvOqVfRMbUq94Y8(ZWc0uftuFbxp1@+_SrB;bD<3& z?}36sqAwOBN4AJ8USEQs4ohG39{TJ+q`NaP^e7-dZ@u5+7-g;T8ajNplB{# zp48}p7C^u?6#~Q0uvj~kNLeI0kQe;3h#+mY+}bJ<;fYk7nhjwxI5Ba80}D_$su&l7 zafA++P%}&iLY&DhM(OI7^q&zuFE96JTI@aqd6B_XP(@V)UAZD{aM-$(sodqI>S`#` zQVDXDNF|qAQG`U_6y@WbdCa?QkU|Z^Q({8|HYBc0d^)ngn5$4tjV3l__ee@b1QbTO z!6uQ;Z3?t5AX$2qMITgd5=G#zCkd!E!2zmXqJm*nR20K56k0lHh=Q2(cjmJ2Wu0-UW6Av6%RpkmrTSTK!QfoCWIcZdLHE85^|@47fQ3A{F!l4uQ* zgbq~lohVeGtLU2SjQXh+I7|1XM8wcMx1}OUIRV0E9?)>}GgBCt*tHs=Lbb(0*_gJhvnV2D#??v(sb-OmpuA!ht!Pp@5h$zH@pQ#4;{A#kNjfn}O_ zm5^#s6;WcA5v-_7V3QWy4oz8b2#5%)0BHo3KL`jNe2lVPpb~&k6x)nCA_pNV4mECE>{a#?#yW(;FNJ+g^Aj${;Q2_79fo9s!F0Y5ec0}>gd zgw8}cD*^~X#4iH?4Dd*6=fDeDa44-n%7uVwUX`k*ySE2kWazepD?SWCd7|Pz9c`lz zhiqVBkRZw+0igN~Xib8R5t(3C?x|#O4>%3# z0IelJ&fqA8AfzjunkEj^P*uUpI2g(Wi^-LfDohFlg*rH#;wO5RwAQUErDqzD4U^tn z&{B1R^w&%Tcf0#=_hJJBCW{9T9I^$km-FYH+TaODYsyB{jD}!Z5R%56S6*BTyE$@U z#iu^kB5}${COx0L%3lv8!&c9eWMxr`0|F^98WT(mg9BmMC#;xewbLMV^``(@=^I-Fe)PrKiR=`kL?s&2ZHEbo?(L7d>eCo2<)xMoI?I%|nJ z7RgqIIolE@YMYdo6Tz~CA3Tm8D-oVmlt#l)1!O~M>maHRZ zuy-q99}Q#~%r!Fs?+qU9(5Nll8UWZe(pjT?n#TpzRys)YExwJhC@zXBi4hW}PT<}r z0MzUNmN=fV_0`%BFSh9k0}wsmgZN*1=kRx;DFTbPV(?bd%^+$%3t7($VkrUE;W*o2 zIFeg!C_z}#ZUFQY96Ss;Qa5ZvcNOn&4o9O5AXf#J8&y`M%?xr4pz_g&B+`)G_B!(B z=Y*Hy{dhRhfDnOcpJhqL;P7=ifK?z>x@4O>mqj-Vfs5Z_EfJIGX(6gQPN{fY;=u1|ycXYA_6hkNx;0Br@NTw!10wd@6vQ*!Q z6fx(78cG7LQ2= zt~2P&kHIFAQ~*7OgK9R4@F66HfV+tq2MHZ!BDqbIIZiZSl9;H+fy!!;Wq_T1L#MSH z6|75~;P#19yVN%I?@61$h_QLBX$`T~g|D$~M3V%_A(51ecPT{U; zAjsx?CJ2d3kO|80qFkwMlqLp)P+(hZ4b~W8fT}vB6Rb*Zc4dQ&Bq@Rlu&&V{BED3y z=hr1v4M-vZ2e?UC?JReIa4{3SvJh}1Xy&0|^@)<0YDdlubdI9!{B-A-Zw)<}>W|&l zuz{6DMhcV`0SAf2@xS5~0<;p==pYv&9rM>m^>_t9e>NONUUA3@ZG~=SPDQicVD3n?SX-_Bvp;jM;*egfr|iP5NvIXAiO=vjPR2j5bp_u zCRKJwR5GQH>|4G8KWu-*Djqi8UM&nk$|OvqP0aoW>DV^=^JogamXB@bpTtIPB<0Vk2WxEDg31Ge!{_@0-7V%#llnr_1 zSV5OUf>66IsJ=jg8BmBD#UO|b0fG*JU@C=8s$BBqESVylk(8zsVk zB@)uX3OL_HY#ZS~Aryk%+k-(YK`d50ws1NAT(;IuIx5i$Oo(hLEENihHgmik+E%9$ zna5@(I|gl@h3Ir%VXRR%U@=7;Q6eIPr3-~qND0WfvvbC%aq;06;))KDAPV9bn64$> zHbJ@>#(*W_6(%FVjfouA04!~~?@=8T@Q#EKC`R*U5P?Lv5??bQPNcRyOX0c21Dvh6%F`0zw2x0FoFAYz?K3+0DLT!rpM;Vi;p^)Kw~q)dwtrNH_J&JGh3?Spo|P zUIZOP9814UYX~5gad2k1lr2!v5fAinc8h9Gu( z*FQ3m|C7-$I*Y4!i~kKP*7(*3=?j+wW*|XviNIgA?2bza-tQQ2=QOHsG>F7RMHGn< zLNN&ugCTZ_L{usun3{SB@NEmj5tIRQKtLh@gv-H*7s2&4&i96FUC1H%!C-Z>R0bldph1b#AavjyL|_y{ewDNkH{b1X#03q2%v52% z7UV&L0Nw}UVt5A=#XGA9!RYerLy6<=J6!m78Zx(A-dkXCl1NUPELB;$%Bs7@lS&1X zn2ryTY`zxzoyj>6AwmwVdU+VX7e!v?=~_kj{GWHtx$`8SG4s?m+VOYiHe3dnHY8B zozZZhGhj3WK)gotLZ;y&MUs)MHrO*n)$D-bz*4*{qh7P?xisUkIu*`Tk{cAEap6gm zwJY{`zw)IGj|ZXe|L%u~g-GAmIv|-W-Z}OdYsvy#A-%3dO&q3{$&J*7j%bra z*!vIN%SCXEX>fkMZktpY19U>GMT8On;AhnhAAq?YXM=6sOZm~nb;f=&IL*50w9O#Q z-iY1$G71_cGeBmIV^RgHG~5_YBOn$nf{Lo5jvzlT?r@pw9p7=Dzsn!|_PVM>>M>X)>gMqQ8ATU%3MJm?ht~+h(7Ai0y%@P@n z<3MZ+kyaYEB%*juM4+S`K3II6p9O~^@no2>F~_d+M9|XJ<`ENLW0N^ssuQl%3x$BQ zxkO+^YbrkS{DAygQ}SO$krx6eYN3#Vgy6{^_W$4J%X!9Z5L##tHuIpxb(!~hU7z2u z&s++d;^76^psoSAM7Ovl>ztjIu83rO*R8#fLiX-dsj zZrgnnBc@FR7^!WHH=^`TMi(M=^tGwg9&Q%YOmG#z2u9$+2N`!p&oq|`Hf2VGvFYf8 zGiB$d>h|sCOK9-Uyd9kaRp9z2!gp5PJVLxPazXK4dABbg#p3LITl6nBc#I?z zMUljhi%D5!%9$h(kTH+~^tQB3P&fzBmSQ@R0W~7QufcpM^UYL9Ieta;%n3I@&MBYc zSVHTXlP{D9D7m>nKzjZj-$WzXXUs{j3_jLUwkZ8SddMt!*Z4~SciwRs-iV1zm&`%K zLhT4i$-zMKXltH$LJFAG1dpW63gPuDu$xL9ABjluTM1twBZ)C!x(({x|vWqPSGAaxLux80$-e#=**W#{> z`N~K-jNQac+n`>gLM^oO?4O-Yt(fljHC?79NS2}1prvY9nZ7QeZQ9#_KiM) zcv-2`o(EPrQ4?Je^BJ}M3Dy34kDDVB^83%Wp#KT_4u#elH_+Wn?QyTBy4tion4f`T zuLiv%k#88bOF&eAIC#S~JQ(b^Eb#~aZ+Q1#?O=m$8nfnPF(A=1QgH4y-IZ)v)?a?g zxk9<>7hVS!nyrNc0*`TmnD0P=1J@);`nGuy3{;hA@$bNlo8-9D_&3Dn^8`R>_7 zWou+kB4qD?zwbIos`9ZF1yn&miNbPf?BV0?uN%E+&TO3o>0~+WESbP&#j~daYqoeg zjDz#{*uyzY&RvDUiO9mRXlUBH1t^JtQksr$Z4X|C_XIV&&^lByWZ3yMI|=pY89m%2 zID5_2)iW(b!OGIOrE3QpuIcbGeAw}5fa1lkaVA873u-n<9qci$IEcSU&VAD$Imvg& z!Uvqerr6ln{|*j6gL>0~_Wab-!H-s}Dyt*+UXba!vT#Zp1>pi4iMXFtbuMSUf@Ud> z{5sX|Zv?{=9IAlUr4~o1H5mVit9ORCgeYL4#;I*Dfb@(CR?9ZbXt5s^gB8uGg;WlP z%5?p|Z>hiD$Hq6=H|-AxK?33pinJ15HUb9v=p@_R}mtSTa?*m9ttKm1+E L6yZWbdqFu|uvd++ diff --git a/R/utils-tbl_regression.R b/R/utils-tbl_regression.R index 5eee938f35..f5c6489d14 100644 --- a/R/utils-tbl_regression.R +++ b/R/utils-tbl_regression.R @@ -27,12 +27,23 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label, include = {{ include }}, conf.level = conf.level, conf.int = TRUE, - add_estimate_to_reference_rows = FALSE, - add_header_rows = TRUE, + add_header_rows = + get_theme_element("tbl_regression-lgl:add_header_rows", default = TRUE), + interaction_sep = + get_theme_element("tbl_regression-str:interaction_sep", default = " * "), + categorical_terms_pattern = + get_theme_element("tbl_regression-str:categorical_terms_pattern", default = "{level}"), + add_reference_rows = + get_theme_element("tbl_regression-lgl:add_reference_rows", default = TRUE), + no_reference_row = + get_theme_element("tbl_regression:no_reference_row", default = NULL), + add_estimate_to_reference_rows = + get_theme_element("tbl_regression-lgl:add_estimate_to_reference_rows", default = FALSE), + add_header_rows = + get_theme_element("tbl_regression-lgl:add_header_rows", default = FALSE), strict = TRUE ) - # add reference row value, requested ----------------------------------------- if (get_theme_element("tbl_regression-lgl:add_ref_est", default = FALSE)) { df_tidy <- diff --git a/data-raw/gtsummary_theme_elements.csv b/data-raw/gtsummary_theme_elements.csv index d076e06d47..a2a2169e84 100644 --- a/data-raw/gtsummary_theme_elements.csv +++ b/data-raw/gtsummary_theme_elements.csv @@ -1,67 +1,74 @@ fn,name,argument,desc,example -Package-wide,pkgwide-str:theme_name,FALSE,optional name of theme; name is printed when theme loaded,"""My Personal Theme""" -Package-wide,pkgwide-str:print_engine,FALSE,"string indicating the default print engine; default is `""gt""`","""flextable""" -Package-wide,pkgwide-fn:pvalue_fun,FALSE,function to style p-values throughout package; default is `style_pvalue`,"function(x) style_pvalue(x, digits = 2)" +add_global_p,add_global_p-str:type,FALSE,set argument default for `add_global_p.tbl_regression(type=)` and `add_global_p.tbl_uvregression(type=)`,"""II""" +add_global_p,add_global_p-str:type,FALSE,"set argument default for `add_global_p.tbl_regression(type=)` and `add_global_p.tbl_uvregression(type=)`; default is `""III""`","""II""" +add_p.tbl_cross,add_p.tbl_cross-arg:pvalue_fun,TRUE,, +add_p.tbl_cross,add_p.tbl_cross-arg:source_note ,TRUE,, +add_p.tbl_cross,add_p.tbl_cross-arg:test,TRUE,, +add_p.tbl_summary,add_p.tbl_summary-arg:pvalue_fun,TRUE,, +add_p.tbl_summary,add_p.tbl_summary-arg:test,TRUE,, +add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""chisq.test""" +add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.group_by2,FALSE,default test for categorical/dichotomous grouped/correlated variables with a 2-level by variable,"""lme4""" +add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.low_count,FALSE,default test for categorical/dichotomous variables with minimum expected count <5,"""fisher.test""" +add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous,FALSE,default test for continuous variables with a 3- or more level by variable,"""aov""" +add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous.group_by2,FALSE,default test for continuous grouped/correlated variables with a 2-level by variable,"""lme4""" +add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous_by2,FALSE,default test for continuous variables with a 2-level by variable,"""t.test""" +add_p.tbl_svysummary,add_p.tbl_svysummary-arg:pvalue_fun,TRUE,, +add_p.tbl_svysummary,add_p.tbl_svysummary-arg:test,TRUE,, +add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""svy.chisq.test""" +add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.continuous,FALSE,default test for continuous variables,"""svy.wilcox.test""" +add_q,add_q-arg:method,TRUE,, +add_q,add_q-arg:pvalue_fun,TRUE,, +add_stat_label,add_stat_label-arg:location,TRUE,, +as_flex_table,as_flex_table-lst:addl_cmds,FALSE,"named list of expressions of {flextable} package commands inserted in the `as_flex_table()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_flex_table(x, return_calls = TRUE)` and check the names.","list(autofit = list(rlang::expr(flextable::font(fontname = ""Bodoni 72"", part = ""all"")), rlang::expr(flextable::fontsize(size = 8, part = ""all""))))" +as_gt,as_gt-lst:addl_cmds,FALSE,"named list of expressions of {gt} package commands inserted in the `as_gt()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_gt(x, return_calls = TRUE)` and check the names.",list(tab_spanner = rlang::expr(gt::tab_options(table.font.size = 'small'))) +as_hux_table,as_hux_table.gtsummary-lst:addl_cmds,FALSE,"named list of expressions of {huxtable} package commands inserted in the `as_hux_table()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_hux_table(x, return_calls = TRUE)` and check the names.", +as_kable_extra,as_kable_extra-lst:addl_cmds,FALSE,"named list of expressions of {kableExtra} package commands inserted in the `as_kable_extra()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_kable_extra(x, return_calls = TRUE)` and check the names.", Package-wide,pkgwide-fn:prependpvalue_fun,FALSE,"function to style p-values throughout package that include a ""p"" prefix, e.g. ""p<0.001"" or ""p=0.12""; this is common in the `inline_text()` functions; default is `function(x) style_pvalue(x, prepend_p = TRUE)`","function(x) style_pvalue(x, digits = 2, prepend_p = TRUE)" +Package-wide,pkgwide-fn:pvalue_fun,FALSE,function to style p-values throughout package; default is `style_pvalue`,"function(x) style_pvalue(x, digits = 2)" Package-wide,pkgwide-lgl:quiet,FALSE,logical indicating whether to suppress messages or not; default is `FALSE`, -Package-wide,pkgwide-str:language,FALSE,"string indicating language; default is `""en""`","""es""" Package-wide,pkgwide-str:ci.sep,FALSE,"string indicating separator between upper and lower bounds of confidence intervals. Default is `"", ""`",""" to """ +Package-wide,pkgwide-str:language,FALSE,"string indicating language; default is `""en""`","""es""" +Package-wide,pkgwide-str:print_engine,FALSE,"string indicating the default print engine; default is `""gt""`","""flextable""" +Package-wide,pkgwide-str:theme_name,FALSE,optional name of theme; name is printed when theme loaded,"""My Personal Theme""" +style_number,style_number-arg:big.mark,TRUE,, +style_number,style_number-arg:decimal.mark,TRUE,, +tbl_regression,tbl_regression:no_reference_row,FALSE,Specifies the `broom.helpers::tidy_plus_plus(no_reference_row=)` argument, +tbl_regression,tbl_regression-arg:conf.level,TRUE,, +tbl_regression,tbl_regression-arg:estimate_fun ,TRUE,, +tbl_regression,tbl_regression-arg:pvalue_fun ,TRUE,, +tbl_regression,tbl_regression-arg:tidy_fun ,TRUE,, +tbl_regression,tbl_regression-chr:tidy_columns,FALSE,"character vector of columns from `tidy_fun=` tibble to print. 'estimate' column will always be printed. Select among columns 'conf.low', 'conf.high', 'std.error', 'statistic', or 'p.value'.","c(""std.error"", ""p.value"")" +tbl_regression,tbl_regression-lgl:add_estimate_to_reference_rows,FALSE,Specifies the `broom.helpers::tidy_plus_plus(add_estimate_to_reference_rows=)` argument, +tbl_regression,tbl_regression-lgl:add_header_rows,FALSE,Specifies the `broom.helpers::tidy_plus_plus(add_header_rows=)` argument, +tbl_regression,tbl_regression-lgl:add_header_rows,FALSE,Specifies the `broom.helpers::tidy_plus_plus(add_header_rows=)` argument, +tbl_regression,tbl_regression-lgl:add_ref_est,FALSE,logical indicating whether the reference estimate should be added to regression model tables with caetgorical covariates,TRUE +tbl_regression,tbl_regression-lgl:add_reference_rows,FALSE,Specifies the `broom.helpers::tidy_plus_plus(add_reference_rows=)` argument, +tbl_regression,tbl_regression-str:categorical_terms_pattern,FALSE,Specifies the `broom.helpers::tidy_plus_plus(categorical_terms_pattern=)` argument, +tbl_regression,tbl_regression-str:coef_header,FALSE,"string setting the default term for the beta coefficient column header; default is `""Beta""`","ifelse(exponentiate == TRUE, ""exp(coef)"", ""coef"")" +tbl_regression,tbl_regression-str:interaction_sep,FALSE,Specifies the `broom.helpers::tidy_plus_plus(interaction_sep=)` argument, +tbl_regression,tbl_regression-str:ref_row_text,FALSE,string indicating the text to print on reference rows (default is an em-dash),"""Reference""" tbl_stack,tbl_stack-str:group_header,FALSE,"string indicating the group column header used in `as_tibble()`, `as_flex_table()`, etc. where row headers are not supported; default is `""**Group**""`","""**Group Status**""" -as_gt,as_gt-lst:addl_cmds,FALSE,"named list of expressions of {gt} package commands inserted in the `as_gt()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_gt(x, return_calls = TRUE)` and check the names.",list(tab_spanner = rlang::expr(gt::tab_options(table.font.size = 'small'))) -as_flex_table,as_flex_table-lst:addl_cmds,FALSE,"named list of expressions of {flextable} package commands inserted in the `as_flex_table()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_flex_table(x, return_calls = TRUE)` and check the names.","list(autofit = list(rlang::expr(flextable::font(fontname = ""Bodoni 72"", part = ""all"")), rlang::expr(flextable::fontsize(size = 8, part = ""all""))))" -as_kable_extra,as_kable_extra-lst:addl_cmds,FALSE,"named list of expressions of {kableExtra} package commands inserted in the `as_kable_extra()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_kable_extra(x, return_calls = TRUE)` and check the names.", -as_hux_table,as_hux_table.gtsummary-lst:addl_cmds,FALSE,"named list of expressions of {huxtable} package commands inserted in the `as_hux_table()` call; do not include the `data=` argument; the list of expressions is inserted after the named call, e.g. if the named list element is `""tab_spanner""` the expressions will be inserted after expressions named `""tab_spanner""`; to see the names of the expressions run `as_hux_table(x, return_calls = TRUE)` and check the names.", -tbl_summary,tbl_summary-arg:label,TRUE,, -tbl_summary,tbl_summary-arg:statistic,TRUE,, tbl_summary,tbl_summary-arg:digits,TRUE,, -tbl_summary,tbl_summary-arg:type,TRUE,, -tbl_summary,tbl_summary-arg:value,TRUE,, +tbl_summary,tbl_summary-arg:label,TRUE,, tbl_summary,tbl_summary-arg:missing,TRUE,, tbl_summary,tbl_summary-arg:missing_text,TRUE,, tbl_summary,tbl_summary-arg:percent,TRUE,, tbl_summary,tbl_summary-arg:sort,TRUE,, -tbl_summary,tbl_summary-fn:percent_fun,FALSE,function to style percentages; default is `style_percent`,function(x) style_percent(x) +tbl_summary,tbl_summary-arg:statistic,TRUE,, +tbl_summary,tbl_summary-arg:type,TRUE,, +tbl_summary,tbl_summary-arg:value,TRUE,, tbl_summary,tbl_summary-fn:N_fun,FALSE,function to style integers. Currently questioning...THIS MAY BE REMOVED IN A FUTURE RELEASE. Use `style_number-arg:big.mark` and `style_number-arg:decimal.mark` instead.,"function(x) sprintf(""%.0f"", x)" -tbl_summary,tbl_summary-str:continuous_stat,FALSE,"glue string defining the default continuous summary statistics to display; default is `""{median} ({p25}, {p75})""`","""{mean} ({sd})""" +tbl_summary,tbl_summary-fn:percent_fun,FALSE,function to style percentages; default is `style_percent`,function(x) style_percent(x) tbl_summary,tbl_summary-str:categorical_stat,FALSE,"glue string defining the default categorical and dichotomous summary statistics to display; default is `""{n} ({p}%)""`","""{n} / {N} ({p}%)""" +tbl_summary,tbl_summary-str:continuous_stat,FALSE,"glue string defining the default continuous summary statistics to display; default is `""{median} ({p25}, {p75})""`","""{mean} ({sd})""" tbl_summary,tbl_summary-str:default_con_type,FALSE,"string indicating the default summary type for continuous variables; default is `""continuous""`; update to `""continuous2""` for multi-line summaries of continuous variables","""continuous2""" -tbl_svysummary,tbl_svysummary-arg:label,TRUE,, -tbl_svysummary,tbl_svysummary-arg:statistic,TRUE,, +tbl_survfit,tbl_survfit-arg:statistic,TRUE,, tbl_svysummary,tbl_svysummary-arg:digits,TRUE,, -tbl_svysummary,tbl_svysummary-arg:type,TRUE,, -tbl_svysummary,tbl_svysummary-arg:value,TRUE,, +tbl_svysummary,tbl_svysummary-arg:label,TRUE,, tbl_svysummary,tbl_svysummary-arg:missing,TRUE,, tbl_svysummary,tbl_svysummary-arg:missing_text,TRUE,, tbl_svysummary,tbl_svysummary-arg:percent,TRUE,, tbl_svysummary,tbl_svysummary-arg:sort,TRUE,, -add_p.tbl_summary,add_p.tbl_summary-arg:test,TRUE,, -add_p.tbl_summary,add_p.tbl_summary-arg:pvalue_fun,TRUE,, -add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous_by2,FALSE,default test for continuous variables with a 2-level by variable,"""t.test""" -add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous,FALSE,default test for continuous variables with a 3- or more level by variable,"""aov""" -add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""chisq.test""" -add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.low_count,FALSE,default test for categorical/dichotomous variables with minimum expected count <5,"""fisher.test""" -add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.group_by2,FALSE,default test for categorical/dichotomous grouped/correlated variables with a 2-level by variable,"""lme4""" -add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous.group_by2,FALSE,default test for continuous grouped/correlated variables with a 2-level by variable,"""lme4""" -add_p.tbl_svysummary,add_p.tbl_svysummary-arg:test,TRUE,, -add_p.tbl_svysummary,add_p.tbl_svysummary-arg:pvalue_fun,TRUE,, -add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.continuous,FALSE,default test for continuous variables,"""svy.wilcox.test""" -add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""svy.chisq.test""" -add_stat_label,add_stat_label-arg:location,TRUE,, -add_q,add_q-arg:method,TRUE,, -add_q,add_q-arg:pvalue_fun,TRUE,, -add_p.tbl_cross,add_p.tbl_cross-arg:test,TRUE,, -add_p.tbl_cross,add_p.tbl_cross-arg:pvalue_fun,TRUE,, -add_p.tbl_cross,add_p.tbl_cross-arg:source_note ,TRUE,, -tbl_survfit,tbl_survfit-arg:statistic,TRUE,, -tbl_regression,tbl_regression-arg:conf.level,TRUE,, -tbl_regression,tbl_regression-arg:estimate_fun ,TRUE,, -tbl_regression,tbl_regression-arg:pvalue_fun ,TRUE,, -tbl_regression,tbl_regression-arg:tidy_fun ,TRUE,, -tbl_regression,tbl_regression-lgl:add_ref_est,FALSE,logical indicating whether the reference estimate should be added to regression model tables with caetgorical covariates,TRUE -tbl_regression,tbl_regression-str:ref_row_text,FALSE,string indicating the text to print on reference rows (default is an em-dash),"""Reference""" -tbl_regression,tbl_regression-chr:tidy_columns,FALSE,"character vector of columns from `tidy_fun=` tibble to print. 'estimate' column will always be printed. Select among columns 'conf.low', 'conf.high', 'std.error', 'statistic', or 'p.value'.","c(""std.error"", ""p.value"")" -tbl_regression,tbl_regression-str:coef_header,FALSE,"string setting the default term for the beta coefficient column header; default is `""Beta""`","ifelse(exponentiate == TRUE, ""exp(coef)"", ""coef"")" -add_global_p,add_global_p-str:type,FALSE,set argument default for `add_global_p.tbl_regression(type=)` and `add_global_p.tbl_uvregression(type=)`,"""II""" -add_global_p,add_global_p-str:type,FALSE,"set argument default for `add_global_p.tbl_regression(type=)` and `add_global_p.tbl_uvregression(type=)`; default is `""III""`","""II""" -style_number,style_number-arg:big.mark,TRUE,, -style_number,style_number-arg:decimal.mark,TRUE,, +tbl_svysummary,tbl_svysummary-arg:statistic,TRUE,, +tbl_svysummary,tbl_svysummary-arg:type,TRUE,, +tbl_svysummary,tbl_svysummary-arg:value,TRUE,, From 4dec82ef29473d20201b22d510ef75f1a952affb Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Thu, 29 Oct 2020 00:30:28 -0400 Subject: [PATCH 08/17] more broom.helpers updates --- R/add_p.R | 5 +- R/inline_text.R | 12 ++-- R/select_helpers.R | 39 +++++++------ R/sysdata.rda | Bin 10373 -> 10328 bytes R/utils-tbl_regression.R | 78 +++++++++++--------------- data-raw/gtsummary_theme_elements.csv | 33 +++++------ man/select_helpers.Rd | 7 ++- 7 files changed, 84 insertions(+), 90 deletions(-) diff --git a/R/add_p.R b/R/add_p.R index a507c3bdc5..433673dad7 100644 --- a/R/add_p.R +++ b/R/add_p.R @@ -416,6 +416,9 @@ add_p.tbl_cross <- function(x, test = NULL, pvalue_fun = NULL, add_p.tbl_survfit <- function(x, test = "logrank", test.args = NULL, pvalue_fun = style_pvalue, include = everything(), quiet = NULL, ...) { + # quoting inputs ------------------------------------------------------------- + include <- rlang::enquo(include) + # setting defaults ----------------------------------------------------------- quiet <- quiet %||% get_theme_element("pkgwide-lgl:quiet") %||% FALSE @@ -430,7 +433,7 @@ add_p.tbl_survfit <- function(x, test = "logrank", test.args = NULL, getOption("gtsummary.pvalue_fun", default = style_pvalue) %>% gts_mapper("add_p(pvalue_fun=)") - include <- select(vctr_2_tibble(x$meta_data$variable), {{ include }}) %>% names() + include <- .select_to_varnames(select = !!include, var_info = x$meta_data) # if user passed a string of the test name, convert it to a tidy select list diff --git a/R/inline_text.R b/R/inline_text.R index 1a96f5b8c6..f3f7b167e2 100644 --- a/R/inline_text.R +++ b/R/inline_text.R @@ -515,6 +515,10 @@ inline_text.tbl_survfit <- function(x, time = NULL, prob = NULL, variable = NULL, level = NULL, pattern = x$inputs$statistic, estimate_fun = x$inputs$estimate_fun, pvalue_fun = NULL, ...) { + # quoting inputs ------------------------------------------------------------- + variable <- rlang::enquo(variable) + level <- rlang::enquo(level) + # setting defaults --------------------------------------------------------- pvalue_fun <- pvalue_fun %||% @@ -531,9 +535,9 @@ inline_text.tbl_survfit <- } # selecting variable ------------------------------------------------------- - variable <- dplyr::select(vctr_2_tibble(unique(x$meta_data$variable)), {{ variable }}) %>% names() + variable <- .select_to_varnames(select = !!variable, var_info = x$meta_data) if (length(variable) == 0) - variable <- dplyr::select(vctr_2_tibble(unique(x$meta_data$variable)), 1) %>% names() + variable <- .select_to_varnames(select = 1, var_info = x$meta_data) result <- dplyr::filter(x$meta_data, .data$variable == .env$variable) %>% @@ -541,9 +545,9 @@ inline_text.tbl_survfit <- purrr::flatten_dfc() # selecting level ---------------------------------------------------------- - level <- dplyr::select(vctr_2_tibble(unique(result$label)), {{ level }}) %>% names() + level <- .select_to_varnames(select = !!level, var_info = unique(result$label)) if (length(level) == 0) - level <- dplyr::select(vctr_2_tibble(unique(result$label)), 1) %>% names() + level <- .select_to_varnames(select = 1, var_info = unique(result$label)) result <- dplyr::filter(result, .data$label == .env$level) diff --git a/R/select_helpers.R b/R/select_helpers.R index e2267de098..9a9c9b3202 100644 --- a/R/select_helpers.R +++ b/R/select_helpers.R @@ -14,8 +14,9 @@ #' Default is `TRUE` #' @param continuous2 Logical indicating whether to include continuous2 variables. #' Default is `TRUE` -#' @param type type of contrast to select. Must be one or more of -#' `c("treatment", "sum", "poly", "helmert")`. Default is all. +#' @param contrasts_type type of contrast to select. When `NULL`, all variables with a +#' contrast will be selected. Default is `NULL`. Select among contrast types +#' `c("treatment", "sum", "poly", "helmert", "other")` #' @return A character vector of column names selected #' @examples #' select_ex1 <- @@ -64,7 +65,7 @@ all_categorical <- function(dichotomous = TRUE) { types <- switch(dichotomous, c("categorical", "dichotomous")) %||% "categorical" .generic_selector("variable", "var_type", - .data$var_type %in% types, + .data$var_type %in% .env$types, fun_name = "all_categorical") } @@ -86,18 +87,24 @@ all_intercepts <- function() { #' @rdname select_helpers #' @export -all_contrasts <- function(type = c("treatment", "sum", "poly", "helmert")) { - type <- match.arg(type, several.ok = TRUE) - contr.type <- - map_chr(type, - ~switch(.x, - "treatment" = "contr.treatment", - "sum" = "contr.sum", - "poly" = "contr.poly", - "helmert" = "contr.helmert") +all_contrasts <- function(contrasts_type = NULL) { + # if no types specified, select all contrasts + if (is.null(contrasts_type)) + return( + .generic_selector("variable", "contrasts_type", + !is.na(.data$contrasts_type), + fun_name = "all_contrasts") ) - - .generic_selector("variable", "contrasts", - .data$contrasts %in% contr.type, - fun_name = "all_contrasts") + # otherwise, select those specified in `contrasts_type=` + else { + contrasts_type <- + match.arg(contrasts_type, + c("treatment", "sum", "poly", "helmert", "other"), + several.ok = TRUE) + return( + .generic_selector("variable", "contrasts_type", + .data$contrasts_type %in% .env$contrasts_type, + fun_name = "all_contrasts") + ) + } } diff --git a/R/sysdata.rda b/R/sysdata.rda index 26b557a383137998b851413f8494cc9427f372dd..f4ba10e1a6ced929d4fa57a12ad65f624e563b0b 100644 GIT binary patch literal 10328 zcmV-eD5uv#T4*^jL0KkKSvZUX0{|NH|NsC0|NsC0|NsC0|NQ^||Nejf|NsC0|No2t zLI7XkfC1nx9(mS$^7G^GI5_z51^3+hlKW*XW$lVtr;giaZn#j;`?>7&JlUb<&0kn6 z=o&uzU8~zDQ?G2Ub-KyxLcOw2On}w5(Y;`OK38UGPM2XFU=qt*?eAYs=7ZmDG&3-x zeZ3M;Jy-xf2}D34G8r(KQyK<TILbG(AsIrfO;G85sZoGyni( zHi9$*AOO%FpfmvVk5Kgh0B8+QM9@NIAu}nX0qU6pMvR#>z!9L)rh`Dx8fkoVYBgr;X+EI*{pv3hW z15Z!@G(A8bpbtnMpfogkfE$C#r+5eX@ouU9qaX28+# zYA%ua6;S{zQmsojgo*AAPO=9 zFFT+vMTo=$I)Z3O=KbbeQU|gh=$HaUkifZ$olpsP0jn*z4aO_pIqLb@lE_znRi^E@PYv9`~)=x{7DT zk}-Y{WO1`z_NKZy>?^76PYYaoDeoPhelq43J*Sz6z&dZUfubS&A@-HGux zYea}$6jkgT^PbKAYwGATv74>w%BsVd(5lPrjhnpcW}Ou|e3tMww+me#8x+x7Hnq)) zxnb2cPg8F}E$)tr@{T%WN9kJk&tvs7Uac(a(VV}Cp%m*F}hi}}vb zSAy3fWKxVo8Ox0eZWKfq(=l{HSPiB@iIZOHb#`BELW;#wu5mAga3Sjjp_*0BZ4rb@ z6kcZ5SvHdvSF3?F0B>^htGiTrB z4G{p#Tsup(gr`(`aN(f!3T{{naZL4@A^olH<|xle>>4%J*pf_Fw(%As&VoK@{1ZlB z2x$pLQP@t`){O--Rbx@w_VU9ga=t3SnH9@z-Y=BtZnIq7a_$fd`!22>emZpIvNPaq zIL$k@Me6+6JLEq}&xMn&sTZk2%IZy3G*;twu6;ys(7IxHIPe5GY6zBCV_2Lm=ve(2 z+)CqXa#`U8H>O}BQ9yO*1XXD`u4`1{-O;GrhW>Me;Y3N!%CD)gCpba)K*PX7fe(#! zp|eEy)Qy*G*8KM~_ikpDARI76Pz&F9BGTJhASpNrqZv~Bpp9FqMuXgwxG{ixUlk1( zQG-w;WT$(A#!RS$N`zWjN+Om?FoPlQ(F7VY4JZS0j-ZSLD5M*+DO0XSFL|XRUvgal zM5svs6z0@a2nY+zKm=qUMG*k>{@&-$!>yNA;1cjiDBl$Y2ry7i!UCN$77!!>ApnZS zAS6-(h^&I5C<2gSA^^liWRO85VHgZlVxSQffWeGnqAZaZ$r45=ia{6%L>5Sc5rB$= zBCuk{D-}>;h%ir5l*YwT%so+b2i8lK)sK1qnEGE z{9nyuJCBZ@u&Oano|LrCy%p@iOZ#x{hMH}6B8*lFFc`&CK$~Y=-RF?lmVq&s)@nN= z({%QtP%?EM0_sdl;Z-*Iv(NatC0xaeqi-(%^lnaxj<}WKEzH*K@Ry#hUwec2r5Xh7kWrxQN-vf{9M;`LT51@bV!#t_?4kW5R`rh3nfDB9b)z|8v_WSh+s zc%y3+fvXTxz21h~WI#GNahz6lp|gs*-FJmLd)#G1ziDCx%X1WYX9VRUKKMdP!~zOf zI2KFq6VB1txEy+h@}Xg4RT4K#-THuW<1p2*d=o5p3__U8Jy_^-))x zx`DXbWj5MxR1nzMDApl*1Qjq+q3jd~nUcZ*UamsKA%dgT?`J!95FU46j29JGdWCLT zrP_$2pmQb^m1tDjOd;wqis_80Scz@i8UqOdQIuA}+?6Q96_)}JL`u~a2J2xt#v4QLaLZ^YFvc;x@kEMkmgt{bPcn4A z*;xZXSO$|wxNXymT!LT>E@k9o4tIZY+!V>&V1&Xs4Xs`t*jVS2?puRZ+;bW`>AK35t@hfc@L)Sa2h;3N!k0!Lm*v z@oMoU2NU1RdpzASczVWoqNt{UxFaNc8PmNi9zQSNJLvWvL9N9n9^x*_dlPIkghIb_ zy-w+KEpvr3$~nb^Wz+PUPi*X}XZ#JvD&4lVU-mN!02fe5QVn^+m8rZaf4aK&uu z&?si8yj59_w~GjW3B-)7avYi<4kFa?jxp&-vHH=}EFoTs)I~TvW8HEgl95_!)e6E0 zu`V3L#H|x@E6pl8>UK30E-Nn_%L<%35!UP>v1Kiro1&_*Z$OcCnaxmh(t~Dp=8P_k zDs`Lvx@+3pX#lgdpu&t)2IFX|7Cw789Rq2htt4vX(Gt3yY-hK1c5LWlX1GA-)|%t) z4W%MHd8(3>EDOc%E}jlvZqcgbIF`k_Bg*V-J%hw}kKKKZ1^D*D0g-s^8-N;);rMK0 zB{y!pX%kqjfAMu|{iz*HxAYEMFNZXAol$>!?u? z6ie&wMb9IS>&QN2D;P22{{VAUT}O;KS$`A{O;mI6>W3;QMJokc<>Jf`tqM>0`n4&T|s^wFKJ^+An8;iU=y0eXWKymeaK99a+kQ}2c zDjmr*?l^gTv8ftd2heIvIR*xe7kV%SEdquMkyzo=A!B_N7JW!n3I)n)8{1JX${^uX zHgQL1UFPD_C3raplBmd9wLmn0xPS$nr>dKE5Zwy!q{+0=b?=O!*w|<03{QbfsRR#93h0iK{ zo-NT;6U#pD+d=S=YYbQ&E_%X!RIruZo=h^bB8-qKW$nA>wOypKHCLBJMh0!!-CKKC zZX&hLGM#K=$?J!Ina;vT1b|HiJLxW1IdIYV%soNU=8YF_CtF_1Ey(bV7oP<5)UkaX zkNY1mWtgcu;}@X-KjPg*`5!)XvpmQ}xH>){PvO zBqyVR+4>_seHrMjjONkR2Rj<@PSxm6)eguN3pSv(*#h+O^B!OeZEuX8QpOn0(Jd+m(z$F($qpGbR+Df^@PCXha9yw4V~nVc=#vJ2MxYphB9YuHadVmi^j(^_neH7+;5wI zDG=6sgI>c}FN#?7(Rv<@s2zjAP&$$4O@EXu1pC07%9A>b4ymsXd&3?GCZ8)9lu)zFpmG5U-2rmNggYk(mhLTGv zpxT6Q1kjiv>$T|pO9(WWJ3{vT|F!MoufG<} zFc1qsTB#OCG|h$>J^HCm3B;>V(hNY*l7V6}w4@?TT3tn{n(p>T5dx$|F|m$l6p-IH zZ0iTFP{OGsA1S5yss2VrNo5xTA&GXH1TbXMjs>|W0nFB~u6-U)pZ0!@v0=-(* z$vGj3XgHWzCgoF%&A4>A_AO^Z=Dh*o+p1ylax5hvMRJ3k88Vy@VBsWHp=T5^XUWxF zX;*=z36R4>QuC<2%;_xy8mek(228C8bt?r$3Bv+q##vF)fO=tdv$YH?6Oj{40&>ci zToZ?V(5-yrnRO(rE16~m`A|55)RqIn3+F004E0G!vTQQJDQ-i&WTxeyR|?IA!jp+& z3J{tV)F|^yQTNweR2Dd@pmxNR2BO}@Xn=_e$i-|jOc)Yy4(1dFVuEKH)P>P74qf+= z$ei{B+P5t$3zpVmky!{$f_Lb!OZ5Gy$65|M!2ZezTedKI3WJ%@IFSwQfM!xQ%L)>f zq%A|Kn$jqod8Sd>$$Cb{H7FJZiHL7yQq~$9=+iE7I1QZfBom0B5-JX0Pcp*!2}v&4Nd$OM@7xOkC!khFt)v)jjS0gSLqDv*QtImg2;ifR;M+3J#3Rgf2T!@0>K>Pd9aEMs z285PicG?>g8XH)$MS{sVWlD(#6mU0p3xS-6S(?x_XUKGiGg)lXngw^5OJs#~C=!8s z!{GcLw)G%I;;?THPPzvpAT?%=9Y{v-XzqT?D8NjynJI)KU(T4Vw*}0x|R-F zB70A#(qn|Xw^?9_i7n?w-hmPciTykcekShewBkUYEr^rnAcnF4LP3g0U=W(pl_OL_ zI@QCRp+F@vItG=+69`9{y&`zP75f!byhA$>knmu*>NZ?^+%xfGy@wZ=yte3>`bFG3 z>sODldM(aLRp%H~fPiuk15oHhb+8NI&Q3vlRI^oWgy!ia6EqKio7!=TeP_ev#68k2W+*!g9wDVIdfWOr+>=S8AP62LDK!wdgdYSSA)ZMtlg_|wBok-3)qvzuSqLGAUP2TI z5rPa5H?#}{po2KfAvAC{ra(@JhAJ3(wGWsrj*3OaO{V79!Iz*VRB&lP!LkP3iLWyR z-JEnKLjvH#b+0xjwIUe1a^uU-fdnA&8Lr`W(+EY8B4qsTpsEysU&pe?vX>=soJa?n zE;R{$PA=Ngk-)5X+R025(S-$?1g$4CdV8~i6F8868R2uopoJgHX(Uzz-Hj# zkc+{8d$;Gy@pV*YctDI%-yjr94n!sZpkfL!2y><&Pp)jw1XF)gy$TT^N&$rdWNn4E zqDiqSxByXzAJt;AKslkH?U731Vi(ExVRnfZfl~=fwK8EOGIHZ6$J*|OuzLZCAy8L~ zK*~Iv_>J z7zU!CW*vShm^xetO;RizN({ao>WURry9`3x`nDzPz}6EN1YFQSVQL2TLjv$p3TSo^I;8GDh=g?3G-*TrhdVs6PSW#q6yooVmPW5ekP<6OLW|CVKfe?Vi&e> z1fhUw6|~($TIGVw1VE=dD0Lx%R0|Vg0~XQyA%thB3pqdw&>#V~lK6dQzX!3_+$QkY zUO7SoWT69PTDvNp#auP>a2@D<05O^#aI#*Ch+d{!s6hp%2YV`S>?Rh1MJOM-* z1rSCcFc=y_jcr0~iLML{o*ZMEkZhDHOc4rf!P1|%`qRVP#TIYi5k8vytrmUOi0D2w zWRcltPh@+KchTxZmmu1AnPaz+i+hdUj7hu5L_lJ!0i+UC?tnn&NXsSK0hJOJ9F|_vnS&V6PivEtxaUDefRW+Tb$Lld zHj+GSYzzd<63#;dz(@i>Nq|)g0A#8)@!$olxI=MTft3pY(!DEHO?R#inUkX05UlR& zVhhGDBk=XMjDHVl3^6gx5N8ko&~?m|I|WLFbfIi{@+`Kdd45Tq1^bF)Oj+KLLeIi~{|K(To;vcd}#0-+>Qt|m?* zcr9vShI;I$bCj__G|1jw&{B1S1lLpqdL8|^d1)yI22B$V9CFAO&TqRtS8ISiM2W7_ zHzZ~=v5|a%C7pO*iFhwUa^}O6cCJpNT0>$m{NJaEW^<-)*Vj#_BryPBMPLyakPQiu ztm75hDjJ=uWDdT};0s)#3jjUPZLnw|B+zH+>d+OCvBT0_I;FeixC5_H9#j)RAX? zlY#1C|F@iuyvA~9J9hUd=t;DfP5P8WDEDrKL3!Ec2NAW3P6JV! z$+n)MKDOHNw$VX$DyWeWDr4@=(sU-CzzJiA>zAC*Lz2wjuZSW90A1*5bZe`+SPWyV z5s=J|v61@`^$-?UU7Is~8fvhh;&0CN!U?%0xJg3V6j;QLqN}W$C9S}K&tST0PudnrU8*+nfU=_D$K2(h~3X& zUshvUdo7S2Qeacd$|@6wNJJ(!h0F>dw0g)h<2~u0ESLd61Mk`msM;&UKmu3`&q&BP z5P6JC^;Q)(jfs-A8$x7n8251*T}L%22MItZqG;h60X%?v*{JPa;V@DX@hj@Vim;(<1RJGzqS0bnTr)b9U6 zAC-Ze*j6hW;Er2rwG5a82!mG9gcq#uMpOBwSfSbz7)W*s}IPzUB!|2fk+H#;6aAt3~+(zgO7YG8@A#7OR-Q~Gf>uuDTXOSQ)f z;WF>o9*yS;mm&8*I49PF5kf|&j|xYFjVXs(d~!;m6ktWeLJ$lf(EuG56@57EoiAge z{Ue_wDUc3IUS^^c4EN&7f>dAS&){1%<9Xc`G0Yrux5z^nM8&uZ3f|R5pwtiVKpjnx zi6%Xg39u$->Y8@EU>Y8>L06wz-#Q~u)P69gi!)H z_U zQq&?V5+Wr~0YFx?7g++kKq`xx3kWUZzB_0d^vbYebz})~etpQl@IegdL=I(0A_D+m zgQ!>vp>q{fBmfYAML=Ew6h$*CYJvtzxpP@oUMK=wmMS50mKP&Y!WRJuq!$L*w+U1d zs>hF{4-wIpvnMwdZbIpq4g!**p+QEz8>QkUD0g>h9jKXb4I5oc)at;;bWu2fF-07a zA|ivW3&m4d3C}t-bmrta$nuM1iVm?L3gj6XE=B#;VZIth;1dBGR8ImnBy-pRv9{~J z`5lUQM?we`BYCp~Ac0H-r+Y{jtV-Uq_O~_%UDCrC!Lj0K3oNVv78Kp&PFFu`Ta5Jo77xu9nY5Rfe-A$(pfTsN4|ebR7vw#iu_gi}ViSb+-w3Yp0c0NAUr z@NXf;-7(*?4060^DwIWNhV=oUZ|N}aVjD$d2rMCZ5OSd6UHW5KK*Ue~mos)H#gsKf zMZE>X4kr%V`Li?^6mcx_cy|sSqni{!l#5by1AC1X;=#Ys)Dt(!vOJISsFF-t@IUaI zb1w|4pA&SUQ(=z2%ILkOX! z1d;_Vy>!ibwF4m;>Rs7nHNe#$;J%O@C)2gbHv1AWf~nurk~|3bAaoL`5_ zS9$stu>SwQ?)q09Sx3rz*2i_j%=k~aP2te&;nkr?NsU$l9NphEG*QRynRy@6oM^ZB z8<5BYt!^=c9+3Lo1@4}c4ah0TB6VhV7~Y~V>5hj*!2zj&&r=1AxXbV8oyyjn(`;af;RTYd0^?`rsaW zNKC-^pzohuXQF1jpe4XJwaAI1n9|uXx{$Hdi8M`*wEVeft`Utc51hA6stkd;AyuNn z2>^AO`%uyN3z6OMZM&BKgmE1sKDs!~y6LpkkZL!gH+|^^4H8$NYb{2Y7ObY=!f@FD zv1}AoRTOH2>-PK7+r^JPPG5B0|6kM?ZiQ%m0ZPL~{PX z9E-)0V#LQDm#Gs&OFrolHT3y4O5JdscA#7s3suS^0xMZj`U~^}>e8R0`xZo82%((} zga{8~G9Tl;?_G(kz(B3&2ZfQkQ8yI+KAVmCWNV=#1F~de}5k@8rl4kn?9EIJ(8{*X>k3YY!8{kJRkm2LgDf zt2swAkXn%CRV+~fCxI;sRaS!cl?-b86k{%~JeOP&kUMQoTs%f55a#m_jd%v^&orx? zN0BLT1!6#04+aZ;uz>`-0xktRvBQCM0V5m}mkj|SP)h@@ECA9HYy$gN5va-Iswhn# z5gCT#EW{Ni%zvOjytxJ>v9}#IvlIB6;DC(Ap$#&S(R5a$wMAo+qh$0ZTqG@FuN64Q z-U;)m#lj16Z7FpRZHPC@17KBLF#=lTE1;T~TL`7f zKB?-)a1AA8;wfXpLIa7jLV@@Y4*Rw$@+`KRj3~^FT;p1X6-$uBxSm5Ds#qDZ(`v#L zvJgvgV1t-8l3*IAF@a=EC}y_ejX@@v$!ViBLq{37DyASp0i`DP%sNA(1bMS49K%c# znZ*vJI>WE0blDWm!L(4uEMf)Nk_pJTi!LoHp>hG4@w{B-a+p?VgEWwOiF*FRjP4Im z9vz#HTj73DQo(T(VQ?b0f{DnG7(P2u27{?tZtM}l!OpJ9hRrV{$NBF25wm3PYgDsB zDBZ?haM!wF`rl@Z@%X4Rl1iIckj&6Pmvv%9+p&e3aAjL~;VZ9fkaxl3QuajDx zQRBkdlN<$b0ui_{LB?I!+2bX_8#1Fo+V!+SsM&ezI=#Dj(JY0E!ReJ`gI<}YSeB}Y z44Nvci@=);xXXbzEaq$azMnUx-Xh-Ouq2>R&NkC+(&h*n+}b(k8ujo8`}d&F1`gez zbe&S}>D+llB);oZ@fdGBO{z7k$>zCiLq%+Y!uZV*a?yAvI+zT_ zg8d}Q0KQ=6b4D+|Eyx0x`xdQz}e9X8XOMAU&TCbFm2f_IfEb z;fLpCD`Jn6=vf7iO8*I94*S&+s`NxkWW5v|C|#imIXEaD-iEpA!Vpx(s3d#L(5@ek zU4+_D==@4Yir7l|2^>j_S$@VxqPP5P5N3)W6bp^M+en$WO&Bm5E@Mn=w6EW+h}S*q zMIO~ek&^ucSL1Fu3~9W0Xc?bOIaVi%(JCZb-T5OE0>!r2o6;fFuNoyA5N@KcF|MNm z?RlKCMrQ(}g+Wb2I+OhL=HTr&Zz5(X&Ivoc!Q5knp6N;HyKwy0iiYmISML|^%P$1#B zmGyBlHkYmN8Z)0OJvuoqJE4^{4CrksKHANk4p5SJcsRp3jM}cE;X%v8j?mlFarGz( zf-#n6%5ny(1xOGjr9d}G5W^>;!^d8-+AlFhQ+ZB(T1IM#g_ogkMw|SvQOVD-eJK#o z0m8wq@nyjH6)0ICZz7F*G-NVaVCC@~3PW%Ov;!GIQB_4zR9$8hw^Gtf%j^SpqlF^s z>6c2$9v7}TGQ6xJexZ6kh0M*5(_P)f=WvahnGZ#$TKe=%K{5-Z2DK1U0Cfu&U3+!W0YHAB literal 10373 zcmV;0D0qj*T~Gtib2U?GoQAPr4Gr#VbB5T_b0`8pDZ0aws*)Ki zGRf@79kN!<0M)Qw$3T!l)Q?V;b%2euz1^3)yia26H)QMpWkjh!fm9qN5dcKVHcc{U zGzOYAJrgP9$$?F&wK8m}(`6owPY?va6HO0ON2%&)^*ts{G;Kpb z41u83$OO@((8;J8YEKl?)Bpyah-vCPD0-Rz0009(1JnQj00HVUG|)XjG&RfdK%G0U0zjBM8uG zPfV%#PfR9;rYZWSo}*%(lhoRS5vQmC^*u&_G|&$y&>o-wG-zZGP|yHtjSo%#ltd^i ztt~a?4J3|-R-=?^BY}mBSW0BZRZ`-`0RrM6uS>+?@cqYSaNz<6IDvvlSEi^*_C^Je zf%63AqQcpA)-i~e#Wf#n3IWB58BPWZF^)4oo}_(w_$YE zS?mi}Rh4Yu&<3U&lXbQGi*BZUyw|-X)XwKN-Sb@eY|RZRJ-P{0abx?Kl6OO8>@gY+ zWRNfabWfwAf=M092%zn)pYj@SxRd4bSg19C2_h;mf`D)H1r#DMK-5rTDZ2Q1wrUei zCvak-U=RzKsosD~z6>n9_G74+iU95sM1kqwASxDnV#5IIX3b;hpnn9xpXl3DorBQDgOxzl6$e8e9 zjH4*l$*e`wUf9A}AV}di|3r#burM5{WXgou<<3bv!%Oij^hR zTr;pn`%8k1I_YA$>1#?4c`(}B#i&PyA0tgaOXejp(|LO_iZZlP`2@Rl!o#*VoJ@@) z&X9VSQrii)|BV8TQ#kdOhrs8qC8!q z*h{MlIPG_Y;#j9aYo`_c3e7jMAtUBAk=ym-*!MkRNgzJ?`8ayr=VP`qu%VdC`>Kd6 zOQS&MZpR-sNHTv|aeE@x3B@+exlk5CR{6F8u6RAzAZG+%k{0o`+ByJ)teD`M@F}8{ z>*^(m1B#pU>#`F3Gda&Vu7!bPv&ml_ZmOv#i!=-5iDaJZluDL_`D&i=yHe`y*~59@zobWTf?3{fu)7^p&U<%hFVb=LZ`n#Ss{>diiO@?=x&%2J&r5ot-&fs%F5;ng^_7oMs5(+p(RYD9@6X(ET%7_SpfdoKgjDiUifTAlPsEPoj z7)XFI5m_VP<&R2db67BN_=gA_r6 zus~5FL>MXq7>WoaMl4n&Mhc3=K@njTR1zwHu|)w8V4@LGQCP(yASiKeg1Q8;j zil~ef77G*@r~-=t5Mdz2P+smMvj>7f6zMw}ASs-3$p`>K_5KciUdK1_e|E-qpA|g9 zsKq|TDQTUWE7^lQ>yYe*@iR097_1avF^Z<(onfMG_T)9?h)rcX1s1%1PXiMMm!;z< z5}jdj{0r*)@FjewMAnv8uxZ zx>3NO#Glww3W7|7L&ng<1SL6?qC?-WL7lHA?PuTEv6+( z#7kz-(hMX8Mp0V_a#W-a2ngYj7tYhx1`5qGWsh^R8&N73qclLT7NP?27{}*lbHApO z5LprO>4q0mjGn0w^aBPM#y7q3BAX?)C&8zhbiT$`K+qNeq|z=Mbl<8$Fa{Sg@-hae zZQD{5rwI@cKqP=X+wTETYew_~gqG^4%Ful<%Q{g~`>%ItGr*A8)MAU}DP3!{VJB@^ zkW)rPu~<{LD$vMmd`gN6PqFY}h*0Hmd=~@yJ262r;HI(UGj&ZGW>_c@aYB8h6T`i- z`ICKR+%mzU8j4PP{;j4HtALACvtU3M0el)lsX#>a3#dARIznieR5*fEwJULVCHYLw zQm9-QaCKKrUU|X`20#%Z5UC6FoVS)n_;DmKN;CYafZ0Z|`?$K&!&~-bJ)U>WU0p*w zQB+ev+!3UQ$u8fvC67?Gw=?@8V*Vf)vv0AeQIv zI;QmiL!lIPDXx3#H;gS`K= zyWO5fPGeQbaH$svk1Mg@+q_7K`0w!`z#g}NWL^_S)lMI!g}#6l2bNxRYcfkmo3hWF z%w9%d@3RClZ7`KYod8clp6aTbYZERaSb;h7!}3`xVM_M4Qx$L_|?9@A+4Ju1mE=k5R-C zQ_t{|`c8_clK8&Q#}G@{9iV}Yo*KHoZn-!kg?a)-z|eShBYcP|C@x87cL zkjuzrYY90;%xtOP7?G(_}F0+I2Vnce(vqj-;Kb&l{ZH4g{ zf!+UV`X`>h1{V>GRHV*sX3=fYv4=|x4o;z? zKB(>`t)=>q(FG%zuP8ivFB?s3muW3G)h8oCMNEAIo=#B7#qN-v+F{N6qq7YP{PzpvWPV$P^R^Avf4OC5+!&! z2b!qJS~Ng30mjl5mp%nvr#Vxg9f1xWS};z~^0Tnhe|`D)-tPy4z~IJ(=&`RGJ*Ma4 z^c`^AxqG~Fn!>zbxQtyGolkeiazv!_e*a(a`eN)G1);85%Cug#MG83dJ?8d0KBnrG zwo?q(t>2gDrTwK+v%JlU4ZY9wBSx7VzW z2>_Z3cXFJra^<7(u=dAGx-?z6vZZ}2xFkX}UmgkR!moWDk@}xDa||@KAK7HsVqQ%# zJ%rJqkWr6iD%uoB?2>s8LB}+$bSi!N34iOZJd<;qIC>imenC7z(vbRaG@b z6nN`e-*?CCI!zm7k4y#k_sSr1o-Vj}a7&7sJh;`jSuUgthd$%qoO|=xT?N6n$z(2V zCT4D&Noa;rm1tc$iAilqtW?D9HyTdg8jaJ)mAA~NUoEnQetm$?gtY?u1^Y*tfDB?8 zxlJ1GOl=aXqyDWB2Bh_)zqxIp1jx&(%&PcEQB|b%3C5n8#0_0wP}bJtwF89SUbxVS z1x>=C1zi#f1^C@Cm=!5xgYoE*fW|Q~fSGw>E>)mdUcr)F0MyHnqa@BzOsHHNSd|G0 z*1+rN_tkw$ww+d35cbZAnbsV~#G0z=vIyz`&2x6vgb|(}H?(3C|a5#PjICr{j z*~>&Y?@T6Y?@T zf>XX&qtvGPj0IC}0W#0Q^xqz7SymjI|FE01r?>EvDfb zb}N=OkZ)nVo|;GSD3QNGxGPoclTb8%8RkK~*-6{+tIUiMF>7iucJFhZTUgf6s|T-V zQ(J4eXnG_cu#q1h)cKdNN zn_LwZ>2&m{Zc|}-zzVDiq~|%<5xc*CRsqO!fn_}%X(iP;Wgi>s4}N3%YiMY%Prc}U zff_+VM**N-8U;6tj6q_hJfp-C5XI; z5Pd>SVW{Sq8QBKmBZLz`G=c291byoWHB23$d;hThx4(~@UX*tBPz`MlL{cOpSdRD) zk|0tBCFHU<1{-jB@MpKv{2_WF^FANbRc6G3X+1_V%beb9m0emwUv+`+38kFtsY2l8 zg{a*(H17&51OlK@RaGL$<1xbw9)77#DaNZ%(hNY(FrZcuy{w5GrK-|g+K$lGz=C4{ zS5Uh46p-I1QQZ$hp@mWsKAL}D6BMzF0wIZZnglRp(%>zlihvyrX!d7Y%yRoKvu_~c zaP|hhj1fhGY!cRx*j6xTQbRfkt|v2@LDSmxvH`k*(N?iREhNm?x4)^Rw;-xWC>KLE zO%hEEB*oU)RqInFLRX~26`lo@GE8&r#25%UAwXhP*$jr;aKRHW zbeG%}$emgQ*<++hSX{QVL?&xM1qeG@rU`$a+KhD|;=B*Kf)?Fu9+87`q2IVWeSk7% z^t9o#68q|n2==ddT$hgp!FOZJFf}yT(v%Ao%DCD_4{qIGjv)Ly&C8&I1-Xh$8Ok|9 z(Jq!6>0U{exnX>Q;$j=uQECk);*4d^CjqaTB!Xl`0Fh905jBxveB`7q*hvL>&_%)y zFe(PMDD`TC)iSloWAn7UHiE=S=?civvKz-_Y9|a_?Eb3~lMwp&0EBR;;#Gl!Sq#g^9Fa^O$N%o))~g1tda~WVN-1 zs72O;%4}aIe3V8y$eH0ee1ge0SguO|>qkKyG4K~9lF}ViI#7&^X2_89KlhMo{TB%{Is2Oo3FxR1L(ha4r zjS37TihT*>F-FYx$+jyUe5|2R+c0nqze8mc0Gi+>x|++JkfFjGxN3U4AF9w(OlV;7NVMp6roU{p`jFFwIx*~DS@_2 z1!NdNpb!bADTG2}F;vsgJCZgjQ(h*V^^8j|14}uRAsMe^HBbU#2?D8oK~V%FjatOS zHYC^#Rc!F}trS7Vf~3WG88|oOBH&-$e@`il#^@1xH4q9V2JlP)f#?i`U+nQ9-|-&7 z_yjtBKbi1xO+++-Lyji0>g$E$S+W(_RjUv`vc+V8ZxX4lMRE?HxobESc@m~jFEOmU zQzjBaCm=Y=G4{LRs2;FrNK{JkX$+AjVCfi*cQK#_1ge7cih~EOR7H6(kcC2_GzJQz z1cPu_CG@!(5eS4r<=gJ$Qm7Gf1_7C1E*_4e!QY|)%?+8^SdV^g2o$N_DJ9Nz%(5s8u>s7C(=*{lx@q5lE^yjyIMc`-H&JqwA z76Uu!B5eBhF1nRF{Yqe_xki$ZOVpx4Eq%raRbAe_x(nArnQX=dK;aC!NFfCznMOVw z^1zs@P)&^{Hf8sSN<{<|MybIjkI@(_!67;$c0efr)m5=Bp{nJA%miQ*w%~YTTlzcKm##e-vd=k;^^VpCg-rclR#^fAabW^(uGP2zGGF9qp*cjguilBOicsJ za#AFdkQ^p}_QQvnnX!qDi!(S;0T;|>v0ch(5%Pq=Qtjx4Vlt5+E(0)KwY9b}jiqCw z3%9Vm(8k>11enmc`FQLLaLi9{nm)|WYuZ;4Apvid-XjNku(u%iVI*(?ST8H=h_G2Y zEMRnS9j;)@CMs;NtL=Kfnb`Kf3rVhRfI%XX2qO>}3=OhMHEAZq)(j1t)JF2bvQVio zL@BceN`5!(r-#9aS-(Vy_N(h@S@;?wuzR(VM^igpL)v^kk9iVYV`<)Hj?OkM&Nlin zCioDTfQqmNkV#Xw0RzrR%O%Or4ofd-Ou>l2zROjdj_m^m0b`xjzr)0$TB%7R&(NyiCR8QPBLmFHsK7~pSqp$M z1WkM}0@Pe36{s0dunjBHwN%%iaCFR_6AggXp9Ux~Nv}j(&z-5XYs=?Ap@t?of(f~9p9H5xUuR^Gh5Dg>`mY*)^roxQ8d=I6Q-`bZofQHi$n+!P<%nxH)G789=dlGO}nYObP^rIyjgUh@I&ki80Sq zq?C(ft3w?Y#EF^B%1e8}vVYBh*`5ZHYm4DyWeWDm~UP z1eiy~L_}$C<1dcRPRQ^1{+k-Ih*>6$|R^f*^VNx zFF~ex$|0M(J^gt7-4*y9g$_9}0*E@gG_{o24rgy{3&dOUSd(Xl=%&$dF?_}%o~mdPPdMn)q+%QlyFqLZU+ZRS9} zCPSI^$p>yoQv?-ZU4lSGds4@rRFzOQAczDX0VQL)BOSmT3`FlNgd7OiIjC{#ixseE zPIxvc9diCoI&;jMvroi2W5Vm$K-5uDf~5t3LGnDWAO0awD?u)Af&qFV;5~$YKZH~V zzRBb&`Ufa0lre(6|KYb*UrI_Lbw;Hy0MP(EnB~C+Kra}91%O}<1VSMp+~wk-;u>)r z#8XpHGM}L0p@-`Us~V8|gC_S1Yzz}ZpiO`s#YuDkuoQq9zi)>F!iZ!wq>8b=2;;^o z*fC%c7!vaaB1z_V4DWLc`9S^iK*~Ax z5U39l&x@#@*7a*Td4fW!t2Ot*d z-GHi0Kp@bXDNbQd4${~+7TT)b5k>@DGa&%N4Nw8iaI4mj7;w9+*XJEfP_7_2sd<*D zR57i|%n>m!_jTB%^%YP26E3_wNBr;*T*ix)0Jv86$~FeTe~N(UZbBrR45_zTeSo6y0^Ug7#R@zTo+7oMT|I7|k=FD+&03M3+k5zVt{!f>t;t(5?V zQ4Ld?4;!2BOI*4Q#xI@HT!C<$o}YU=NPfZ*;0PJ6^~-pXhlKPP5WzM|1~IlIL`t9n zfUX24jj@kyjGOQS#Spp!gJ6d1+5Fo_^KyK86ATS09It75L6k@7` zfC3N*s0*q^5lpI@Ac2amJKSwA6agrg77(M36h^~@CTWMOJMKg}HOm$4!-3!p@z{#*En_w|T98n@7gQW|_Q%DKF zb7toacycl53$aB9NRS0_3`|!N|Mz&R%*6mA!WAYX#Eoej)&MMQy6?V6MLc7n1PT$j z*Mbm0rUFyFqzl$1Z&~|WTLZA^VT@qd@icOxl`Tv2&>G?FICM*=~8=7okJUEn~q9cTJ6h>J9~g9qnSNK#`Zf%FMy5nmV#AR{J_ z?07ZA#D@*q5Z%sdRw#@_L{UhQBnB`R3>gcv$|9jr1j=i3@!?z#gd!^dM2$fJfCMZr zh9F=EgTgobgHsp|(X7rtE&mOu#a%?=>Hx4suONN8jDf8j9B(XF2CO>ZN?8!GtJ$H$ z0QRi_+YXiA^hkQ2CUArxbpg&q#&9e^fMCEEK-(aYG>7&2jTHoHWkPZufAeR_ncFzQ z3}0=9!*x`A(stT4Q1U-lDtE+*!l&dOruV zbL&e#f%8&3E*@9Nc{Z;OhhGNjg`l`3;1TvdZ`cooPTkn=W%l1~rC(AIU;*`17cn*I zADQ5)&(gNmBzXppo?@Ym=pzo8=X6{s4Gac=Xcv&&X)0|JBv~mMgJpw4Ca+`%4gxk1 zeHkuU;HyGC){(T%h<2(eUJM}e-FRu{9i{;#X^*tF$JDwkWwANOtJ>Q zM1@~aV>z-$mV|0NFtQLSnN8Wh)xgf<1)x$AUpftHYC1S~+E=&j05}mw7#}1Z^Xx42 zrfSLpTp_uxG))|)n`Fl7LdQZR(KbG(?`5T2BN|*Et6OH(20+~qs?lKtfH)cYz|#Ch z$nbc!UCDnsH=QFtZjK{ns%$hQ8V!V|zl%_~)mJJJ&7jmmw94`%M|%_smAOS#QAVgf z*J-+NHI7}PbiI{#URR?yJYdEhsFn?hnTR@%U$gCZXRM#Sa`1C$zVD%4K0phw~iMdzMm8^-F}XwE`VFK5FjDF+X5KG$!>VaU8$CM-;G z>3R_~G_&v#6JL?XqE_q#>#+jiU@aFYj0mk|N9V7}4$kYliM_!okP_oP#$gMKP|Th; zllg0~Z5l){vH^t&Zbp{Me?4puh7!s$5+dM`N3|8fB0_Q=@g3=Rfk8}nI!QozVIOh+ zxBJ-3^BOFKd7${-2QwfI-mZu?xv;zvClCVs0wZzHB?GDHHqg6F@mLwQl)!ol8+QZ< zaeHqgbJk z%2=WTPKdNERawj4R5Mle(VAUc-2m|F{ndKq%>U>sO?c$ zyFv>Hh7_SLXTpwK6jOu{$|x?*Ew5oqsC(=|x=3UUf&t%lwO%!r!$E}^k)xPvK*FhUn3ogCW3@{IHM(qALY6`aZ7dLS zhQdq(MCLFoiG>W-%u%2u(>U!kW{7CwHicBg3=kNxaLJ>*bpsydAwbR}K}_qQ$y2;E zSeMzX*LmJ^+h)G_SE{J1nuSSY;(S5>%$C97qP!iwAu8~E^I6K$22K@KMbn)N zxQkYHLC@&@-)qF{ezGnG8v;@V46{0Q!d<}wTa!mT*uH!L{kza-g9mR=DHpA&Dw@b+ z5fiwm?g6ai6CR6#(4j^b%*VPfWA zH*(RP33=(&#&O*YdBA1EV`%$oHpm>IDD3fZ26Ne(yfv){h2+XX?)E2Uatp*nZ9Lpa zK9Ua2$Tu#?A1wv<>HL^EtLv?b^VC&0_OtG-43!eLMuo*2SNVS1mQS&LnJ~}+!nv;N z%(}pKc{U*U@W;Qri}c2c`NlwVlJJj&4@rYfv8bvq8HJa9F(pmEs%Y-3NxZye;<8Tj z@D5GVmsp>}FNe^(o3#3iqjO~KV<}8mqTbZMz7q&cQt<(;N(_@oYBBE@N}dwm5g}O) zT`Ox23$nI!ZI*3_(O`I13|AXV2JjA^qIrG3-% - tibble::as_tibble(.name_repair = "minimal") - - names(df) <- x - df[0, , drop = FALSE] -} - # prepares the tidy object to be printed with broom.helpers tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label, show_single_row, include) { - df_tidy <- - broom.helpers::tidy_plus_plus( - model = x, - tidy_fun = tidy_fun, - exponentiate = exponentiate, - variable_labels = {{ label }}, - show_single_row = {{ show_single_row }}, - intercept = intercept, - include = {{ include }}, - conf.level = conf.level, + # quoting inputs + label <- rlang::enquo(label) + show_single_row <- rlang::enquo(show_single_row) + include <- rlang::enquo(include) + + # getting the default `tidy_plus_plus()` args + tidy_plus_plus_args <- + get_theme_element("tbl_regression-lst:tidy_plus_plus", default = list()) %>% + c(list( conf.int = TRUE, - add_header_rows = - get_theme_element("tbl_regression-lgl:add_header_rows", default = TRUE), - interaction_sep = - get_theme_element("tbl_regression-str:interaction_sep", default = " * "), - categorical_terms_pattern = - get_theme_element("tbl_regression-str:categorical_terms_pattern", default = "{level}"), - add_reference_rows = - get_theme_element("tbl_regression-lgl:add_reference_rows", default = TRUE), - no_reference_row = - get_theme_element("tbl_regression:no_reference_row", default = NULL), - add_estimate_to_reference_rows = - get_theme_element("tbl_regression-lgl:add_estimate_to_reference_rows", default = FALSE), - add_header_rows = - get_theme_element("tbl_regression-lgl:add_header_rows", default = FALSE), - strict = TRUE - ) + add_header_rows = TRUE, + add_estimate_to_reference_rows = FALSE + )) - # add reference row value, requested ----------------------------------------- - if (get_theme_element("tbl_regression-lgl:add_ref_est", default = FALSE)) { - df_tidy <- - broom.helpers::tidy_add_estimate_to_reference_rows(df_tidy, exponentiate = exponentiate) - } + # keeping the first arg listed if duplicated (first is the user-specified one) + tidy_plus_plus_args <- + tidy_plus_plus_args[names(tidy_plus_plus_args) %>% {!duplicated(.)}] + + # tidying up the tidy data frame with `broom.helpers::tidy_plus_plus()` + df_tidy <- + rlang::expr( + broom.helpers::tidy_plus_plus( + model = !!x, + tidy_fun = !!tidy_fun, + exponentiate = !!exponentiate, + variable_labels = !!label, + show_single_row = !!show_single_row, + intercept = !!intercept, + include = !!include, + conf.level = !!conf.level, + strict = TRUE, + !!!tidy_plus_plus_args + ) + ) %>% rlang::eval_tidy() # final tidying before returning --------------------------------------------- df_tidy %>% diff --git a/data-raw/gtsummary_theme_elements.csv b/data-raw/gtsummary_theme_elements.csv index a2a2169e84..924bafc645 100644 --- a/data-raw/gtsummary_theme_elements.csv +++ b/data-raw/gtsummary_theme_elements.csv @@ -4,18 +4,18 @@ add_global_p,add_global_p-str:type,FALSE,"set argument default for `add_global_p add_p.tbl_cross,add_p.tbl_cross-arg:pvalue_fun,TRUE,, add_p.tbl_cross,add_p.tbl_cross-arg:source_note ,TRUE,, add_p.tbl_cross,add_p.tbl_cross-arg:test,TRUE,, -add_p.tbl_summary,add_p.tbl_summary-arg:pvalue_fun,TRUE,, -add_p.tbl_summary,add_p.tbl_summary-arg:test,TRUE,, add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""chisq.test""" add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.group_by2,FALSE,default test for categorical/dichotomous grouped/correlated variables with a 2-level by variable,"""lme4""" add_p.tbl_summary,add_p.tbl_summary-attr:test.categorical.low_count,FALSE,default test for categorical/dichotomous variables with minimum expected count <5,"""fisher.test""" add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous,FALSE,default test for continuous variables with a 3- or more level by variable,"""aov""" add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous.group_by2,FALSE,default test for continuous grouped/correlated variables with a 2-level by variable,"""lme4""" add_p.tbl_summary,add_p.tbl_summary-attr:test.continuous_by2,FALSE,default test for continuous variables with a 2-level by variable,"""t.test""" -add_p.tbl_svysummary,add_p.tbl_svysummary-arg:pvalue_fun,TRUE,, -add_p.tbl_svysummary,add_p.tbl_svysummary-arg:test,TRUE,, +add_p.tbl_summary,add_p.tbl_summary-arg:pvalue_fun,TRUE,, +add_p.tbl_summary,add_p.tbl_summary-arg:test,TRUE,, add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.categorical,FALSE,default test for categorical/dichotomous variables,"""svy.chisq.test""" add_p.tbl_svysummary,add_p.tbl_svysummary-attr:test.continuous,FALSE,default test for continuous variables,"""svy.wilcox.test""" +add_p.tbl_svysummary,add_p.tbl_svysummary-arg:pvalue_fun,TRUE,, +add_p.tbl_svysummary,add_p.tbl_svysummary-arg:test,TRUE,, add_q,add_q-arg:method,TRUE,, add_q,add_q-arg:pvalue_fun,TRUE,, add_stat_label,add_stat_label-arg:location,TRUE,, @@ -32,22 +32,20 @@ Package-wide,pkgwide-str:print_engine,FALSE,"string indicating the default print Package-wide,pkgwide-str:theme_name,FALSE,optional name of theme; name is printed when theme loaded,"""My Personal Theme""" style_number,style_number-arg:big.mark,TRUE,, style_number,style_number-arg:decimal.mark,TRUE,, -tbl_regression,tbl_regression:no_reference_row,FALSE,Specifies the `broom.helpers::tidy_plus_plus(no_reference_row=)` argument, +tbl_regression,tbl_regression-chr:tidy_columns,FALSE,"character vector of columns from `tidy_fun=` tibble to print. 'estimate' column will always be printed. Select among columns 'conf.low', 'conf.high', 'std.error', 'statistic', or 'p.value'.","c(""std.error"", ""p.value"")" +tbl_regression,tbl_regression-lst:tidy_plus_plus,FALSE,"Additional `tidy_plus_plus()` arguments. Cannot be one of `model=`, `tidy_fun=`, `exponentiate=`, `variable_labels=`, `show_single_row=`, `intercept=`, `include=`, `conf.level=`, or `strict=` as these are controlled by `tbl_summary()`. The default value for the additional arguments is `list(conf.int = TRUE, add_header_rows = TRUE, add_estimate_to_reference_rows = FALSE)`.","list(conf.int = TRUE, add_header_rows = TRUE, add_estimate_to_reference_rows = TRUE)" +tbl_regression,tbl_regression-str:coef_header,FALSE,"string setting the default term for the beta coefficient column header; default is `""Beta""`","ifelse(exponentiate == TRUE, ""exp(coef)"", ""coef"")" +tbl_regression,tbl_regression-str:ref_row_text,FALSE,string indicating the text to print on reference rows (default is an em-dash),"""Reference""" tbl_regression,tbl_regression-arg:conf.level,TRUE,, tbl_regression,tbl_regression-arg:estimate_fun ,TRUE,, tbl_regression,tbl_regression-arg:pvalue_fun ,TRUE,, tbl_regression,tbl_regression-arg:tidy_fun ,TRUE,, -tbl_regression,tbl_regression-chr:tidy_columns,FALSE,"character vector of columns from `tidy_fun=` tibble to print. 'estimate' column will always be printed. Select among columns 'conf.low', 'conf.high', 'std.error', 'statistic', or 'p.value'.","c(""std.error"", ""p.value"")" -tbl_regression,tbl_regression-lgl:add_estimate_to_reference_rows,FALSE,Specifies the `broom.helpers::tidy_plus_plus(add_estimate_to_reference_rows=)` argument, -tbl_regression,tbl_regression-lgl:add_header_rows,FALSE,Specifies the `broom.helpers::tidy_plus_plus(add_header_rows=)` argument, -tbl_regression,tbl_regression-lgl:add_header_rows,FALSE,Specifies the `broom.helpers::tidy_plus_plus(add_header_rows=)` argument, -tbl_regression,tbl_regression-lgl:add_ref_est,FALSE,logical indicating whether the reference estimate should be added to regression model tables with caetgorical covariates,TRUE -tbl_regression,tbl_regression-lgl:add_reference_rows,FALSE,Specifies the `broom.helpers::tidy_plus_plus(add_reference_rows=)` argument, -tbl_regression,tbl_regression-str:categorical_terms_pattern,FALSE,Specifies the `broom.helpers::tidy_plus_plus(categorical_terms_pattern=)` argument, -tbl_regression,tbl_regression-str:coef_header,FALSE,"string setting the default term for the beta coefficient column header; default is `""Beta""`","ifelse(exponentiate == TRUE, ""exp(coef)"", ""coef"")" -tbl_regression,tbl_regression-str:interaction_sep,FALSE,Specifies the `broom.helpers::tidy_plus_plus(interaction_sep=)` argument, -tbl_regression,tbl_regression-str:ref_row_text,FALSE,string indicating the text to print on reference rows (default is an em-dash),"""Reference""" tbl_stack,tbl_stack-str:group_header,FALSE,"string indicating the group column header used in `as_tibble()`, `as_flex_table()`, etc. where row headers are not supported; default is `""**Group**""`","""**Group Status**""" +tbl_summary,tbl_summary-fn:N_fun,FALSE,function to style integers. Currently questioning...THIS MAY BE REMOVED IN A FUTURE RELEASE. Use `style_number-arg:big.mark` and `style_number-arg:decimal.mark` instead.,"function(x) sprintf(""%.0f"", x)" +tbl_summary,tbl_summary-fn:percent_fun,FALSE,function to style percentages; default is `style_percent`,function(x) style_percent(x) +tbl_summary,tbl_summary-str:categorical_stat,FALSE,"glue string defining the default categorical and dichotomous summary statistics to display; default is `""{n} ({p}%)""`","""{n} / {N} ({p}%)""" +tbl_summary,tbl_summary-str:continuous_stat,FALSE,"glue string defining the default continuous summary statistics to display; default is `""{median} ({p25}, {p75})""`","""{mean} ({sd})""" +tbl_summary,tbl_summary-str:default_con_type,FALSE,"string indicating the default summary type for continuous variables; default is `""continuous""`; update to `""continuous2""` for multi-line summaries of continuous variables","""continuous2""" tbl_summary,tbl_summary-arg:digits,TRUE,, tbl_summary,tbl_summary-arg:label,TRUE,, tbl_summary,tbl_summary-arg:missing,TRUE,, @@ -57,11 +55,6 @@ tbl_summary,tbl_summary-arg:sort,TRUE,, tbl_summary,tbl_summary-arg:statistic,TRUE,, tbl_summary,tbl_summary-arg:type,TRUE,, tbl_summary,tbl_summary-arg:value,TRUE,, -tbl_summary,tbl_summary-fn:N_fun,FALSE,function to style integers. Currently questioning...THIS MAY BE REMOVED IN A FUTURE RELEASE. Use `style_number-arg:big.mark` and `style_number-arg:decimal.mark` instead.,"function(x) sprintf(""%.0f"", x)" -tbl_summary,tbl_summary-fn:percent_fun,FALSE,function to style percentages; default is `style_percent`,function(x) style_percent(x) -tbl_summary,tbl_summary-str:categorical_stat,FALSE,"glue string defining the default categorical and dichotomous summary statistics to display; default is `""{n} ({p}%)""`","""{n} / {N} ({p}%)""" -tbl_summary,tbl_summary-str:continuous_stat,FALSE,"glue string defining the default continuous summary statistics to display; default is `""{median} ({p25}, {p75})""`","""{mean} ({sd})""" -tbl_summary,tbl_summary-str:default_con_type,FALSE,"string indicating the default summary type for continuous variables; default is `""continuous""`; update to `""continuous2""` for multi-line summaries of continuous variables","""continuous2""" tbl_survfit,tbl_survfit-arg:statistic,TRUE,, tbl_svysummary,tbl_svysummary-arg:digits,TRUE,, tbl_svysummary,tbl_svysummary-arg:label,TRUE,, diff --git a/man/select_helpers.Rd b/man/select_helpers.Rd index ed5e49cf08..c1188ef641 100644 --- a/man/select_helpers.Rd +++ b/man/select_helpers.Rd @@ -23,7 +23,7 @@ all_interaction() all_intercepts() -all_contrasts(type = c("treatment", "sum", "poly", "helmert")) +all_contrasts(contrasts_type = NULL) } \arguments{ \item{continuous2}{Logical indicating whether to include continuous2 variables. @@ -32,8 +32,9 @@ Default is \code{TRUE}} \item{dichotomous}{Logical indicating whether to include dichotomous variables. Default is \code{TRUE}} -\item{type}{type of contrast to select. Must be one of -\code{c("treatment", "sum", "poly", "helmert")}} +\item{contrasts_type}{type of contrast to select. When \code{NULL}, all variables with a +contrast will be selected. Default is \code{NULL}. Select among contrast types +\code{c("treatment", "sum", "poly", "helmert", "other")}} } \value{ A character vector of column names selected From 2f5285a2e0f631fdde9558ac183be9e0908f5940 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Thu, 29 Oct 2020 01:48:23 -0400 Subject: [PATCH 09/17] misc updates --- .github/pull_request_template.md | 2 +- R/where.R | 19 ------------------- tests/testthat/test-set_gtsummary_theme.R | 20 ++++++++++++++++++++ 3 files changed, 21 insertions(+), 20 deletions(-) delete mode 100644 R/where.R diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index b57ac1c237..f6769238c6 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -13,7 +13,7 @@ Checklist for PR reviewer - [ ] If a new function was added, function included in `_pkgdown.yml` - [ ] If a bug was fixed, a unit test was added for the bug check - [ ] Run `pkgdown::build_site()`. Check the R console for errors, and review the rendered website. -- [ ] Code coverage is suitable for any new functions/features. Review coverage with `covr::report()`. Before you run, set `Sys.setenv(NOT_CRAN=true)` and begin in a fresh R session without any packages loaded. +- [ ] Code coverage is suitable for any new functions/features. Review coverage with `covr::report()`. Before you run, set `Sys.setenv(NOT_CRAN="true")` and begin in a fresh R session without any packages loaded. - [ ] R CMD Check runs without errors, warnings, and notes - [ ] NEWS.md has been updated with the changes from this pull request under the heading "`# gtsummary (development version)`". If there is an issue associated with the pull request, reference it in parantheses at the end update (see NEWS.md for examples). - [ ] `usethis::use_spell_check()` runs with no spelling errors in documentation diff --git a/R/where.R b/R/where.R deleted file mode 100644 index 6b67fc7aee..0000000000 --- a/R/where.R +++ /dev/null @@ -1,19 +0,0 @@ -#' Copy of tidyselect's unexported `where()` function -#' -#' Need this function when we do checks if the select helpers are wrapped in `var()`. -#' If it is not present, users cannot use `where(is.numeric)` type selectors. -#' @noRd - -where <- function(fn) { - predicate <- rlang::as_function(fn) - - function(x, ...) { - out <- predicate(x, ...) - - if (!rlang::is_bool(out)) { - abort("`where()` must be used with functions that return `TRUE` or `FALSE`.") - } - - out - } -} diff --git a/tests/testthat/test-set_gtsummary_theme.R b/tests/testthat/test-set_gtsummary_theme.R index 9b388b54ad..c80a521bce 100644 --- a/tests/testthat/test-set_gtsummary_theme.R +++ b/tests/testthat/test-set_gtsummary_theme.R @@ -10,6 +10,26 @@ test_that("setting themes", { set_gtsummary_theme(theme_gtsummary_journal("jama")), NA) + expect_error( + set_gtsummary_theme(theme_gtsummary_journal("nejm")), + NA) + + expect_error( + set_gtsummary_theme(theme_gtsummary_journal("lancet")), + NA) + + expect_error( + theme_gtsummary_continuous2(), + NA) + + expect_error( + theme_gtsummary_printer(), + NA) + + expect_error( + theme_gtsummary_mean_sd(), + NA) + expect_error( theme_gtsummary_compact(), NA) From 7be5ba6f01a3078c79e896799768ebdbf6e80169 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Sun, 1 Nov 2020 21:23:20 -0500 Subject: [PATCH 10/17] misc updates --- R/tbl_regression.R | 34 ++++++++-------------------------- R/utils-tbl_regression.R | 8 ++++---- man/tbl_regression.Rd | 3 +++ 3 files changed, 15 insertions(+), 30 deletions(-) diff --git a/R/tbl_regression.R b/R/tbl_regression.R index e460f726d7..e54db4d3ed 100644 --- a/R/tbl_regression.R +++ b/R/tbl_regression.R @@ -58,6 +58,7 @@ #' @param ... Not used #' @param exclude DEPRECATED #' @param show_yesno DEPRECATED +#' @inheritParams broom.helpers::tidy_plus_plus #' @author Daniel D. Sjoberg #' @seealso See tbl_regression \href{http://www.danieldsjoberg.com/gtsummary/articles/tbl_regression.html}{vignette} for detailed examples #' @family tbl_regression tools @@ -106,6 +107,7 @@ tbl_regression.default <- function(x, label = NULL, exponentiate = FALSE, conf.level = NULL, intercept = FALSE, estimate_fun = NULL, pvalue_fun = NULL, tidy_fun = broom::tidy, + add_estimate_to_reference_rows = FALSE, show_yesno = NULL, exclude = NULL, ...) { # deprecated arguments ------------------------------------------------------- if (!is.null(show_yesno)) { @@ -116,7 +118,7 @@ tbl_regression.default <- function(x, label = NULL, exponentiate = FALSE, } if (!rlang::quo_is_null(rlang::enquo(exclude))) { - lifecycle::deprecate_warn( + lifecycle::deprecate_stop( "1.2.5", "gtsummary::tbl_regression(exclude = )", "tbl_regression(include = )", @@ -166,9 +168,10 @@ tbl_regression.default <- function(x, label = NULL, exponentiate = FALSE, tidy_prep(x, tidy_fun = tidy_fun, exponentiate = exponentiate, conf.level = conf.level, intercept = intercept, label = label, show_single_row = !!show_single_row, - include = !!include) + include = !!include, + add_estimate_to_reference_rows = add_estimate_to_reference_rows) - # saving evaluated `label`, and `show_single_row` + # saving evaluated `label`, `show_single_row`, and `include` ----------------- func_inputs$label <- .formula_list_to_named_list( x = label, @@ -183,28 +186,7 @@ tbl_regression.default <- function(x, label = NULL, exponentiate = FALSE, arg_name = "show_single_row" ) - # including and excluding variables indicated - include <- - .select_to_varnames( - select = !!include, - var_info = table_body, - arg_name = "include" - ) - exclude <- - .select_to_varnames( - select = !!exclude, - var_info = table_body, - arg_name = "exclude" - ) - - include <- include %>% setdiff(exclude) - - # saving the evaluated lists (named lists) as the function inputs - func_inputs$include <- include - func_inputs$exclude <- NULL # making this NULL since it's deprecated - - # keeping variables indicated in `include` - table_body <- table_body %>% filter(.data$variable %in% include) + func_inputs$include <- unique(table_body$variable) # model N n <- table_body$N[1] @@ -257,7 +239,7 @@ tbl_regression.default <- function(x, label = NULL, exponentiate = FALSE, # setting default table_header values results <- - .tbl_reression_default_table_header( + .tbl_regression_default_table_header( results, exponentiate = exponentiate, tidy_columns_to_report = tidy_columns_to_report, diff --git a/R/utils-tbl_regression.R b/R/utils-tbl_regression.R index 8b7c530430..897bfdd657 100644 --- a/R/utils-tbl_regression.R +++ b/R/utils-tbl_regression.R @@ -1,6 +1,6 @@ # prepares the tidy object to be printed with broom.helpers tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label, - show_single_row, include) { + show_single_row, include, add_estimate_to_reference_rows) { # quoting inputs label <- rlang::enquo(label) show_single_row <- rlang::enquo(show_single_row) @@ -11,8 +11,7 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label, get_theme_element("tbl_regression-lst:tidy_plus_plus", default = list()) %>% c(list( conf.int = TRUE, - add_header_rows = TRUE, - add_estimate_to_reference_rows = FALSE + add_header_rows = TRUE )) # keeping the first arg listed if duplicated (first is the user-specified one) @@ -31,6 +30,7 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label, intercept = !!intercept, include = !!include, conf.level = !!conf.level, + add_estimate_to_reference_rows = !!add_estimate_to_reference_rows, strict = TRUE, !!!tidy_plus_plus_args ) @@ -68,7 +68,7 @@ gtsummary_model_frame <- function(x) { ) } -.tbl_reression_default_table_header <- function(x, exponentiate, +.tbl_regression_default_table_header <- function(x, exponentiate, tidy_columns_to_report, estimate_fun, pvalue_fun, diff --git a/man/tbl_regression.Rd b/man/tbl_regression.Rd index 726c43d96d..9d2c6a361f 100644 --- a/man/tbl_regression.Rd +++ b/man/tbl_regression.Rd @@ -18,6 +18,7 @@ tbl_regression(x, ...) estimate_fun = NULL, pvalue_fun = NULL, tidy_fun = broom::tidy, + add_estimate_to_reference_rows = FALSE, show_yesno = NULL, exclude = NULL, ... @@ -64,6 +65,8 @@ and return a string that is the rounded/formatted p-value (e.g. model is not a \link[=vetted_models]{vetted model} or you need to implement a custom method. Default is \code{NULL}} +\item{add_estimate_to_reference_rows}{should an estimate value be added to reference rows?} + \item{show_yesno}{DEPRECATED} \item{exclude}{DEPRECATED} From ceb54aef256d9845a068bfaa4a7c0e1f8a79ef23 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Sun, 1 Nov 2020 22:06:16 -0500 Subject: [PATCH 11/17] Update tbl_regression.R --- R/tbl_regression.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/tbl_regression.R b/R/tbl_regression.R index d965d93f73..a686b68c11 100644 --- a/R/tbl_regression.R +++ b/R/tbl_regression.R @@ -157,7 +157,6 @@ tbl_regression.default <- function(x, label = NULL, exponentiate = FALSE, } include <- rlang::enquo(include) - exclude <- rlang::enquo(exclude) show_single_row <- rlang::enquo(show_single_row) # will return call, and all object passed to in tbl_regression call From 448771ca056d1a6f7a69130b23e961055bbbcdd0 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Tue, 3 Nov 2020 14:14:30 -0500 Subject: [PATCH 12/17] importing all select helpers from broom.helpers now --- NAMESPACE | 6 ++++ R/reexport.R | 25 ++++++++++++++++ R/select_helpers.R | 69 ------------------------------------------- man/reexports.Rd | 8 +++++ man/select_helpers.Rd | 22 ++------------ 5 files changed, 41 insertions(+), 89 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 614cbfc8cf..e2e8b8b888 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -129,6 +129,12 @@ export(vars) importFrom(broom.helpers,.formula_list_to_named_list) importFrom(broom.helpers,.generic_selector) importFrom(broom.helpers,.select_to_varnames) +importFrom(broom.helpers,all_categorical) +importFrom(broom.helpers,all_continuous) +importFrom(broom.helpers,all_contrasts) +importFrom(broom.helpers,all_dichotomous) +importFrom(broom.helpers,all_interaction) +importFrom(broom.helpers,all_intercepts) importFrom(dplyr,"%>%") importFrom(dplyr,all_of) importFrom(dplyr,any_of) diff --git a/R/reexport.R b/R/reexport.R index 2e39285eaa..c2e66b90a4 100644 --- a/R/reexport.R +++ b/R/reexport.R @@ -8,6 +8,31 @@ tibble::as_tibble #' @importFrom knitr knit_print knitr::knit_print +# broom.helpers ---------------------------------------------------------------- +#' @export +#' @importFrom broom.helpers all_continuous +broom.helpers::all_continuous + +#' @export +#' @importFrom broom.helpers all_categorical +broom.helpers::all_categorical + +#' @export +#' @importFrom broom.helpers all_dichotomous +broom.helpers::all_dichotomous + +#' @export +#' @importFrom broom.helpers all_interaction +broom.helpers::all_interaction + +#' @export +#' @importFrom broom.helpers all_intercepts +broom.helpers::all_intercepts + +#' @export +#' @importFrom broom.helpers all_contrasts +broom.helpers::all_contrasts + # dplyr ------------------------------------------------------------------------ #' @export #' @importFrom dplyr %>% diff --git a/R/select_helpers.R b/R/select_helpers.R index 9a9c9b3202..c4d61eb277 100644 --- a/R/select_helpers.R +++ b/R/select_helpers.R @@ -32,17 +32,6 @@ #' \if{html}{\figure{select_ex1.png}{options: width=55\%}} NULL -#' @rdname select_helpers -#' @export -all_continuous <- function(continuous2 = TRUE) { - if (continuous2) con_types <- c("continuous", "continuous2") - else con_types <- "continuous" - - .generic_selector("variable", "var_type", - .data$var_type %in% con_types, - fun_name = "all_continuous") -} - #' @rdname select_helpers #' @export all_continuous2 <- function() { @@ -50,61 +39,3 @@ all_continuous2 <- function() { .data$var_type %in% "continuous2", fun_name = "all_continuous") } - -#' @rdname select_helpers -#' @export -all_dichotomous <- function() { - .generic_selector("variable", "var_type", - .data$var_type %in% "dichotomous", - fun_name = "all_dichotomous") -} - -#' @rdname select_helpers -#' @export -all_categorical <- function(dichotomous = TRUE) { - types <- switch(dichotomous, c("categorical", "dichotomous")) %||% "categorical" - - .generic_selector("variable", "var_type", - .data$var_type %in% .env$types, - fun_name = "all_categorical") -} - -#' @rdname select_helpers -#' @export -all_interaction <- function() { - .generic_selector("variable", "var_type", - .data$var_type %in% "interaction", - fun_name = "all_interaction") -} - -#' @rdname select_helpers -#' @export -all_intercepts <- function() { - .generic_selector("variable", "var_type", - .data$var_type %in% "intercept", - fun_name = "all_intercepts") -} - -#' @rdname select_helpers -#' @export -all_contrasts <- function(contrasts_type = NULL) { - # if no types specified, select all contrasts - if (is.null(contrasts_type)) - return( - .generic_selector("variable", "contrasts_type", - !is.na(.data$contrasts_type), - fun_name = "all_contrasts") - ) - # otherwise, select those specified in `contrasts_type=` - else { - contrasts_type <- - match.arg(contrasts_type, - c("treatment", "sum", "poly", "helmert", "other"), - several.ok = TRUE) - return( - .generic_selector("variable", "contrasts_type", - .data$contrasts_type %in% .env$contrasts_type, - fun_name = "all_contrasts") - ) - } -} diff --git a/man/reexports.Rd b/man/reexports.Rd index 8e86f83d0e..61d25e1223 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -5,6 +5,12 @@ \alias{reexports} \alias{as_tibble} \alias{knit_print} +\alias{all_continuous} +\alias{all_categorical} +\alias{all_dichotomous} +\alias{all_interaction} +\alias{all_intercepts} +\alias{all_contrasts} \alias{\%>\%} \alias{vars} \alias{select} @@ -25,6 +31,8 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ + \item{broom.helpers}{\code{\link[broom.helpers:select_helpers]{all_categorical}}, \code{\link[broom.helpers:select_helpers]{all_continuous}}, \code{\link[broom.helpers:select_helpers]{all_contrasts}}, \code{\link[broom.helpers:select_helpers]{all_dichotomous}}, \code{\link[broom.helpers:select_helpers]{all_interaction}}, \code{\link[broom.helpers:select_helpers]{all_intercepts}}} + \item{dplyr}{\code{\link[dplyr:reexports]{\%>\%}}, \code{\link[dplyr:reexports]{all_of}}, \code{\link[dplyr:reexports]{any_of}}, \code{\link[dplyr:reexports]{contains}}, \code{\link[dplyr:reexports]{ends_with}}, \code{\link[dplyr:reexports]{everything}}, \code{\link[dplyr:reexports]{last_col}}, \code{\link[dplyr:reexports]{matches}}, \code{\link[dplyr:reexports]{num_range}}, \code{\link[dplyr:reexports]{one_of}}, \code{\link[dplyr]{select}}, \code{\link[dplyr:reexports]{starts_with}}, \code{\link[dplyr]{vars}}} \item{knitr}{\code{\link[knitr]{knit_print}}} diff --git a/man/select_helpers.Rd b/man/select_helpers.Rd index c1188ef641..7055105888 100644 --- a/man/select_helpers.Rd +++ b/man/select_helpers.Rd @@ -2,34 +2,16 @@ % Please edit documentation in R/select_helpers.R \name{select_helpers} \alias{select_helpers} -\alias{all_continuous} \alias{all_continuous2} -\alias{all_dichotomous} -\alias{all_categorical} -\alias{all_interaction} -\alias{all_intercepts} -\alias{all_contrasts} \title{Select helper functions} \usage{ -all_continuous(continuous2 = TRUE) - all_continuous2() - -all_dichotomous() - -all_categorical(dichotomous = TRUE) - -all_interaction() - -all_intercepts() - -all_contrasts(contrasts_type = NULL) } \arguments{ -\item{continuous2}{Logical indicating whether to include continuous2 variables. +\item{dichotomous}{Logical indicating whether to include dichotomous variables. Default is \code{TRUE}} -\item{dichotomous}{Logical indicating whether to include dichotomous variables. +\item{continuous2}{Logical indicating whether to include continuous2 variables. Default is \code{TRUE}} \item{contrasts_type}{type of contrast to select. When \code{NULL}, all variables with a From d4ed90cc0417c3f440ae2379ddd0d59478cf1b6c Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Tue, 3 Nov 2020 14:16:10 -0500 Subject: [PATCH 13/17] the all_factor() functions are now warn deprecated instead of defunct --- R/deprecated.R | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/R/deprecated.R b/R/deprecated.R index a205cfc030..e8fdcfb3db 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -108,8 +108,11 @@ all_numeric <- function() { "Use `where(is.numeric)` instead." ) ) + + where(is.numeric) } + #' @rdname deprecated #' @export all_character <- function() { @@ -122,6 +125,8 @@ all_character <- function() { "Use `where(is.character)` instead." ) ) + + where(is.character) } #' @rdname deprecated @@ -136,6 +141,8 @@ all_integer <- function() { "Use `where(is.integer)` instead." ) ) + + where(is.integer) } #' @rdname deprecated @@ -150,6 +157,8 @@ all_double <- function() { "Use `where(is.double)` instead." ) ) + + where(is.double) } #' @rdname deprecated @@ -164,12 +173,14 @@ all_logical <- function() { "Use `where(is.logical)` instead." ) ) + + where(is.logical) } #' @rdname deprecated #' @export all_factor <- function() { - lifecycle::deprecate_stop( + lifecycle::deprecate_warn( "1.3.6", "gtsummary::all_factor()", details = paste0( "The {tidyselect} and {dplyr} packages have implemented functions to ", @@ -178,4 +189,22 @@ all_factor <- function() { "Use `where(is.factor)` instead." ) ) + + where(is.factor) +} + +# this is a copy of the tidyselect where function. it can be deleted after the +# all_factor, all_character, etc. functions are fully deprecated +where <- function(fn) { + predicate <- rlang::as_function(fn) + + function(x, ...) { + out <- predicate(x, ...) + + if (!rlang::is_bool(out)) { + abort("`where()` must be used with functions that return `TRUE` or `FALSE`.") + } + + out + } } From b01c0ca306ecd459c25d3928b060388275bce354 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Tue, 3 Nov 2020 14:53:56 -0500 Subject: [PATCH 14/17] doc updates --- R/select_helpers.R | 7 ------- inst/WORDLIST | 29 ++++++++++++++--------------- man/select_helpers.Rd | 11 ----------- 3 files changed, 14 insertions(+), 33 deletions(-) diff --git a/R/select_helpers.R b/R/select_helpers.R index c4d61eb277..ae107e3883 100644 --- a/R/select_helpers.R +++ b/R/select_helpers.R @@ -10,13 +10,6 @@ #' - `all_intercepts()` selects intercept terms from a regression model #' - `all_contrasts()` selects variables in regression model based on their type of contrast #' @name select_helpers -#' @param dichotomous Logical indicating whether to include dichotomous variables. -#' Default is `TRUE` -#' @param continuous2 Logical indicating whether to include continuous2 variables. -#' Default is `TRUE` -#' @param contrasts_type type of contrast to select. When `NULL`, all variables with a -#' contrast will be selected. Default is `NULL`. Select among contrast types -#' `c("treatment", "sum", "poly", "helmert", "other")` #' @return A character vector of column names selected #' @examples #' select_ex1 <- diff --git a/inst/WORDLIST b/inst/WORDLIST index 7eb98838f3..1531dde8fc 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,6 +1,18 @@ Anova -ci Codecov +JAMA +Kaplan +Lifecycle +NEJM +ORCID +README +RStudio +RTF +Rao +SHA +Waerden's +Wainberg +ci conf coxph crosstab @@ -16,34 +28,23 @@ geepack glm glmer huxtable -JAMA kable kableExtra -Kaplan knitr labelled lifecycle -Lifecycle lm lme -lmer logLik mL -NEJM nevent ng -ORCID +nnet pre pvalue -Rao -README -RStudio -RTF saddlepoint -SHA sig survfit -survreg svychisq svyranktest svysummary @@ -58,5 +59,3 @@ tidyselect tidyselect's tidyverse uvregression -Waerden's -Wainberg diff --git a/man/select_helpers.Rd b/man/select_helpers.Rd index 7055105888..6a374edd28 100644 --- a/man/select_helpers.Rd +++ b/man/select_helpers.Rd @@ -7,17 +7,6 @@ \usage{ all_continuous2() } -\arguments{ -\item{dichotomous}{Logical indicating whether to include dichotomous variables. -Default is \code{TRUE}} - -\item{continuous2}{Logical indicating whether to include continuous2 variables. -Default is \code{TRUE}} - -\item{contrasts_type}{type of contrast to select. When \code{NULL}, all variables with a -contrast will be selected. Default is \code{NULL}. Select among contrast types -\code{c("treatment", "sum", "poly", "helmert", "other")}} -} \value{ A character vector of column names selected } From 237431e4b3a049623cda5b79f72969f08b3ced00 Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Sun, 8 Nov 2020 00:56:34 -0500 Subject: [PATCH 15/17] added theme element to control ref row estimate arg --- R/sysdata.rda | Bin 10328 -> 10319 bytes R/tbl_regression.R | 5 +++++ data-raw/gtsummary_theme_elements.csv | 1 + 3 files changed, 6 insertions(+) diff --git a/R/sysdata.rda b/R/sysdata.rda index f4ba10e1a6ced929d4fa57a12ad65f624e563b0b..273c685815693b69c6095e553aea9ac2456d886e 100644 GIT binary patch literal 10319 zcmV-VD6rQ;T4*^jL0KkKSqL0L2LKxb|NsC0|NsC0|NsC0|NQ^||Nejf|NsC0|No2t zLI7XkfC1nx9v)A(H-+86JI8=8JEO@$6zz&xrsdmlYkdLG=6h~u)v(pZPzAlhyKV1q z=dSGv9^0dLbh>-F+CAAPUfZG9PJ;FtdOh0O4F>Gdb&3|TTZEK?UZgO(&Vvl>e zrpg`fb>JEv2}D6M5uuYbm`w(TfC-}}nq;1h2=Yvr$Y@VNPbl#kX*BUCsP#5RrqTvz zPej6G*+yv|f-_T3PywI0000000000005IxBxnR`Pe9Zs zl08O^>Ojym^$k5HgF&EZdVtU}27m^JK+pgHGynhrp{9TU03uNYXazE2nx2_8J*s4S zMxIFYhSbpX(mh6=pwRSy28M^JplATl0MVhQfB};r#L1&T&>K@tJqQUB1Oft>)WkF< z&`d)mPui*GDt@C=*)-ILshW>d9+OOi4O2nsi48RM41*BKrW4c+0LU9e(TEtB1RBG} zul^JekRq;`WY(9ok~!TK9Ai-%%j_y7#e}G(g@pkE;vlZyTU2_P*!%lByFKm0LIhQN zLI9nS4{He$+&NQ+g`k(jPU4Juyam(H~G`A{NdUt>-vH* z%dBWd>~EFZ-L-9{RXkTn+}-WXY^&vRne1lRw&+(ZI;M-%+s;pez|UrxXw@=Z-S2%j zAFZ1eY3GGr#J3lMQ+1XtXElpiX7czd+ob7ZJM_-s&lVcVsaArKf;*Nwf;6yOD>Gt^ zfVV-8mQdQYFT--^((>6~I~DQ1Dm~Gb6s6iWj%%Qn|xSZIp;i zck>p)U06}kHOWpjigX!qy=3k3UM|>44;+A(8BEL0$QmL6lDJlPO94vYdT`;jdVMD= zg}0=843hqB=Gv8xA58LIO?ajTm5*CPA$CgMq_SGZ=Y%@}IBJlY_CCC-DQs?PyJp^; zw7Zq@mIVneowss%PM-5N4cM;f0LR<)Q08dWt4hqxk-~9pFx->X_T=xB{YQHXsbpqi zrAw@eYl}&6H>2LfmRZ+Sj(S{C4-BA*b;gSX=C~nq^XR~y2Mcz2p#?Z7WC2w~b|?gu zYe_A)smH^>iMtLZDGEZUl%>(eEs;t>56T8yXjCEG;dpLmrqyM38#X^S4E^jGr&tJY zsX<=+>Rj#zQYBZ5HiF8p*fcLoS`m3SE-Pe5!-(cuY_c$+W)hy%U1Xr0E*eTT;ijOeZyk7Xp}{+vM91WFSCM z0P6l7A6o;erIi6L1cHsx1WI(A7_nH9V5qD_5f%|eK_aYziUJ_PL?WW1v5G`MQ3e7r5oA~jAgCfDEEEWj!<>i+$lPc zDGHa?!P^bWW^F|ntQ24|il%us%S6!5Ah0aLV=ru!U4!xZGJ!xey+1756-m+|aQ4^R zd?*x5t4-m;|4aOLCvao1O6hIP*Y&WMory}Rl8MW_>FiK5tb0wH$KOO!hj6m*ZR(lo zEE9X?+!hD$X|Uf)aeAZHR9lS0)&*9 z)`GrYYRyRT@+g8RIYFDQ;U5MSvL`|kDWg`VT;%lE$F`J-IZb7Obq5Nfqg4sH&XtnB zj$1LP#4ogUQjp+uU|K4Ru^@~)bI4RAZL3L(0es$SAUwPwk!Z$(!sUnsq|`U$_-zeCG6wDV(|DTaH6QD zd9)*>hs^2VmJc7Z`NxGGtH?FDq~qH~*-v6^hH!{i?su#;PpiGo6w{_zg@mWjcuhC9 zW>qtOrn%x`fHg-K`eoCj2hDOJC1>^40c`b3j}}fCv7KTCOJZUwtp{Jngg<>GN_RO9 zj;I5PHF}2{JSmqyVmhV7EYD(yrl*X1jzlt2D@`;FxTsuJP_Xut*=efJQDytX%a%LB1HNnqHjcd1a<%FRZUBuh2&KB!T1*PRi6k;H5 zws^wB?pefhji!dRNYjR-O6qknp54{ivz?8a;RByjj&Ha&jF}Q9s!C9hn%c5CU$n#F7Wk7GxrC(_A( zJnH9?HdaXrkElK!9+uI zr0E^rraC-tHEyL335S#h z;zx9O^V~?7(1t8or%VHb1mFifew22ih3>+E^mvHJTwA}_xtD}2IbD|bD=<%Q#LQ+M z=qZ?_$&#d8Z$&08HbOkC@0rqfP9+-Y6zIne$z2+)sRz9xPhq-fye+HrO}1*P5HXMe zSNA5Fe4ExL`Ha;#haISnE2igyk5NyGE4JP$QJv8z3!|BbJu} zp40*B3FZud8&+s zrjQLFI5d*5O_ahkr&W}sNOfUDPc0ZHaE`3^hMT*;gM+*GbhNj+QV_cqLYDM^1#(`H zFeq#gqhS&livV3k0YM@VV@{-Gqksj@evXy!2>2f)R8A>L$}82^&!Lk)^f$H9^mg?r z<*?0q)%jg?zN3I)JImuwZP%d+KNisus)F}5l3o?g)OhlHLfz!nM|M_}9B`kBQK56o zzvh@k2O4623=;=ogC2E}Hd07yC8(EJY#eSaL6yK))=v! zE_(ub30*6<5irQdhB`)6$<5g{s_hkps=T@aFfy)=+S^(?Zw;ndkn3ZfPvZ{*U(dlu z1dJwnn=1D!oVRHFb{&z@=7k4s=Ty9uTM{4|FG4g)r(pU!BjkL*mSUwL`y8t*YO@S) zO*ChuY7y*f>A;BmwB2ldGBOaWrCuYts{PzHH{lfVFpkuRMk~eR8dD$ zYg_Gjy{9iml1^YpC(jrlR?cL+SS3Stk1n@wgt<9z+PKORFF`=R5{V%_91ly^7~`KBmAQ$u z@PWf z68jPNLe#(=3#2NzozQ#-FF_S#I^lFeT{xIGzButgH8LErQk3tODIORY!^LnBpcN^B z`FqUNjUov0mAo=xLjX_^2hJ0_+XfJXWvrPB030z2>l)%{+&G+=XfF*BP9bs#EL5kE zc%TF^dM!2~O&)iC$jF$#L1~#g3=g#U-(Q_*AiN90540r48l<^yLvV?%3>E@SH{(y& zc!rAtUq_G1{Cs?#ZF-T~*+4clJtC1Mut!J_k|0tBCF8KSh8oyR+j+IPeyn&w$m#hv zIiR669)BT|gYb0cZLaKi_@ z)hW)Lnzaoe#0=>u6@+hVBL^93w3jniaT$z&Twx)O1=p~ohWUGEP(A%a3V22 zagmZ)MZkz+U8aEy88oAaw+aAqwWrcPZx6ZrKbve=b$9Fyd#n*ff^LaxNN$yu4F#Z_ zlJkn(=cOH<*S^RG>X$`Y#RRnzGh*X?W1CrYg;GI4x*4`;l4xNjFCbKs9ZE@yvk>a7 z**o`Zl%5USh&|rkSCg`dR_lgobyBs|lkF4{bV^uC`$M%Sa)|awnhaPg#*7>(uTFC= zVv-8PLxqSmva})8tQ8a|3<;MRWk*T@>4nzL)G)A4L`^UW%PL)PP966`weyl?)RM5S zWtbP`K;sKiSPuv{>VU`I?avkF(H!VS2D>fG*Oo?I&5SW$JRC%SL@2y5bW8)6edy*VSiqZY%VjOFu9G5{ zRYpW+Jq`=rd8%a6hSo4UG$`w8P+SE;%;+5KgM)AjRF(6}r01;*(D9U7$rGWXbuR09 zCXum>B?85At_>pxw|2j}5PX}>=U{_;g(eK;9H8tH=wY&z>au07SYIOIVjJ01wT7d8 z8fDHW0kfJUf^ifAMM2C7=2%}5DJ9zpAg?+i;RgUJ8x*6|st-`g*!)dS{lKsiTmmjH z%rQ*Ofc8;1ihWf99nI+hkkpN`L7C;9h(}$}9X_sWqg7%Ih* zEEY+~DpW`?qkn^-mjeobG$PF_`7fKPl8auyblwc&vYAtZ6Tma=YF{ohy5?zvwy5@GDE^w zB1?JEw}3)|VgEh1M^{3tX+nV%wjy&|NScTN2?i-0pdmFSY$ITy9ZFX0$e32`))+8mI7QrPpg%Wi&Zl-?sBDqD{7n(=Za;oamWm-322 zK)^gK0Lb1k=|G(t@?H~^DL9F1YW+}+wS&lQU&EhPh}dNlKfAt(Z4NINM)a3q#Hv+Q z6k10&B7;QZa1=_CH75rJ%50RaQCUS1B-K%>kuDPTCAj)Hy+AdZ1E{ zIu{r4!?d160ItMGhF4A9V6txUp(xL2VdSs4B(2?BY^+v0o(C9IIrzK?rv!^#I%M|w zu`F1bKqyRw8pf1%L>{<426-g94(0=4Ae%kDoChM3$UzJ`(omE@MhGxqaOfBbK?ZV| zLTBIFuK{z!F;K(QsC%N==%id!+HP%(8F~U$M-xg04UjhMO?B{1*~dCmFfI%?TJvIi zQXz}CE=;@7AcP))n(mivFoanWCQrH26+)0J`8HVflHpuu5&`CmkP)AMX27a$XUcBy^(E=_&z%(iahpV<&JM>6d ziL^S97ycaL2pes->@o$owQPm#z}6;51YEE{VQL2TLZCQ;mm;8H#|R04XB$aqkXa`6m)U-k_ioK9zohFI!*Xl6BDR85S|l9B=MsN zYspY<#6YKAP1Q4V8evKZCAC5MG1n?wjofVLRduYC*MVXZ)@vfRkwWFwa`Gft9rZI0^t)OzHQT)p9qt3A{EJj!=NvC_v>-%cT`c z3ch1qk*8QiO@kh~+QEoSy6aM_Dh9!vI#Af%!!#hlv1VrqAR_sU*eklGq>ro<1xvWm z3dT@C7Xg?q+T7b1#?rCa!;bL3Mmoe&1vWG;9K0?Cy_la_%^!U;*!C5~NI+ZRcStT( z7W5w6Btl>kSUZ#;@K-c+(NIa-61i3cL&N9ldEDNAM!c{h07xDg3{qJUy&YX8eRtqQ4tb&%V(d=fSL!J1pqzk8$pLT_}>^ zHl5~J?cl||t`~c&F7zTGF;)Q52`YXt5IM3k$##HcNT4ad7bI|8jV6@^(~3c!aYm$0T_#xxV!B{GZj=T%*>3T zQnvyH%|Hl;A}tA|qeNy%6}#80jxgxKy0f_lj?S5&0ry7 zCIZyMz+Pm_haQS?HDYyCY{kuFl;}Z5H8`WZEJ(x|#d&gABo}b>#enRbJvY$Kh+HYXX*mfcop`Ur zyceH2a^b^voH|Wu4T!_x==Q4v_M>$TvTLFucr1t!kUDq>DTCP6wkV%i?yN;v#t( zqGP7HN<%G@tqgRoBuuV!bDHCLHc*5)!9jw`!R<{dgG&N+5}#nEbBa6I8mAA{x)HNr z>m@chXM}9^&h=~q;;fOR!%cdmWIf?WyL2iGxt?Hgn^>gaG&6ZC9b|k(wnp1Z3$ay1 zh>24tW^fanG;k0RrxK@>y!Lt=hHN~nK@cDU?`xsd+$*{m3}dVjkXguB>20N$fvEl^ ztmlR?6oBmTI(opnNlUEA8X8U+=K%YV9eNb?Qgd<<-m+g-;O~1ua|v7nna3oQhm$T8 z!Fn&i$RLPj@1NS2H#{W1kG%&XFai)QGwD)sv^^dPQ6N;eRzqi>aTMGw>|Wy$iOLs5 z3lk91l_cK{_F71RvP_jk4Tn5ha+GQSQxO1*6&|9_cAJtGrF|~cilru(RwlyuL68l2 zg7`rU7Aqi#Xc_h1mPrj20x8iK0Pud`)Bw_4rfxu8SlX?csNKhuv#U4Reb-uq%1jD- zT~Sb+Izk~av@TFl1*6{}&yf2Gp6M_GfCsS9ZAQ^vA^;M=UF3{|h=Z=gS4pyGDaecx zQxzESIZe%^<_PO59;VcD+N`pHLSE+wu1b~Op|!8QCT@W#e_rP{jDmCZ$*{V56Ne#U z$83i}kmfH}n%gAP*C8}1anpI=Hq9g%oNti9D3rNCoUc?%oh{M{gqlqQ1D?AlLc~( z)qv$9nKA}5xjTd}?!nQ06zzz+JSns=O$vcFfOfSd&;r0x0jIU?ko@WxjWR`8-2`yl zD%cn>1`!6v*uo3R+?Y@5m|{b@CMZmb=^;?amOawl@k#q5-@>8b?PT#NU=BedWEyT~ z@H%}4*X=eyt_gstR108+;b5G+qTX0;MW8h+pN4xR7R|Vn~bS)rC%-EL>^1HBuAN}{ZY+43h4{xI^VM7nt9wKI_l0kXS z*dL{eh{%QP-3lSlY(#i&Y}%^a5k>@C@}U5}4Nw8gXshi9aB%x9w`LreAzT1(QsW&^ zsARhnECjG$`}EkQ^%YOtCS7=VkJrFKa~dvC1q78;(i;J=5A#qQ?WjbPZ7OBI!D<}GnV-2lZDa72iT4x}y>O+Y6) z<;&6<(D8BUOK?R8P>=<13=9_n@A-^whGC!yVG5HG;zq=dYXBBD-FLo6VxBS3f&~cP zY|jW3OMxZxG6d;MW$9lF!caN)45A_mJWW8d%76huBY&X&x2BYZwaKzW8%$uxi5Q6j z5s-u=y$nH76e_5eT{h`pZf>A<=1Jw?is`#EP0p z=3JYf+K`5oprORjZYvZ7z8EW z3_!jQtE6uAO-*PX`Qo#O$$!UcF;`JI8h|^n`B@g1yBA7C$;;*rWS##g4NbHYHGKph zL<6d52Ix62J<}n`@aIG!1Jnme8XSUe#Gybpf!VP?dEs~m>ac&Go5`Xc7c+6#X2tGv zhdV=@9}Q03$nNF&54O^;@F4~OA0f@_)zn}mrLN=C5TV9^s-vIC0& zO7OCcde55V)0D*N);Y3>YmzH(9#pP1hwbwJ+$2fR_+&Yl0?@Q&qBKbs=M-B+)iL)An-It`Utc50tk}stkd;AyuNn2>^8&_Tj1c zi;>^)ZM&;~IylaOpGh2s-E`V$kZ5m2ZvCkR4M|MU8K+sI1*$fd#t`O2r6Rm%a*q-3o^z6jf=qMkU{gJcc^ zW6MBbs1^kat5UB8v1%XR zzwh0k*kmAB^aGJIc&cux{5=mp`6g_sGKUznuTCq(q8iZqg?Y1@p#dH&mJUV_BqQ=) z%l~dN`i&MsJkWesfy~GQf2pJ!oY-Co6NmwS7>M3;$w2CPTWDRDc&ric^*~ncufUjs z41VR5UFjqQC@wmn#Dq5o`|%nGNES+wAvR$GtKQSWs-c9g-sM<0foPfQu`*2C@vKnE zV--8a1lLa3dYtcvs zqQems&SAL(iL+5a_)re}wkq&hZ8R{WGBoBI&|y@#7?%^sW3@{IHacxsLY6`aZY&UT zhSE#}Nz7nb6ABrvxT8RmOyOyxG($%rtQR&2KtRa{VzE4FzX(q}<3oyMNO5+F_ z`tl`#A)cWiMQsHX@IeKNbLDF6XduN)Y+=0@qH-{~6R(?Eol)rFYln)# z8UV;=3LtDHy_X<%q%yV&fxpSY0`n=Hm5S!g!$iz2FOHrJ0nyXUGB(u^8(6BUFK4cB z=@$NONzLf`-mg2W@{sQ_SQY3K^32(`$#WVrTa`mN;@&<0|A6#t;DVhfIu4n4^>J;JcNux!eKvTb(u66$i6I)9(c#Q z!;pc(fWwTKyeunz6uR;P!w7|->JOnc4i~3&J9M{XnKd#FFdxstCsu>u%dlUnOrQ(h z9L`ypO_HyDr8Dim&Ra88k`2t^@t{UH#j0gVhsb^Y&=4NCkGt4}e+izFO?ct=GL^AM z*m?FrW6OVxum^?d5vAyel*xKXIH+Bygq)ld4{K4bdSM7EV^kGABs3Rc?5@;V7LwV) zYH)ADxaujg!O~;Z3Un_y;q$=N3=W_SO}-_NxwmG-5Ex>NMKaoYF&VLbg{qHe$eE>n zf-Cf2qe#ZAM}~2k^~;rVbo;NxT^e(eF)%D!ZHc{64yAb!DAza$PPE`W`6Wb6Bu9*9*7fGr{}$c-ZYAaStxhMn zZ$#uSNZH>*ab>Q?zL@1ZsDE58j#EoORC_RV!!$V(S!!A04|n^g>U&)K z{`56xOV+U;*_mlHbCY*tb&EE~uVYw>vF(=}E-yh_3I+uK2L&2!SWK3@FmZ~9#)H4zzgO%sTj9uOD)Cs7q$RwAIPh$s=bZYGYV9zMqL zyJn2&O3qHEwa0VvCV`g)ofq3#vw_L==WBtCGn&lB(_9$byeSP0ohKhsc$fnjWNW7& zY9LdLfh{S4;GjVTe^G}qdkbc~)fG+MD6S}(N+u3YeYFZt@_Q~$eT(Wzf_M%U&3B0| zGvHI7Vu8DcJ?9x0>WwGhG6S5KgnU4GSTx%k8z0Amlic35buVwt4ZaMTwOLhJC&Ttf zCTPmRBGWGi(7Bn3^_N24bGRnKOn0H&*1fzF3`}yW16q^WCZN<~-cF6)8r~40f`=xh zJ1y(A_!KFu%Q2$HcvcKo8&e9X9X&+zz8{CJyxU2}JS>a$ha))x+5I}PC6+b<2ZeBL zZOTS}7M(r4hX0l3R(|ZzA^|02D(2|SsADlvyY6?*%f&-uL0)e;#IrCCxzU_+sN&cU hXbK_yJMQ8PlA;430E1z`6#@U^?ntK!5&;87&JlUb<&0kn6 z=o&uzU8~zDQ?G2Ub-KyxLcOw2On}w5(Y;`OK38UGPM2XFU=qt*?eAYs=7ZmDG&3-x zeZ3M;Jy-xf2}D34G8r(KQyK<TILbG(AsIrfO;G85sZoGyni( zHi9$*AOO%FpfmvVk5Kgh0B8+QM9@NIAu}nX0qU6pMvR#>z!9L)rh`Dx8fkoVYBgr;X+EI*{pv3hW z15Z!@G(A8bpbtnMpfogkfE$C#r+5eX@ouU9qaX28+# zYA%ua6;S{zQmsojgo*AAPO=9 zFFT+vMTo=$I)Z3O=KbbeQU|gh=$HaUkifZ$olpsP0jn*z4aO_pIqLb@lE_znRi^E@PYv9`~)=x{7DT zk}-Y{WO1`z_NKZy>?^76PYYaoDeoPhelq43J*Sz6z&dZUfubS&A@-HGux zYea}$6jkgT^PbKAYwGATv74>w%BsVd(5lPrjhnpcW}Ou|e3tMww+me#8x+x7Hnq)) zxnb2cPg8F}E$)tr@{T%WN9kJk&tvs7Uac(a(VV}Cp%m*F}hi}}vb zSAy3fWKxVo8Ox0eZWKfq(=l{HSPiB@iIZOHb#`BELW;#wu5mAga3Sjjp_*0BZ4rb@ z6kcZ5SvHdvSF3?F0B>^htGiTrB z4G{p#Tsup(gr`(`aN(f!3T{{naZL4@A^olH<|xle>>4%J*pf_Fw(%As&VoK@{1ZlB z2x$pLQP@t`){O--Rbx@w_VU9ga=t3SnH9@z-Y=BtZnIq7a_$fd`!22>emZpIvNPaq zIL$k@Me6+6JLEq}&xMn&sTZk2%IZy3G*;twu6;ys(7IxHIPe5GY6zBCV_2Lm=ve(2 z+)CqXa#`U8H>O}BQ9yO*1XXD`u4`1{-O;GrhW>Me;Y3N!%CD)gCpba)K*PX7fe(#! zp|eEy)Qy*G*8KM~_ikpDARI76Pz&F9BGTJhASpNrqZv~Bpp9FqMuXgwxG{ixUlk1( zQG-w;WT$(A#!RS$N`zWjN+Om?FoPlQ(F7VY4JZS0j-ZSLD5M*+DO0XSFL|XRUvgal zM5svs6z0@a2nY+zKm=qUMG*k>{@&-$!>yNA;1cjiDBl$Y2ry7i!UCN$77!!>ApnZS zAS6-(h^&I5C<2gSA^^liWRO85VHgZlVxSQffWeGnqAZaZ$r45=ia{6%L>5Sc5rB$= zBCuk{D-}>;h%ir5l*YwT%so+b2i8lK)sK1qnEGE z{9nyuJCBZ@u&Oano|LrCy%p@iOZ#x{hMH}6B8*lFFc`&CK$~Y=-RF?lmVq&s)@nN= z({%QtP%?EM0_sdl;Z-*Iv(NatC0xaeqi-(%^lnaxj<}WKEzH*K@Ry#hUwec2r5Xh7kWrxQN-vf{9M;`LT51@bV!#t_?4kW5R`rh3nfDB9b)z|8v_WSh+s zc%y3+fvXTxz21h~WI#GNahz6lp|gs*-FJmLd)#G1ziDCx%X1WYX9VRUKKMdP!~zOf zI2KFq6VB1txEy+h@}Xg4RT4K#-THuW<1p2*d=o5p3__U8Jy_^-))x zx`DXbWj5MxR1nzMDApl*1Qjq+q3jd~nUcZ*UamsKA%dgT?`J!95FU46j29JGdWCLT zrP_$2pmQb^m1tDjOd;wqis_80Scz@i8UqOdQIuA}+?6Q96_)}JL`u~a2J2xt#v4QLaLZ^YFvc;x@kEMkmgt{bPcn4A z*;xZXSO$|wxNXymT!LT>E@k9o4tIZY+!V>&V1&Xs4Xs`t*jVS2?puRZ+;bW`>AK35t@hfc@L)Sa2h;3N!k0!Lm*v z@oMoU2NU1RdpzASczVWoqNt{UxFaNc8PmNi9zQSNJLvWvL9N9n9^x*_dlPIkghIb_ zy-w+KEpvr3$~nb^Wz+PUPi*X}XZ#JvD&4lVU-mN!02fe5QVn^+m8rZaf4aK&uu z&?si8yj59_w~GjW3B-)7avYi<4kFa?jxp&-vHH=}EFoTs)I~TvW8HEgl95_!)e6E0 zu`V3L#H|x@E6pl8>UK30E-Nn_%L<%35!UP>v1Kiro1&_*Z$OcCnaxmh(t~Dp=8P_k zDs`Lvx@+3pX#lgdpu&t)2IFX|7Cw789Rq2htt4vX(Gt3yY-hK1c5LWlX1GA-)|%t) z4W%MHd8(3>EDOc%E}jlvZqcgbIF`k_Bg*V-J%hw}kKKKZ1^D*D0g-s^8-N;);rMK0 zB{y!pX%kqjfAMu|{iz*HxAYEMFNZXAol$>!?u? z6ie&wMb9IS>&QN2D;P22{{VAUT}O;KS$`A{O;mI6>W3;QMJokc<>Jf`tqM>0`n4&T|s^wFKJ^+An8;iU=y0eXWKymeaK99a+kQ}2c zDjmr*?l^gTv8ftd2heIvIR*xe7kV%SEdquMkyzo=A!B_N7JW!n3I)n)8{1JX${^uX zHgQL1UFPD_C3raplBmd9wLmn0xPS$nr>dKE5Zwy!q{+0=b?=O!*w|<03{QbfsRR#93h0iK{ zo-NT;6U#pD+d=S=YYbQ&E_%X!RIruZo=h^bB8-qKW$nA>wOypKHCLBJMh0!!-CKKC zZX&hLGM#K=$?J!Ina;vT1b|HiJLxW1IdIYV%soNU=8YF_CtF_1Ey(bV7oP<5)UkaX zkNY1mWtgcu;}@X-KjPg*`5!)XvpmQ}xH>){PvO zBqyVR+4>_seHrMjjONkR2Rj<@PSxm6)eguN3pSv(*#h+O^B!OeZEuX8QpOn0(Jd+m(z$F($qpGbR+Df^@PCXha9yw4V~nVc=#vJ2MxYphB9YuHadVmi^j(^_neH7+;5wI zDG=6sgI>c}FN#?7(Rv<@s2zjAP&$$4O@EXu1pC07%9A>b4ymsXd&3?GCZ8)9lu)zFpmG5U-2rmNggYk(mhLTGv zpxT6Q1kjiv>$T|pO9(WWJ3{vT|F!MoufG<} zFc1qsTB#OCG|h$>J^HCm3B;>V(hNY*l7V6}w4@?TT3tn{n(p>T5dx$|F|m$l6p-IH zZ0iTFP{OGsA1S5yss2VrNo5xTA&GXH1TbXMjs>|W0nFB~u6-U)pZ0!@v0=-(* z$vGj3XgHWzCgoF%&A4>A_AO^Z=Dh*o+p1ylax5hvMRJ3k88Vy@VBsWHp=T5^XUWxF zX;*=z36R4>QuC<2%;_xy8mek(228C8bt?r$3Bv+q##vF)fO=tdv$YH?6Oj{40&>ci zToZ?V(5-yrnRO(rE16~m`A|55)RqIn3+F004E0G!vTQQJDQ-i&WTxeyR|?IA!jp+& z3J{tV)F|^yQTNweR2Dd@pmxNR2BO}@Xn=_e$i-|jOc)Yy4(1dFVuEKH)P>P74qf+= z$ei{B+P5t$3zpVmky!{$f_Lb!OZ5Gy$65|M!2ZezTedKI3WJ%@IFSwQfM!xQ%L)>f zq%A|Kn$jqod8Sd>$$Cb{H7FJZiHL7yQq~$9=+iE7I1QZfBom0B5-JX0Pcp*!2}v&4Nd$OM@7xOkC!khFt)v)jjS0gSLqDv*QtImg2;ifR;M+3J#3Rgf2T!@0>K>Pd9aEMs z285PicG?>g8XH)$MS{sVWlD(#6mU0p3xS-6S(?x_XUKGiGg)lXngw^5OJs#~C=!8s z!{GcLw)G%I;;?THPPzvpAT?%=9Y{v-XzqT?D8NjynJI)KU(T4Vw*}0x|R-F zB70A#(qn|Xw^?9_i7n?w-hmPciTykcekShewBkUYEr^rnAcnF4LP3g0U=W(pl_OL_ zI@QCRp+F@vItG=+69`9{y&`zP75f!byhA$>knmu*>NZ?^+%xfGy@wZ=yte3>`bFG3 z>sODldM(aLRp%H~fPiuk15oHhb+8NI&Q3vlRI^oWgy!ia6EqKio7!=TeP_ev#68k2W+*!g9wDVIdfWOr+>=S8AP62LDK!wdgdYSSA)ZMtlg_|wBok-3)qvzuSqLGAUP2TI z5rPa5H?#}{po2KfAvAC{ra(@JhAJ3(wGWsrj*3OaO{V79!Iz*VRB&lP!LkP3iLWyR z-JEnKLjvH#b+0xjwIUe1a^uU-fdnA&8Lr`W(+EY8B4qsTpsEysU&pe?vX>=soJa?n zE;R{$PA=Ngk-)5X+R025(S-$?1g$4CdV8~i6F8868R2uopoJgHX(Uzz-Hj# zkc+{8d$;Gy@pV*YctDI%-yjr94n!sZpkfL!2y><&Pp)jw1XF)gy$TT^N&$rdWNn4E zqDiqSxByXzAJt;AKslkH?U731Vi(ExVRnfZfl~=fwK8EOGIHZ6$J*|OuzLZCAy8L~ zK*~Iv_>J z7zU!CW*vShm^xetO;RizN({ao>WURry9`3x`nDzPz}6EN1YFQSVQL2TLjv$p3TSo^I;8GDh=g?3G-*TrhdVs6PSW#q6yooVmPW5ekP<6OLW|CVKfe?Vi&e> z1fhUw6|~($TIGVw1VE=dD0Lx%R0|Vg0~XQyA%thB3pqdw&>#V~lK6dQzX!3_+$QkY zUO7SoWT69PTDvNp#auP>a2@D<05O^#aI#*Ch+d{!s6hp%2YV`S>?Rh1MJOM-* z1rSCcFc=y_jcr0~iLML{o*ZMEkZhDHOc4rf!P1|%`qRVP#TIYi5k8vytrmUOi0D2w zWRcltPh@+KchTxZmmu1AnPaz+i+hdUj7hu5L_lJ!0i+UC?tnn&NXsSK0hJOJ9F|_vnS&V6PivEtxaUDefRW+Tb$Lld zHj+GSYzzd<63#;dz(@i>Nq|)g0A#8)@!$olxI=MTft3pY(!DEHO?R#inUkX05UlR& zVhhGDBk=XMjDHVl3^6gx5N8ko&~?m|I|WLFbfIi{@+`Kdd45Tq1^bF)Oj+KLLeIi~{|K(To;vcd}#0-+>Qt|m?* zcr9vShI;I$bCj__G|1jw&{B1S1lLpqdL8|^d1)yI22B$V9CFAO&TqRtS8ISiM2W7_ zHzZ~=v5|a%C7pO*iFhwUa^}O6cCJpNT0>$m{NJaEW^<-)*Vj#_BryPBMPLyakPQiu ztm75hDjJ=uWDdT};0s)#3jjUPZLnw|B+zH+>d+OCvBT0_I;FeixC5_H9#j)RAX? zlY#1C|F@iuyvA~9J9hUd=t;DfP5P8WDEDrKL3!Ec2NAW3P6JV! z$+n)MKDOHNw$VX$DyWeWDr4@=(sU-CzzJiA>zAC*Lz2wjuZSW90A1*5bZe`+SPWyV z5s=J|v61@`^$-?UU7Is~8fvhh;&0CN!U?%0xJg3V6j;QLqN}W$C9S}K&tST0PudnrU8*+nfU=_D$K2(h~3X& zUshvUdo7S2Qeacd$|@6wNJJ(!h0F>dw0g)h<2~u0ESLd61Mk`msM;&UKmu3`&q&BP z5P6JC^;Q)(jfs-A8$x7n8251*T}L%22MItZqG;h60X%?v*{JPa;V@DX@hj@Vim;(<1RJGzqS0bnTr)b9U6 zAC-Ze*j6hW;Er2rwG5a82!mG9gcq#uMpOBwSfSbz7)W*s}IPzUB!|2fk+H#;6aAt3~+(zgO7YG8@A#7OR-Q~Gf>uuDTXOSQ)f z;WF>o9*yS;mm&8*I49PF5kf|&j|xYFjVXs(d~!;m6ktWeLJ$lf(EuG56@57EoiAge z{Ue_wDUc3IUS^^c4EN&7f>dAS&){1%<9Xc`G0Yrux5z^nM8&uZ3f|R5pwtiVKpjnx zi6%Xg39u$->Y8@EU>Y8>L06wz-#Q~u)P69gi!)H z_U zQq&?V5+Wr~0YFx?7g++kKq`xx3kWUZzB_0d^vbYebz})~etpQl@IegdL=I(0A_D+m zgQ!>vp>q{fBmfYAML=Ew6h$*CYJvtzxpP@oUMK=wmMS50mKP&Y!WRJuq!$L*w+U1d zs>hF{4-wIpvnMwdZbIpq4g!**p+QEz8>QkUD0g>h9jKXb4I5oc)at;;bWu2fF-07a zA|ivW3&m4d3C}t-bmrta$nuM1iVm?L3gj6XE=B#;VZIth;1dBGR8ImnBy-pRv9{~J z`5lUQM?we`BYCp~Ac0H-r+Y{jtV-Uq_O~_%UDCrC!Lj0K3oNVv78Kp&PFFu`Ta5Jo77xu9nY5Rfe-A$(pfTsN4|ebR7vw#iu_gi}ViSb+-w3Yp0c0NAUr z@NXf;-7(*?4060^DwIWNhV=oUZ|N}aVjD$d2rMCZ5OSd6UHW5KK*Ue~mos)H#gsKf zMZE>X4kr%V`Li?^6mcx_cy|sSqni{!l#5by1AC1X;=#Ys)Dt(!vOJISsFF-t@IUaI zb1w|4pA&SUQ(=z2%ILkOX! z1d;_Vy>!ibwF4m;>Rs7nHNe#$;J%O@C)2gbHv1AWf~nurk~|3bAaoL`5_ zS9$stu>SwQ?)q09Sx3rz*2i_j%=k~aP2te&;nkr?NsU$l9NphEG*QRynRy@6oM^ZB z8<5BYt!^=c9+3Lo1@4}c4ah0TB6VhV7~Y~V>5hj*!2zj&&r=1AxXbV8oyyjn(`;af;RTYd0^?`rsaW zNKC-^pzohuXQF1jpe4XJwaAI1n9|uXx{$Hdi8M`*wEVeft`Utc51hA6stkd;AyuNn z2>^AO`%uyN3z6OMZM&BKgmE1sKDs!~y6LpkkZL!gH+|^^4H8$NYb{2Y7ObY=!f@FD zv1}AoRTOH2>-PK7+r^JPPG5B0|6kM?ZiQ%m0ZPL~{PX z9E-)0V#LQDm#Gs&OFrolHT3y4O5JdscA#7s3suS^0xMZj`U~^}>e8R0`xZo82%((} zga{8~G9Tl;?_G(kz(B3&2ZfQkQ8yI+KAVmCWNV=#1F~de}5k@8rl4kn?9EIJ(8{*X>k3YY!8{kJRkm2LgDf zt2swAkXn%CRV+~fCxI;sRaS!cl?-b86k{%~JeOP&kUMQoTs%f55a#m_jd%v^&orx? zN0BLT1!6#04+aZ;uz>`-0xktRvBQCM0V5m}mkj|SP)h@@ECA9HYy$gN5va-Iswhn# z5gCT#EW{Ni%zvOjytxJ>v9}#IvlIB6;DC(Ap$#&S(R5a$wMAo+qh$0ZTqG@FuN64Q z-U;)m#lj16Z7FpRZHPC@17KBLF#=lTE1;T~TL`7f zKB?-)a1AA8;wfXpLIa7jLV@@Y4*Rw$@+`KRj3~^FT;p1X6-$uBxSm5Ds#qDZ(`v#L zvJgvgV1t-8l3*IAF@a=EC}y_ejX@@v$!ViBLq{37DyASp0i`DP%sNA(1bMS49K%c# znZ*vJI>WE0blDWm!L(4uEMf)Nk_pJTi!LoHp>hG4@w{B-a+p?VgEWwOiF*FRjP4Im z9vz#HTj73DQo(T(VQ?b0f{DnG7(P2u27{?tZtM}l!OpJ9hRrV{$NBF25wm3PYgDsB zDBZ?haM!wF`rl@Z@%X4Rl1iIckj&6Pmvv%9+p&e3aAjL~;VZ9fkaxl3QuajDx zQRBkdlN<$b0ui_{LB?I!+2bX_8#1Fo+V!+SsM&ezI=#Dj(JY0E!ReJ`gI<}YSeB}Y z44Nvci@=);xXXbzEaq$azMnUx-Xh-Ouq2>R&NkC+(&h*n+}b(k8ujo8`}d&F1`gez zbe&S}>D+llB);oZ@fdGBO{z7k$>zCiLq%+Y!uZV*a?yAvI+zT_ zg8d}Q0KQ=6b4D+|Eyx0x`xdQz}e9X8XOMAU&TCbFm2f_IfEb z;fLpCD`Jn6=vf7iO8*I94*S&+s`NxkWW5v|C|#imIXEaD-iEpA!Vpx(s3d#L(5@ek zU4+_D==@4Yir7l|2^>j_S$@VxqPP5P5N3)W6bp^M+en$WO&Bm5E@Mn=w6EW+h}S*q zMIO~ek&^ucSL1Fu3~9W0Xc?bOIaVi%(JCZb-T5OE0>!r2o6;fFuNoyA5N@KcF|MNm z?RlKCMrQ(}g+Wb2I+OhL=HTr&Zz5(X&Ivoc!Q5knp6N;HyKwy0iiYmISML|^%P$1#B zmGyBlHkYmN8Z)0OJvuoqJE4^{4CrksKHANk4p5SJcsRp3jM}cE;X%v8j?mlFarGz( zf-#n6%5ny(1xOGjr9d}G5W^>;!^d8-+AlFhQ+ZB(T1IM#g_ogkMw|SvQOVD-eJK#o z0m8wq@nyjH6)0ICZz7F*G-NVaVCC@~3PW%Ov;!GIQB_4zR9$8hw^Gtf%j^SpqlF^s z>6c2$9v7}TGQ6xJexZ6kh0M*5(_P)f=WvahnGZ#$TKe=%K{5-Z2DK1U0Cfu&U3+!W0YHAB diff --git a/R/tbl_regression.R b/R/tbl_regression.R index a686b68c11..cf658397ac 100644 --- a/R/tbl_regression.R +++ b/R/tbl_regression.R @@ -55,6 +55,7 @@ #' @param tidy_fun Option to specify a particular tidier function if the #' model is not a [vetted model][vetted_models] or you need to implement a #' custom method. Default is `NULL` +#' @param add_estimate_to_reference_rows add a reference value. Default is FALSE #' @param ... Not used #' @param exclude DEPRECATED #' @param show_yesno DEPRECATED @@ -149,6 +150,10 @@ tbl_regression.default <- function(x, label = NULL, exponentiate = FALSE, conf.level %||% get_theme_element("tbl_regression-arg:conf.level") %||% getOption("gtsummary.conf.level", default = 0.95) + add_estimate_to_reference_rows <- + add_estimate_to_reference_rows %||% + get_theme_element("tbl_regression-arg:add_estimate_to_reference_rows", default = FALSE) + # checking estimate_fun and pvalue_fun are functions if (!purrr::every(list(estimate_fun, pvalue_fun, tidy_fun %||% pvalue_fun), is.function)) { diff --git a/data-raw/gtsummary_theme_elements.csv b/data-raw/gtsummary_theme_elements.csv index 924bafc645..0059908f2c 100644 --- a/data-raw/gtsummary_theme_elements.csv +++ b/data-raw/gtsummary_theme_elements.csv @@ -39,6 +39,7 @@ tbl_regression,tbl_regression-str:ref_row_text,FALSE,string indicating the text tbl_regression,tbl_regression-arg:conf.level,TRUE,, tbl_regression,tbl_regression-arg:estimate_fun ,TRUE,, tbl_regression,tbl_regression-arg:pvalue_fun ,TRUE,, +tbl_regression,tbl_regression-arg:add_estimate_to_reference_rows,TRUE,, tbl_regression,tbl_regression-arg:tidy_fun ,TRUE,, tbl_stack,tbl_stack-str:group_header,FALSE,"string indicating the group column header used in `as_tibble()`, `as_flex_table()`, etc. where row headers are not supported; default is `""**Group**""`","""**Group Status**""" tbl_summary,tbl_summary-fn:N_fun,FALSE,function to style integers. Currently questioning...THIS MAY BE REMOVED IN A FUTURE RELEASE. Use `style_number-arg:big.mark` and `style_number-arg:decimal.mark` instead.,"function(x) sprintf(""%.0f"", x)" From 3997b5816f4861e41460628e92df469ddb43644b Mon Sep 17 00:00:00 2001 From: ddsjoberg Date: Sun, 8 Nov 2020 01:11:28 -0500 Subject: [PATCH 16/17] ref row estimate update --- R/tbl_regression.R | 1 - R/tbl_uvregression.R | 3 ++- man/tbl_regression.Rd | 2 +- man/tbl_uvregression.Rd | 3 +++ 4 files changed, 6 insertions(+), 3 deletions(-) diff --git a/R/tbl_regression.R b/R/tbl_regression.R index cf658397ac..61423aa320 100644 --- a/R/tbl_regression.R +++ b/R/tbl_regression.R @@ -59,7 +59,6 @@ #' @param ... Not used #' @param exclude DEPRECATED #' @param show_yesno DEPRECATED -#' @inheritParams broom.helpers::tidy_plus_plus #' @author Daniel D. Sjoberg #' @seealso See tbl_regression \href{http://www.danieldsjoberg.com/gtsummary/articles/tbl_regression.html}{vignette} for detailed examples #' @family tbl_regression tools diff --git a/R/tbl_uvregression.R b/R/tbl_uvregression.R index 159a2584ca..693a1a2455 100644 --- a/R/tbl_uvregression.R +++ b/R/tbl_uvregression.R @@ -83,6 +83,7 @@ tbl_uvregression <- function(data, method, y = NULL, x = NULL, method.args = NUL include = everything(), tidy_fun = NULL, hide_n = FALSE, show_single_row = NULL, conf.level = NULL, estimate_fun = NULL, pvalue_fun = NULL, formula = "{y} ~ {x}", + add_estimate_to_reference_rows = NULL, show_yesno = NULL, exclude = NULL) { # deprecated arguments ------------------------------------------------------- if (!is.null(show_yesno)) { @@ -256,7 +257,7 @@ tbl_uvregression <- function(data, method, y = NULL, x = NULL, method.args = NUL # building regression models ------------------------------------------------- tbl_reg_args <- c("exponentiate", "conf.level", "label", "include", "show_single_row", - "tidy_fun", "estimate_fun", "pvalue_fun") + "tidy_fun", "estimate_fun", "pvalue_fun", "add_estimate_to_reference_rows") df_model <- tibble( diff --git a/man/tbl_regression.Rd b/man/tbl_regression.Rd index 0047efe4a9..7c762b6303 100644 --- a/man/tbl_regression.Rd +++ b/man/tbl_regression.Rd @@ -65,7 +65,7 @@ and return a string that is the rounded/formatted p-value (e.g. model is not a \link[=vetted_models]{vetted model} or you need to implement a custom method. Default is \code{NULL}} -\item{add_estimate_to_reference_rows}{should an estimate value be added to reference rows?} +\item{add_estimate_to_reference_rows}{add a reference value. Default is FALSE} \item{show_yesno}{DEPRECATED} diff --git a/man/tbl_uvregression.Rd b/man/tbl_uvregression.Rd index c095033477..3e9f0eff78 100644 --- a/man/tbl_uvregression.Rd +++ b/man/tbl_uvregression.Rd @@ -20,6 +20,7 @@ tbl_uvregression( estimate_fun = NULL, pvalue_fun = NULL, formula = "{y} ~ {x}", + add_estimate_to_reference_rows = NULL, show_yesno = NULL, exclude = NULL ) @@ -83,6 +84,8 @@ Uses \link[glue:glue]{glue::glue} syntax. Default is \code{"{y} ~ {x}"}, where \ is the dependent variable, and \code{{x}} represents a single covariate. For a random intercept model, the formula may be \code{formula = "{y} ~ {x} + (1 | gear)"}.} +\item{add_estimate_to_reference_rows}{add a reference value. Default is FALSE} + \item{show_yesno}{DEPRECATED} \item{exclude}{DEPRECATED} From 6dbbc585da80faabb0015d6dc80f9e1306b02ba0 Mon Sep 17 00:00:00 2001 From: Curry Date: Wed, 11 Nov 2020 11:35:35 -0500 Subject: [PATCH 17/17] change description and news #685 --- DESCRIPTION | 2 +- NEWS.md | 11 +++++++++++ 2 files changed, 12 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 99633ab812..b3388298a3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: gtsummary Title: Presentation-Ready Data Summary and Analytic Result Tables -Version: 1.3.5.9007 +Version: 1.3.5.9008 Authors@R: c(person(given = "Daniel D.", family = "Sjoberg", diff --git a/NEWS.md b/NEWS.md index 93ed172c68..768f87b0b0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,16 @@ # gtsummary (development version) +* All select helper functions and the utility functions that make them possible, have been cleaned up and migrated to broom.helpers. THIS IS A HUGE UPDATE. #648 +* Migrated all selecting functionality from gtsummary to broom.helpers. Exporting functions the functions below. Each has been improved and streamlined compared to their original versions in gtsummary. #648 #680 +* .generic_selector(): this is a function that makes it easy to create selecting functions like all_continuous(). The internals allow for it to be used in broom.helpers and gtsummary seamlessly. #680 +* .select_to_varnames(): This function converts selecting syntax into character varnames #680 +* .formula_list_to_named_list(): this function takes the formula selecting syntax used widely in gtsummary, and converts it to a named list. +* Update to use #680 broom.helpers::tidy_plus_plus() instead of the individual broom.helpers::tidy_*() functions. #692 +* Theme element has been added for controlling the other tidy_plus_plus() arguments. #692 +tbl_regression(add_estimate_to_reference_rows=) argument has been added. Added to tbl_uvregression() as well. #692 +* Theme element for tbl_regression(add_estimate_to_reference_rows=) has been added. #677 +* The argument all_continuous(continuous2=) has been removed. No deprecation messages were added...it was just cut. + * Multiple imputation models created with {mice}, and multinomial regression models created with {nnet} are now supported in `tbl_regression()` (#645) * Added warning message to users when they pass a data frame to `tbl_uvregression(data=)` with column names containing spaces or special characters ( #686)