Nothing
#' ARD survey continuous CIs
#'
#' One-sample confidence intervals for continuous variables' means and medians.
#' Confidence limits are calculated with `survey::svymean()` and `survey::svyquantile()`.
#'
#'
#' @inheritParams ard_continuous.survey.design
#' @param method (`string`)\cr
#' Method for confidence interval calculation.
#' When `"svymean"`, the calculation is computed via `survey::svymean()`.
#' Otherwise, it is calculated via`survey::svyquantile(interval.type=method)`
#' @param conf.level (scalar `numeric`)\cr
#' confidence level for confidence interval. Default is `0.95`.
#' @param df (`numeric`)\cr
#' denominator degrees of freedom, passed to `survey::confint(df)`.
#' Default is `survey::degf(data)`.
#' @param ... arguments passed to `survey::confint()`
#'
#' @return ARD data frame
#' @export
#'
#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "survey", reference_pkg = "cardx"))
#' data(api, package = "survey")
#' dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc)
#'
#' ard_continuous_ci(dclus1, variables = api00)
#' ard_continuous_ci(dclus1, variables = api00, method = "svymedian.xlogit")
ard_continuous_ci.survey.design <- function(data,
variables,
by = NULL,
method = c("svymean", "svymedian.mean", "svymedian.beta", "svymedian.xlogit", "svymedian.asin", "svymedian.score"),
conf.level = 0.95,
df = survey::degf(data),
...) {
set_cli_abort_call()
# check inputs ---------------------------------------------------------------
check_not_missing(data)
check_class(data, "survey.design")
check_not_missing(variables)
cards::process_selectors(
data = data$variables,
variables = {{ variables }},
by = {{ by }}
)
check_scalar(by, allow_empty = TRUE)
check_scalar_range(conf.level, range = c(0, 1))
method <- arg_match(method)
walk(
variables,
\(variable) {
if (!is.numeric(data$variables[[variable]])) {
cli::cli_inform(
"Column {.val {variable}} is not {.cls numeric} and results may be an unexpected format."
)
}
}
)
# return empty ARD if no variables selected ----------------------------------
if (is_empty(variables)) {
return(dplyr::tibble() |> cards::as_card())
}
# calculate and return ARD of one sample CI ----------------------------------
.calculate_ard_continuous_survey_ci(
FUN = ifelse(method == "svymean", .svymean_confint_wrapper, .svyquantile_confint_wrapper),
data = data,
variables = variables,
by = by,
conf.level = conf.level,
method = method,
df = df,
...
)
}
.calculate_ard_continuous_survey_ci <- function(FUN, data, variables, by, conf.level, ...) {
# calculate results ----------------------------------------------------------
map(
variables,
function(variable) {
.calculate_one_ard_continuous_survey_ci(
FUN = FUN,
data = data,
variable = variable,
by = by,
conf.level = conf.level,
...
)
}
) |>
dplyr::bind_rows()
}
.calculate_one_ard_continuous_survey_ci <- function(FUN, data, variable, by, conf.level, ...) {
if (!is_empty(by)) {
by_levels <- .unique_values_sort(data$variables, variable = by)
lst_data <-
map(
by_levels,
~ call2("subset", expr(data), expr(!!sym(by) == !!.x)) |> eval()
) |>
set_names(as.character(by_levels))
}
df_full <-
case_switch(
!is_empty(by) ~
tidyr::expand_grid(
group1_level = as.character(by_levels) |> as.list()
) |>
dplyr::mutate(group1 = .env$by, variable = .env$variable),
.default =
dplyr::tibble(variable = .env$variable)
) |>
dplyr::rowwise() |>
dplyr::mutate(
lst_result =
FUN(
data =
case_switch(
is_empty(.env$by) ~ data,
.default = lst_data[[.data$group1_level]]
),
variable = .data$variable,
conf.level = .env$conf.level,
...
) |>
list(),
result =
.data$lst_result[["result"]] |>
enframe("stat_name", "stat") |>
list(),
warning = .data$lst_result["warning"] |> unname(),
error = .data$lst_result["error"] |> unname(),
context = "survey_continuous_ci"
) |>
dplyr::select(-"lst_result") |>
dplyr::ungroup() |>
tidyr::unnest("result") |>
dplyr::mutate(
stat_label = .data$stat_name,
fmt_fn = map(.data$stat, ~ case_switch(is.numeric(.x) ~ 2L, .default = as.character))
) |>
cards::as_card() |>
cards::tidy_ard_column_order()
}
.svymean_confint_wrapper <- function(data, variable, conf.level, df, ...) {
lst_results <-
cards::eval_capture_conditions({
svymean <-
survey::svymean(x = reformulate2(variable), design = data, na.rm = TRUE)
lst_svymean <- as.data.frame(svymean) |>
as.list() |>
set_names(c("estimate", "std.error"))
lst_confint <- stats::confint(svymean, level = conf.level, df = df, ...) |>
as.data.frame() |>
as.list() |>
set_names(c("conf.low", "conf.high"))
c(lst_svymean, lst_confint)
})
# add NULL results if error
if (is_empty(lst_results[["result"]])) {
lst_results[["result"]] <- rep_named(c("estimate", "std.error", "conf.low", "conf.high"), list(NULL))
}
# add other args
lst_results[["result"]] <- lst_results[["result"]] |> append(list(conf.level = conf.level))
# return list result
lst_results
}
.svyquantile_confint_wrapper <- function(data, variable, conf.level, method, df, ...) {
lst_results <-
cards::eval_capture_conditions({
svyquantile <-
survey::svyquantile(
x = reformulate2(variable), design = data, quantiles = 0.5,
na.rm = TRUE, interval.type = str_remove(method, pattern = "^svymedian\\.")
)
lst_svyquantile <- svyquantile |>
getElement(1L) |>
as.data.frame() |>
dplyr::select(1L, last_col()) |>
as.list() |>
set_names(c("estimate", "std.error"))
lst_confint <- stats::confint(svyquantile, level = conf.level, df = df, ...) |>
as.data.frame() |>
as.list() |>
set_names(c("conf.low", "conf.high"))
c(lst_svyquantile, lst_confint)
})
# add NULL results if error
if (is_empty(lst_results[["result"]])) {
lst_results[["result"]] <- rep_named(c("estimate", "std.error", "conf.low", "conf.high"), list(NULL))
}
# add other args
lst_results[["result"]] <- lst_results[["result"]] |> append(list(conf.level = conf.level))
# return list result
lst_results
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.