From d1a777bcb70c2057fb1babc33dba63b9ae05aafc Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Fri, 14 Jun 2024 09:00:44 -0700 Subject: [PATCH] style --- R/ard_categorical.survey.design.R | 66 ++++++++++++++++--------------- R/ard_dichotomous.survey.design.R | 6 ++- R/ard_missing.survey.design.R | 40 +++++++++++-------- 3 files changed, 61 insertions(+), 51 deletions(-) diff --git a/R/ard_categorical.survey.design.R b/R/ard_categorical.survey.design.R index 108b6537..ec9f1cfa 100644 --- a/R/ard_categorical.survey.design.R +++ b/R/ard_categorical.survey.design.R @@ -48,8 +48,10 @@ ard_categorical.survey.design <- function(data, statistic = everything() ~ c("n", "N", "p", "p.std.error", "deff", "n_unweighted", "N_unweighted", "p_unweighted"), denominator = c("column", "row", "cell"), fmt_fn = NULL, - stat_label = everything() ~ list(p = "%", p.std.error = "SE(%)", deff = "Design Effect", - "n" = "Unweighted n", "N" = "Unweighted N", "p" = "Unweighted %"), + stat_label = everything() ~ list( + p = "%", p.std.error = "SE(%)", deff = "Design Effect", + "n" = "Unweighted n", "N" = "Unweighted N", "p" = "Unweighted %" + ), ...) { set_cli_abort_call() check_pkg_installed(pkg = "survey", reference_pkg = "cardx") @@ -84,7 +86,7 @@ ard_categorical.survey.design <- function(data, x = statistic, predicate = \(x) all(x %in% accepted_svy_stats), error_msg = c("Error in the values of the {.arg statistic} argument.", - i = "Values must be in {.val {accepted_svy_stats}}" + i = "Values must be in {.val {accepted_svy_stats}}" ) ) denominator <- arg_match(denominator) @@ -143,7 +145,7 @@ ard_categorical.survey.design <- function(data, dplyr::mutate( across( c(cards::all_ard_groups("levels"), cards::all_ard_variables("levels")), - ~map(.x, as.character) + ~ map(.x, as.character) ) ) |> dplyr::select(-c("stat_label", "fmt_fn", "warning", "error")) |> @@ -176,7 +178,7 @@ ard_categorical.survey.design <- function(data, context = "categorical", warning = list(NULL), error = list(NULL), - ) |> + ) |> cards::tidy_ard_column_order() %>% {structure(., class = c("card", class(.)))} |> # styler: off cards::tidy_ard_row_order() @@ -301,9 +303,9 @@ ard_categorical.survey.design <- function(data, ), name = str_remove_all(.data$name, "se\\.") %>% - str_remove_all("DEff\\.") %>% - str_remove_all(by) %>% - str_remove_all("`") + str_remove_all("DEff\\.") %>% + str_remove_all(by) %>% + str_remove_all("`") ) |> tidyr::pivot_wider(names_from = "stat", values_from = "value") |> set_names(c("variable_level", "group1_level", "p", "p.std.error", "deff")) |> @@ -334,9 +336,9 @@ ard_categorical.survey.design <- function(data, ), name = str_remove_all(.data$name, "se\\.") %>% - str_remove_all("DEff\\.") %>% - str_remove_all(variable) %>% - str_remove_all("`") + str_remove_all("DEff\\.") %>% + str_remove_all(variable) %>% + str_remove_all("`") ) |> tidyr::pivot_wider(names_from = "stat", values_from = "value") |> set_names(c("group1_level", "variable_level", "p", "p.std.error", "deff")) |> @@ -378,27 +380,27 @@ ard_categorical.survey.design <- function(data, # add big N and p, then return data frame of results switch(denominator, - "column" = - df_counts |> - dplyr::mutate( - .by = any_of("group1_level"), - N = sum(.data$n), - p = .data$n / .data$N - ), - "row" = - df_counts |> - dplyr::mutate( - .by = any_of("variable_level"), - N = sum(.data$n), - p = .data$n / .data$N - ), - "cell" = - df_counts |> - dplyr::mutate( - .by = any_of(c("group1_level", "variable_level")), - N = sum(.data$n), - p = .data$n / .data$N - ) + "column" = + df_counts |> + dplyr::mutate( + .by = any_of("group1_level"), + N = sum(.data$n), + p = .data$n / .data$N + ), + "row" = + df_counts |> + dplyr::mutate( + .by = any_of("variable_level"), + N = sum(.data$n), + p = .data$n / .data$N + ), + "cell" = + df_counts |> + dplyr::mutate( + .by = any_of(c("group1_level", "variable_level")), + N = sum(.data$n), + p = .data$n / .data$N + ) ) } diff --git a/R/ard_dichotomous.survey.design.R b/R/ard_dichotomous.survey.design.R index 53cc8bd6..dd96f2b3 100644 --- a/R/ard_dichotomous.survey.design.R +++ b/R/ard_dichotomous.survey.design.R @@ -21,8 +21,10 @@ ard_dichotomous.survey.design <- function(data, statistic = everything() ~ c("n", "N", "p", "p.std.error", "deff", "n_unweighted", "N_unweighted", "p_unweighted"), denominator = c("column", "row", "cell"), fmt_fn = NULL, - stat_label = everything() ~ list(p = "%", p.std.error = "SE(%)", deff = "Design Effect", - "n" = "Unweighted n", "N" = "Unweighted N", "p" = "Unweighted %"), + stat_label = everything() ~ list( + p = "%", p.std.error = "SE(%)", deff = "Design Effect", + "n" = "Unweighted n", "N" = "Unweighted N", "p" = "Unweighted %" + ), ...) { set_cli_abort_call() check_dots_empty() diff --git a/R/ard_missing.survey.design.R b/R/ard_missing.survey.design.R index 09f53d53..40d7613f 100644 --- a/R/ard_missing.survey.design.R +++ b/R/ard_missing.survey.design.R @@ -15,21 +15,25 @@ ard_missing.survey.design <- function(data, variables, by = NULL, statistic = - everything() ~ c("N_obs", "N_miss", "N_nonmiss", "p_miss", "p_nonmiss", - "N_obs_unweighted", "N_miss_unweighted", "N_nonmiss_unweighted", - "p_miss_unweighted", "p_nonmiss_unweighted"), + everything() ~ c( + "N_obs", "N_miss", "N_nonmiss", "p_miss", "p_nonmiss", + "N_obs_unweighted", "N_miss_unweighted", "N_nonmiss_unweighted", + "p_miss_unweighted", "p_nonmiss_unweighted" + ), fmt_fn = NULL, stat_label = - everything() ~ list(N_obs = "Total N", - N_miss = "N Missing", - N_nonmiss = "N not Missing", - p_miss = "% Missing", - p_nonmiss = "% not Missing", - N_obs_unweighted = "Total N (unweighted)", - N_miss_unweighted = "N Missing (unweighted)", - N_nonmiss_unweighted = "N not Missing (unweighted)", - p_miss_unweighted = "% Missing (unweighted)", - p_nonmiss_unweighted = "% not Missing (unweighted)"), + everything() ~ list( + N_obs = "Total N", + N_miss = "N Missing", + N_nonmiss = "N not Missing", + p_miss = "% Missing", + p_nonmiss = "% not Missing", + N_obs_unweighted = "Total N (unweighted)", + N_miss_unweighted = "N Missing (unweighted)", + N_nonmiss_unweighted = "N not Missing (unweighted)", + p_miss_unweighted = "% Missing (unweighted)", + p_nonmiss_unweighted = "% not Missing (unweighted)" + ), ...) { set_cli_abort_call() check_dots_empty() @@ -58,9 +62,11 @@ ard_missing.survey.design <- function(data, statistic = formals(asNamespace("cards")[["ard_missing.survey.design"]])[["statistic"]] |> eval() ) - stats_available <- c("N_obs", "N_miss", "N_nonmiss", "p_miss", "p_nonmiss", - "N_obs_unweighted", "N_miss_unweighted", "N_nonmiss_unweighted", - "p_miss_unweighted", "p_nonmiss_unweighted") + stats_available <- c( + "N_obs", "N_miss", "N_nonmiss", "p_miss", "p_nonmiss", + "N_obs_unweighted", "N_miss_unweighted", "N_nonmiss_unweighted", + "p_miss_unweighted", "p_nonmiss_unweighted" + ) cards::check_list_elements( x = statistic, predicate = \(x) is.character(x) && all(x %in% stats_available), @@ -115,7 +121,7 @@ ard_missing.survey.design <- function(data, # return final object -------------------------------------------------------- result |> - dplyr::mutate(context = "missing") |> + dplyr::mutate(context = "missing") |> cards::tidy_ard_column_order() %>% {structure(., class = c("card", class(.)))} # styler: off }