diff --git a/R/bal_ess.R b/R/bal_ess.R index 95fe85c..a247466 100644 --- a/R/bal_ess.R +++ b/R/bal_ess.R @@ -21,7 +21,7 @@ #' * If ESS is much lower than the total sample size, consider investigating #' why some weights are extremely large or small #' -#' @param .wts A numeric vector of weights or a single weight column from a data frame. +#' @param .weights A numeric vector of weights or a single weight column from a data frame. #' @inheritParams balance_params #' #' @return A single numeric value representing the effective sample size. @@ -43,7 +43,7 @@ #' bal_ess(weights_with_na, na.rm = TRUE) #' #' @export -bal_ess <- function(.wts, na.rm = FALSE) { +bal_ess <- function(.weights, na.rm = FALSE) { # Simply call the existing ess() function - ess(.wts, na.rm = na.rm) + ess(.weights, na.rm = na.rm) } diff --git a/R/bal_model_auc.R b/R/bal_model_auc.R index 54e3098..6ea4c39 100644 --- a/R/bal_model_auc.R +++ b/R/bal_model_auc.R @@ -15,9 +15,9 @@ #' balance. #' #' @param .data A data frame containing the variables. -#' @param .truth The treatment/outcome variable (unquoted). +#' @param .exposure The treatment/outcome variable (unquoted). #' @param .estimate The propensity score or fitted values (unquoted). -#' @param .wts Optional single weight variable (unquoted). If NULL, computes +#' @param .weights Optional single weight variable (unquoted). If NULL, computes #' unweighted AUC. #' @inheritParams balance_params #' @inheritParams treatment_param @@ -39,25 +39,25 @@ #' @export bal_model_auc <- function( .data, - .truth, + .exposure, .estimate, - .wts = NULL, + .weights = NULL, na.rm = TRUE, - treatment_level = NULL + .focal_level = NULL ) { validate_data_frame(.data, call = rlang::caller_env()) - truth_quo <- rlang::enquo(.truth) + exposure_quo <- rlang::enquo(.exposure) estimate_quo <- rlang::enquo(.estimate) - wts_quo <- rlang::enquo(.wts) + wts_quo <- rlang::enquo(.weights) # Extract column names - truth_name <- names(tidyselect::eval_select(truth_quo, .data)) + exposure_name <- names(tidyselect::eval_select(exposure_quo, .data)) estimate_name <- names(tidyselect::eval_select(estimate_quo, .data)) - if (length(truth_name) != 1) { + if (length(exposure_name) != 1) { abort( - "{.arg .truth} must select exactly one variable", + "{.arg .exposure} must select exactly one variable", error_class = "halfmoon_arg_error", call = rlang::current_env() ) @@ -71,7 +71,7 @@ bal_model_auc <- function( } # Extract data - truth <- .data[[truth_name]] + exposure <- .data[[exposure_name]] estimate <- .data[[estimate_name]] # Handle weights if provided @@ -80,7 +80,7 @@ bal_model_auc <- function( weight_vars <- names(tidyselect::eval_select(wts_quo, .data)) if (length(weight_vars) != 1) { abort( - "{.arg .wts} must select exactly one variable or be NULL", + "{.arg .weights} must select exactly one variable or be NULL", error_class = "halfmoon_arg_error", call = rlang::current_env() ) @@ -91,20 +91,20 @@ bal_model_auc <- function( # Handle missing values if (na.rm) { if (is.null(weights)) { - complete_cases <- stats::complete.cases(truth, estimate) + complete_cases <- stats::complete.cases(exposure, estimate) } else { - complete_cases <- stats::complete.cases(truth, estimate, weights) + complete_cases <- stats::complete.cases(exposure, estimate, weights) } - truth <- truth[complete_cases] + exposure <- exposure[complete_cases] estimate <- estimate[complete_cases] if (!is.null(weights)) { weights <- weights[complete_cases] } } else { if (is.null(weights)) { - na_present <- any(is.na(truth)) || any(is.na(estimate)) + na_present <- any(is.na(exposure)) || any(is.na(estimate)) } else { - na_present <- any(is.na(truth)) || + na_present <- any(is.na(exposure)) || any(is.na(estimate)) || any(is.na(weights)) } @@ -115,10 +115,10 @@ bal_model_auc <- function( # Compute ROC curve roc_data <- compute_roc_curve_imp( - truth, + exposure, estimate, weights = weights, - treatment_level = treatment_level, + .focal_level = .focal_level, call = rlang::current_env() ) diff --git a/R/bal_model_roc_curve.R b/R/bal_model_roc_curve.R index 803a6b4..a69e5fd 100644 --- a/R/bal_model_roc_curve.R +++ b/R/bal_model_roc_curve.R @@ -16,9 +16,9 @@ #' inadequate balance. #' #' @param .data A data frame containing the variables. -#' @param .truth The treatment/outcome variable (unquoted). +#' @param .exposure The treatment/outcome variable (unquoted). #' @param .estimate The propensity score or fitted values (unquoted). -#' @param .wts Optional single weight variable (unquoted). If NULL, computes +#' @param .weights Optional single weight variable (unquoted). If NULL, computes #' unweighted ROC curve. #' @inheritParams balance_params #' @inheritParams treatment_param @@ -42,25 +42,25 @@ #' @export bal_model_roc_curve <- function( .data, - .truth, + .exposure, .estimate, - .wts = NULL, + .weights = NULL, na.rm = TRUE, - treatment_level = NULL + .focal_level = NULL ) { validate_data_frame(.data, call = rlang::caller_env()) - truth_quo <- rlang::enquo(.truth) + exposure_quo <- rlang::enquo(.exposure) estimate_quo <- rlang::enquo(.estimate) - wts_quo <- rlang::enquo(.wts) + wts_quo <- rlang::enquo(.weights) # Extract column names - truth_name <- names(tidyselect::eval_select(truth_quo, .data)) + exposure_name <- names(tidyselect::eval_select(exposure_quo, .data)) estimate_name <- names(tidyselect::eval_select(estimate_quo, .data)) - if (length(truth_name) != 1) { + if (length(exposure_name) != 1) { abort( - "{.arg .truth} must select exactly one variable", + "{.arg .exposure} must select exactly one variable", error_class = "halfmoon_arg_error", call = rlang::current_env() ) @@ -74,7 +74,7 @@ bal_model_roc_curve <- function( } # Extract data - truth <- .data[[truth_name]] + exposure <- .data[[exposure_name]] estimate <- .data[[estimate_name]] # Handle weights if provided @@ -83,7 +83,7 @@ bal_model_roc_curve <- function( weight_vars <- names(tidyselect::eval_select(wts_quo, .data)) if (length(weight_vars) != 1) { abort( - "{.arg .wts} must select exactly one variable or be NULL", + "{.arg .weights} must select exactly one variable or be NULL", error_class = "halfmoon_arg_error", call = rlang::current_env() ) @@ -94,20 +94,20 @@ bal_model_roc_curve <- function( # Handle missing values if (na.rm) { if (is.null(weights)) { - complete_cases <- stats::complete.cases(truth, estimate) + complete_cases <- stats::complete.cases(exposure, estimate) } else { - complete_cases <- stats::complete.cases(truth, estimate, weights) + complete_cases <- stats::complete.cases(exposure, estimate, weights) } - truth <- truth[complete_cases] + exposure <- exposure[complete_cases] estimate <- estimate[complete_cases] if (!is.null(weights)) { weights <- weights[complete_cases] } } else { if (is.null(weights)) { - na_present <- any(is.na(truth)) || any(is.na(estimate)) + na_present <- any(is.na(exposure)) || any(is.na(estimate)) } else { - na_present <- any(is.na(truth)) || + na_present <- any(is.na(exposure)) || any(is.na(estimate)) || any(is.na(weights)) } @@ -122,10 +122,10 @@ bal_model_roc_curve <- function( # Compute and return ROC curve compute_roc_curve_imp( - truth, + exposure, estimate, weights = weights, - treatment_level = treatment_level, + .focal_level = .focal_level, call = rlang::current_env() ) } diff --git a/R/bal_prognostic_score.R b/R/bal_prognostic_score.R index 7cd85a1..1a26f84 100644 --- a/R/bal_prognostic_score.R +++ b/R/bal_prognostic_score.R @@ -27,19 +27,19 @@ #' @param .data A data frame containing the variables for analysis #' @param outcome The outcome variable. Can be specified as a bare name or #' character string. Ignored if `formula` is provided. -#' @param covariates Variables to include in the outcome model. Defaults to +#' @param .covariates Variables to include in the outcome model. Defaults to #' `everything()` which includes all variables except the outcome and treatment. #' Supports tidyselect syntax. Ignored if `formula` is provided. -#' @param treatment The treatment variable. Can be specified as a bare name or +#' @param .exposure The treatment variable. Can be specified as a bare name or #' character string. #' @param formula Optional formula for the outcome model. If provided, `outcome` -#' and `covariates` arguments are ignored. The formula should not include the +#' and `.covariates` arguments are ignored. The formula should not include the #' treatment variable. -#' @param treatment_level The level of treatment that represents the control group. +#' @param .reference_level The level of treatment that represents the control group. #' If NULL (default), the first level is used as control. #' @param family A family object for the GLM. Defaults to `gaussian()` for #' continuous outcomes. Use `binomial()` for binary outcomes. -#' @param weights Optional weights for the outcome model. Can be a numeric vector +#' @param .weights Optional weights for the outcome model. Can be a numeric vector #' or bare name of a variable in `.data`. #' @param na.rm Logical. Should missing values be removed? Defaults to FALSE. #' @param ... Additional arguments passed to `glm()`. @@ -57,27 +57,27 @@ #' prog_scores <- bal_prognostic_score( #' nhefs_weights, #' outcome = wt82_71, -#' treatment = qsmk, -#' covariates = c(age, sex, race, wt71) +#' .exposure = qsmk, +#' .covariates = c(age, sex, race, wt71) #' ) #' #' # Using formula interface #' prog_scores_formula <- bal_prognostic_score( #' nhefs_weights, -#' treatment = qsmk, +#' .exposure = qsmk, #' formula = wt82_71 ~ age + sex + race + wt71 + I(age^2) #' ) #' #' # Add to data and check balance #' nhefs_with_prog <- nhefs_weights #' nhefs_with_prog$prog_score <- prog_scores -#' check_balance(nhefs_with_prog, prog_score, qsmk, .wts = w_ate) +#' check_balance(nhefs_with_prog, prog_score, qsmk, .weights = w_ate) #' #' # For binary outcome #' prog_scores_binary <- bal_prognostic_score( #' nhefs_weights, #' outcome = death, -#' treatment = qsmk, +#' .exposure = qsmk, #' family = binomial() #' ) #' @@ -87,20 +87,20 @@ bal_prognostic_score <- function( .data, outcome = NULL, - covariates = everything(), - treatment, + .covariates = everything(), + .exposure, formula = NULL, - treatment_level = NULL, + .reference_level = NULL, family = gaussian(), - weights = NULL, + .weights = NULL, na.rm = FALSE, ... ) { validate_data_frame(.data) - treatment_quo <- rlang::enquo(treatment) - treatment_var <- get_column_name(treatment_quo, "treatment") - validate_column_exists(.data, treatment_var) + exposure_quo <- rlang::enquo(.exposure) + exposure_var <- get_column_name(exposure_quo, ".exposure") + validate_column_exists(.data, exposure_var) # Handle formula vs tidyselect interface if (!is.null(formula)) { @@ -118,11 +118,11 @@ bal_prognostic_score <- function( outcome_var <- formula_vars[1] # LHS of formula # Check that treatment is not in the formula - if (treatment_var %in% formula_vars) { + if (exposure_var %in% formula_vars) { abort( paste0( "The treatment variable '", - treatment_var, + exposure_var, "' should not be included in the outcome model formula." ), error_class = "halfmoon_formula_error", @@ -152,10 +152,10 @@ bal_prognostic_score <- function( validate_column_exists(.data, outcome_var) # Get covariate names - covariate_enquo <- rlang::enquo(covariates) + covariate_enquo <- rlang::enquo(.covariates) all_vars <- names(.data) - # Remove outcome and treatment from available variables for selection - available_vars <- setdiff(all_vars, c(outcome_var, treatment_var)) + # Remove outcome and exposure from available variables for selection + available_vars <- setdiff(all_vars, c(outcome_var, exposure_var)) covariate_names <- names(tidyselect::eval_select( covariate_enquo, .data[available_vars] @@ -179,12 +179,12 @@ bal_prognostic_score <- function( } # Handle weights - weights_enquo <- rlang::enquo(weights) + weights_enquo <- rlang::enquo(.weights) if (!rlang::quo_is_null(weights_enquo)) { # Try to get column name first (handles both quoted and unquoted) weights_var <- tryCatch( { - get_column_name(weights_enquo, "weights") + get_column_name(weights_enquo, ".weights") }, error = function(e) NULL ) @@ -203,19 +203,19 @@ bal_prognostic_score <- function( } # Determine control group - treatment_levels <- extract_group_levels(.data[[treatment_var]]) + exposure_levels <- extract_group_levels(.data[[exposure_var]]) control_level <- determine_reference_group( - treatment_levels, - treatment_level + exposure_levels, + .reference_level ) # Create control group indicator - is_control <- .data[[treatment_var]] == control_level + is_control <- .data[[exposure_var]] == control_level # Handle NAs if requested if (na.rm) { # Get all variables used in the model - model_vars <- unique(c(all.vars(model_formula), treatment_var)) + model_vars <- unique(c(all.vars(model_formula), exposure_var)) complete_idx <- stats::complete.cases(.data[model_vars]) if (!is.null(model_weights)) { @@ -250,7 +250,7 @@ bal_prognostic_score <- function( model_formula = model_formula, is_control = is_control, family = family, - weights = model_weights, + .weights = model_weights, ... ) @@ -262,34 +262,35 @@ bal_prognostic_fit_model <- function( model_formula, is_control, family, - weights = NULL, + .weights = NULL, ... ) { # Subset to control group for fitting control_data <- .data[is_control, ] - if (!is.null(weights)) { - control_data$.weights <- weights[is_control] + if (!is.null(.weights)) { + .weights <- .weights[is_control] } model <- tryCatch( { - if (!is.null(weights)) { - stats::glm( - formula = model_formula, - data = control_data, - family = family, - weights = .weights, - ... - ) - } else { - stats::glm( - formula = model_formula, - data = control_data, - family = family, - ... - ) + # Build arguments list for GLM + glm_args <- list( + formula = model_formula, + data = control_data, + family = family + ) + + # Add weights if provided + if (!is.null(.weights)) { + glm_args$weights <- .weights } + + # Add any additional arguments + glm_args <- c(glm_args, list(...)) + + # Use do.call to bypass non-standard evaluation + do.call(stats::glm, glm_args) }, error = function(e) { abort( diff --git a/R/bal_qq.R b/R/bal_qq.R index 64432db..80c5512 100644 --- a/R/bal_qq.R +++ b/R/bal_qq.R @@ -17,8 +17,8 @@ #' #' @param .data A data frame containing the variables. #' @param .var Variable to compute quantiles for (unquoted). -#' @param .group Column name of treatment/group variable (unquoted). -#' @param .wts Optional single weight variable (unquoted). If NULL, computes +#' @param .exposure Column name of treatment/group variable (unquoted). +#' @param .weights Optional single weight variable (unquoted). If NULL, computes #' unweighted quantiles. #' @param quantiles Numeric vector of quantiles to compute. Default is #' `seq(0.01, 0.99, 0.01)` for 99 quantiles. @@ -27,8 +27,8 @@ #' #' @return A tibble with columns: #' \item{quantile}{Numeric. The quantile probability (0-1).} -#' \item{treated_quantiles}{Numeric. The quantile value for the treatment group.} -#' \item{untreated_quantiles}{Numeric. The quantile value for the control group.} +#' \item{exposed_quantiles}{Numeric. The quantile value for the exposed group.} +#' \item{unexposed_quantiles}{Numeric. The quantile value for the unexposed group.} #' #' @family balance functions #' @seealso [check_qq()] for computing QQ data across multiple weights, @@ -39,37 +39,37 @@ #' bal_qq(nhefs_weights, age, qsmk) #' #' # Weighted QQ data -#' bal_qq(nhefs_weights, age, qsmk, .wts = w_ate) +#' bal_qq(nhefs_weights, age, qsmk, .weights = w_ate) #' #' # Custom quantiles -#' bal_qq(nhefs_weights, age, qsmk, .wts = w_ate, +#' bal_qq(nhefs_weights, age, qsmk, .weights = w_ate, #' quantiles = seq(0.1, 0.9, 0.1)) #' #' @export bal_qq <- function( .data, .var, - .group, - .wts = NULL, + .exposure, + .weights = NULL, quantiles = seq(0.01, 0.99, 0.01), - treatment_level = NULL, + .reference_level = NULL, na.rm = FALSE ) { # Handle column names var_quo <- rlang::enquo(.var) - group_quo <- rlang::enquo(.group) - wts_quo <- rlang::enquo(.wts) + exposure_quo <- rlang::enquo(.exposure) + wts_quo <- rlang::enquo(.weights) var_name <- get_column_name(var_quo, ".var") - group_name <- get_column_name(group_quo, ".group") + exposure_name <- get_column_name(exposure_quo, ".exposure") # Validate inputs validate_data_frame(.data, call = rlang::caller_env()) validate_column_exists(.data, var_name, ".var", call = rlang::caller_env()) validate_column_exists( .data, - group_name, - ".group", + exposure_name, + ".exposure", call = rlang::caller_env() ) @@ -79,7 +79,7 @@ bal_qq <- function( wt_names <- names(tidyselect::eval_select(wts_quo, .data)) if (length(wt_names) != 1) { abort( - "{.arg .wts} must select exactly one variable or be NULL", + "{.arg .weights} must select exactly one variable or be NULL", error_class = "halfmoon_arg_error", call = rlang::current_env() ) @@ -87,12 +87,16 @@ bal_qq <- function( wt_name <- wt_names[1] } - # Get group levels - group_var <- .data[[group_name]] - group_levels <- extract_group_levels(group_var) + # Get exposure levels + exposure_var <- .data[[exposure_name]] + exposure_levels <- extract_group_levels(exposure_var) - # Validate binary group - validate_binary_group(group_levels, group_name, call = rlang::caller_env()) + # Validate binary exposure + validate_binary_group( + exposure_levels, + exposure_name, + call = rlang::caller_env() + ) # Check for missing values if na.rm = FALSE if (!na.rm) { @@ -104,42 +108,42 @@ bal_qq <- function( call = rlang::current_env() ) } - if (any(is.na(group_var))) { + if (any(is.na(exposure_var))) { abort( - "Group variable {.code {group_name}} contains missing values and {.arg na.rm = FALSE}", + "Exposure variable {.code {exposure_name}} contains missing values and {.arg na.rm = FALSE}", error_class = "halfmoon_na_error", call = rlang::current_env() ) } } - # Handle NULL treatment_level - use same logic as check_qq - if (is.null(treatment_level)) { - if (is.factor(group_var)) { + # Handle NULL .reference_level - use same logic as check_qq + if (is.null(.reference_level)) { + if (is.factor(exposure_var)) { # For factors, use the last level - treatment_level <- group_levels[length(group_levels)] + .reference_level <- exposure_levels[length(exposure_levels)] } else { # For numeric, use the maximum value - treatment_level <- max(group_levels) + .reference_level <- max(exposure_levels) } } - # Validate treatment_level exists - if (!treatment_level %in% group_levels) { + # Validate .reference_level exists + if (!.reference_level %in% exposure_levels) { abort( - "{.arg treatment_level} '{treatment_level}' not found in {.arg .group} levels: {.val {group_levels}}", + "{.arg .reference_level} '{(.reference_level)}' not found in {.arg .exposure} levels: {.val {exposure_levels}}", error_class = "halfmoon_reference_error", call = rlang::current_env() ) } - # Use treatment_level as reference group (same as check_qq) - ref_group <- treatment_level - comp_group <- setdiff(group_levels, treatment_level) + # Use .reference_level as reference group (same as check_qq) + ref_group <- .reference_level + comp_group <- setdiff(exposure_levels, .reference_level) # Filter data by group - ref_data <- .data[group_var == ref_group, ] - comp_data <- .data[group_var == comp_group, ] + ref_data <- .data[exposure_var == ref_group, ] + comp_data <- .data[exposure_var == comp_group, ] if (na.rm) { ref_data <- ref_data[!is.na(ref_data[[var_name]]), ] @@ -165,14 +169,14 @@ bal_qq <- function( comp_wts <- comp_wts[!is.na(comp_data[[var_name]])] } - ref_q <- weighted_quantile(ref_vals, quantiles, .wts = ref_wts) - comp_q <- weighted_quantile(comp_vals, quantiles, .wts = comp_wts) + ref_q <- weighted_quantile(ref_vals, quantiles, .weights = ref_wts) + comp_q <- weighted_quantile(comp_vals, quantiles, .weights = comp_wts) } # Return tibble tibble::tibble( quantile = quantiles, - treated_quantiles = ref_q, - untreated_quantiles = comp_q + exposed_quantiles = ref_q, + unexposed_quantiles = comp_q ) } diff --git a/R/check_balance.R b/R/check_balance.R index 6302793..2b31735 100644 --- a/R/check_balance.R +++ b/R/check_balance.R @@ -34,7 +34,7 @@ #' Available options: "smd" (standardized mean difference), "vr" (variance ratio), #' "ks" (Kolmogorov-Smirnov), "correlation" (for continuous exposures), #' "energy" (multivariate energy distance). Defaults to c("smd", "vr", "ks", "energy"). -#' @param reference_group The reference group level to use for comparisons. +#' @param .reference_level The reference group level to use for comparisons. #' Defaults to 1 (first level). #' @inheritParams balance_params #' @param make_dummy_vars Logical. Transform categorical variables to dummy @@ -61,21 +61,21 @@ #' #' @examples #' # Basic usage with binary exposure -#' check_balance(nhefs_weights, c(age, wt71), qsmk, .wts = c(w_ate, w_att)) +#' check_balance(nhefs_weights, c(age, wt71), qsmk, .weights = c(w_ate, w_att)) #' #' # With specific metrics only #' check_balance(nhefs_weights, c(age, wt71), qsmk, .metrics = c("smd", "energy")) #' #' # Categorical exposure #' check_balance(nhefs_weights, c(age, wt71), alcoholfreq_cat, -#' .wts = c(w_cat_ate, w_cat_att_2_3wk)) +#' .weights = c(w_cat_ate, w_cat_att_2_3wk)) #' #' # Specify reference group for categorical exposure #' check_balance(nhefs_weights, c(age, wt71, sex), alcoholfreq_cat, -#' reference_group = "daily", .metrics = c("smd", "vr")) +#' .reference_level = "daily", .metrics = c("smd", "vr")) #' #' # Exclude observed results -#' check_balance(nhefs_weights, c(age, wt71), qsmk, .wts = w_ate, +#' check_balance(nhefs_weights, c(age, wt71), qsmk, .weights = w_ate, #' include_observed = FALSE) #' #' # Use correlation for continuous exposure @@ -90,11 +90,11 @@ check_balance <- function( .data, .vars, - .group, - .wts = NULL, + .exposure, + .weights = NULL, .metrics = c("smd", "vr", "ks", "energy"), include_observed = TRUE, - reference_group = 1L, + .reference_level = 1L, na.rm = FALSE, make_dummy_vars = TRUE, squares = FALSE, @@ -104,7 +104,7 @@ check_balance <- function( validate_data_frame(.data) # Convert inputs to character vectors for consistent handling - group_var <- rlang::as_name(rlang::enquo(.group)) + exposure_var <- rlang::as_name(rlang::enquo(.exposure)) var_names <- names(tidyselect::eval_select(rlang::enquo(.vars), .data)) if (length(var_names) == 0) { @@ -253,43 +253,43 @@ check_balance <- function( } # Handle weights using proper NSE - capture quosure and check if null - .wts <- rlang::enquo(.wts) - if (!rlang::quo_is_null(.wts)) { - wts_names <- names(tidyselect::eval_select(.wts, .data)) + .weights <- rlang::enquo(.weights) + if (!rlang::quo_is_null(.weights)) { + wts_names <- names(tidyselect::eval_select(.weights, .data)) } else { wts_names <- NULL } - # Validate group variable - validate_column_exists(transformed_data, group_var, "data") + # Validate exposure variable + validate_column_exists(transformed_data, exposure_var, "data") # Get group levels in proper order - # For correlation, we allow continuous group variables + # For correlation, we allow continuous exposure variables using_correlation <- "correlation" %in% .metrics - if (is.factor(transformed_data[[group_var]])) { - group_levels <- levels(transformed_data[[group_var]]) + if (is.factor(transformed_data[[exposure_var]])) { + group_levels <- levels(transformed_data[[exposure_var]]) } else { - group_levels <- transformed_data[[group_var]] |> + group_levels <- transformed_data[[exposure_var]] |> stats::na.omit() |> unique() |> sort() } - # Check group variable requirements based on metrics + # Check exposure variable requirements based on metrics only_correlation <- length(setdiff(.metrics, "correlation")) == 0 # Check for single-level groups if (length(group_levels) < 2 && !only_correlation) { abort( - "Group variable must have at least two levels for metrics: {.val {setdiff(.metrics, 'correlation')}}. Got {length(group_levels)} level{?s}.", + "Exposure variable must have at least two levels for metrics: {.val {setdiff(.metrics, 'correlation')}}. Got {length(group_levels)} level{?s}.", error_class = "halfmoon_group_error" ) } - if (using_correlation && !is.numeric(transformed_data[[group_var]])) { + if (using_correlation && !is.numeric(transformed_data[[exposure_var]])) { abort( - "Group variable must be numeric when using correlation metric", + "Exposure variable must be numeric when using correlation metric", error_class = "halfmoon_type_error" ) } @@ -327,7 +327,7 @@ check_balance <- function( if (length(methods) == 0) { abort( - "No methods to compute. Either set {.arg include_observed = TRUE} or provide {.arg .wts}", + "No methods to compute. Either set {.arg include_observed = TRUE} or provide {.arg .weights}", error_class = "halfmoon_arg_error" ) } @@ -368,9 +368,9 @@ check_balance <- function( .data = .data, metric_functions = metric_functions, transformed_data = transformed_data, - group_var = group_var, + exposure_var = exposure_var, na.rm = na.rm, - reference_group = reference_group, + .reference_level = .reference_level, group_levels = group_levels, var_names = var_names ) @@ -394,9 +394,9 @@ compute_single_balance_metric <- function( .data, metric_functions, transformed_data, - group_var, + exposure_var, na.rm, - reference_group, + .reference_level, group_levels, var_names ) { @@ -415,49 +415,49 @@ compute_single_balance_metric <- function( { if (metric == "energy") { # For energy, use all variables - group_data <- transformed_data[[group_var]] + group_data <- transformed_data[[exposure_var]] covariates_data <- transformed_data[var_names] estimate <- compute_fn( - covariates = covariates_data, - group = group_data, - weights = weights_data, + .covariates = covariates_data, + .exposure = group_data, + .weights = weights_data, na.rm = na.rm ) } else if (metric == "correlation") { - # For correlation, use the group variable as the second variable + # For correlation, use the exposure variable as the second variable var_data <- transformed_data[[variable]] - group_data <- transformed_data[[group_var]] + group_data <- transformed_data[[exposure_var]] estimate <- compute_fn( - x = var_data, - y = group_data, - weights = weights_data, + .x = var_data, + .y = group_data, + .weights = weights_data, na.rm = na.rm ) } else { # For other metrics (smd, vr, ks) var_data <- transformed_data[[variable]] - group_data <- transformed_data[[group_var]] + group_data <- transformed_data[[exposure_var]] # Handle reference group parameter based on the function ref_group_param <- if (metric == "smd") { # bal_smd accepts both indices and group values - reference_group + .reference_level } else { # bal_vr and bal_ks expect actual group values - # Always treat numeric reference_group as index for consistency - if (is.numeric(reference_group) && length(reference_group) == 1) { - group_levels[reference_group] + # Always treat numeric .reference_level as index for consistency + if (is.numeric(.reference_level) && length(.reference_level) == 1) { + group_levels[.reference_level] } else { - reference_group + .reference_level } } estimate <- compute_fn( - covariate = var_data, - group = group_data, - weights = weights_data, - reference_group = ref_group_param, + .covariate = var_data, + .exposure = group_data, + .weights = weights_data, + .reference_level = ref_group_param, na.rm = na.rm ) } @@ -484,18 +484,18 @@ compute_single_balance_metric <- function( # Binary exposure - single result # Determine the group level for reporting if (metric == "correlation") { - # For correlation, report the group variable name since it's continuous - group_level <- group_var + # For correlation, report the exposure variable name since it's continuous + group_level <- exposure_var } else if (metric == "energy") { # For energy, use NA since it's multivariate group_level <- NA_character_ } else { # For other metrics, determine the non-reference group level - if (reference_group %in% group_levels) { - ref_level <- reference_group + if (.reference_level %in% group_levels) { + ref_level <- .reference_level } else { - # If reference_group is numeric index, get the corresponding level - ref_level <- group_levels[reference_group] + # If .reference_level is numeric index, get the corresponding level + ref_level <- group_levels[.reference_level] } group_level <- setdiff(group_levels, ref_level)[1] } @@ -512,16 +512,16 @@ compute_single_balance_metric <- function( error = \(e) { # Return NA for failed computations but preserve structure error_group_level <- if (metric == "correlation") { - group_var + exposure_var } else if (metric == "energy") { NA_character_ } else { setdiff( group_levels, - if (reference_group %in% group_levels) { - reference_group + if (.reference_level %in% group_levels) { + .reference_level } else { - group_levels[reference_group] + group_levels[.reference_level] } )[1] } diff --git a/R/check_ess.R b/R/check_ess.R index 410ccd6..9f50746 100644 --- a/R/check_ess.R +++ b/R/check_ess.R @@ -41,29 +41,29 @@ #' #' @examples #' # Overall ESS for different weighting schemes -#' check_ess(nhefs_weights, .wts = c(w_ate, w_att, w_atm)) +#' check_ess(nhefs_weights, .weights = c(w_ate, w_att, w_atm)) #' #' # ESS by treatment group (binary exposure) -#' check_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk) +#' check_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk) #' #' # ESS by treatment group (categorical exposure) -#' check_ess(nhefs_weights, .wts = w_cat_ate, .group = alcoholfreq_cat) +#' check_ess(nhefs_weights, .weights = w_cat_ate, .group = alcoholfreq_cat) #' #' # ESS by quartiles of a continuous variable -#' check_ess(nhefs_weights, .wts = w_ate, .group = age, n_tiles = 4) +#' check_ess(nhefs_weights, .weights = w_ate, .group = age, n_tiles = 4) #' #' # Custom labels for continuous groups -#' check_ess(nhefs_weights, .wts = w_ate, .group = age, +#' check_ess(nhefs_weights, .weights = w_ate, .group = age, #' n_tiles = 3, tile_labels = c("Young", "Middle", "Older")) #' #' # Without unweighted comparison -#' check_ess(nhefs_weights, .wts = w_ate, .group = qsmk, +#' check_ess(nhefs_weights, .weights = w_ate, .group = qsmk, #' include_observed = FALSE) #' #' @export check_ess <- function( .data, - .wts = NULL, + .weights = NULL, .group = NULL, include_observed = TRUE, n_tiles = 4, @@ -113,7 +113,7 @@ check_ess <- function( } # Handle weights - wts_quo <- rlang::enquo(.wts) + wts_quo <- rlang::enquo(.weights) if (rlang::quo_is_null(wts_quo)) { # No weights provided, just use observed diff --git a/R/check_model_auc.R b/R/check_model_auc.R index 7e177b5..d89b7b4 100644 --- a/R/check_model_auc.R +++ b/R/check_model_auc.R @@ -19,9 +19,9 @@ #' specifically on the propensity score overlap and balance. #' #' @param .data A data frame containing the variables. -#' @param .truth The treatment/outcome variable. +#' @param .exposure The treatment/outcome variable. #' @param .estimate The propensity score or fitted values. -#' @param .wts Weighting variables (supports tidyselect). +#' @param .weights Weighting variables (supports tidyselect). #' @inheritParams check_params #' @inheritParams balance_params #' @inheritParams treatment_param @@ -43,23 +43,23 @@ #' @export check_model_auc <- function( .data, - .truth, + .exposure, .estimate, - .wts, + .weights, include_observed = TRUE, na.rm = TRUE, - treatment_level = NULL + .focal_level = NULL ) { validate_data_frame(.data) roc_data <- check_model_roc_curve( .data, - {{ .truth }}, + {{ .exposure }}, {{ .estimate }}, - {{ .wts }}, + {{ .weights }}, include_observed, na.rm, - treatment_level + .focal_level ) # Calculate AUC for each method @@ -99,12 +99,12 @@ compute_method_auc <- function(method, roc_data) { #' indicates good balance between treatment groups. #' #' @param .data A data frame containing the variables. -#' @param .truth The treatment/outcome variable (unquoted). +#' @param .exposure The treatment/outcome variable (unquoted). #' @param .estimate The propensity score or covariate (unquoted). -#' @param .wts Optional weighting variables (unquoted, can be multiple). +#' @param .weights Optional weighting variables (unquoted, can be multiple). #' @param include_observed Include unweighted results? Default TRUE. #' @param na.rm Remove missing values? Default TRUE. -#' @param treatment_level The level of `.truth` to consider as the treatment/event. +#' @param .focal_level The level of `.exposure` to consider as the treatment/event. #' Default is NULL, which uses the second level. #' #' @return A tibble with class "halfmoon_roc" containing ROC curve data. @@ -113,16 +113,16 @@ compute_method_auc <- function(method, roc_data) { #' @export check_model_roc_curve <- function( .data, - .truth, + .exposure, .estimate, - .wts = NULL, + .weights = NULL, include_observed = TRUE, na.rm = TRUE, - treatment_level = NULL + .focal_level = NULL ) { - truth_quo <- rlang::enquo(.truth) + truth_quo <- rlang::enquo(.exposure) estimate_quo <- rlang::enquo(.estimate) - wts_quo <- rlang::enquo(.wts) + wts_quo <- rlang::enquo(.weights) validate_data_frame(.data) @@ -132,7 +132,7 @@ check_model_roc_curve <- function( if (length(truth_name) != 1) { abort( - "{.arg .truth} must select exactly one variable", + "{.arg .exposure} must select exactly one variable", error_class = "halfmoon_select_error", call = rlang::current_env() ) @@ -166,13 +166,13 @@ check_model_roc_curve <- function( truth <- factor(truth, levels = sort(unique_vals)) } else { abort( - "{.arg .truth} must have exactly 2 unique values", + "{.arg .exposure} must have exactly 2 unique values", error_class = "halfmoon_group_error" ) } } else { abort( - "{.arg .truth} must be a factor, character, logical, or binary numeric", + "{.arg .exposure} must be a factor, character, logical, or binary numeric", error_class = "halfmoon_type_error" ) } @@ -180,7 +180,7 @@ check_model_roc_curve <- function( if (length(levels(truth)) != 2) { abort( - "{.arg .truth} must have exactly 2 levels", + "{.arg .exposure} must have exactly 2 levels", error_class = "halfmoon_group_error", call = rlang::current_env() ) @@ -211,7 +211,7 @@ check_model_roc_curve <- function( truth, estimate, weights = NULL, - treatment_level = treatment_level + .focal_level = .focal_level ) observed_curve$method <- "observed" results$observed <- observed_curve @@ -256,7 +256,7 @@ check_model_roc_curve <- function( truth_wt, estimate_wt, weights = weights_wt, - treatment_level = treatment_level + .focal_level = .focal_level ) weighted_curve$method <- wt_name results[[wt_name]] <- weighted_curve @@ -282,7 +282,7 @@ compute_roc_curve_imp <- function( truth, estimate, weights = NULL, - treatment_level = NULL, + .focal_level = NULL, call = rlang::caller_env() ) { if (length(truth) == 0) { @@ -319,15 +319,15 @@ compute_roc_curve_imp <- function( # Determine which level is the treatment/event if (is.factor(truth)) { truth_levels <- levels(truth) - if (!is.null(treatment_level)) { + if (!is.null(.focal_level)) { # User specified treatment level - if (!treatment_level %in% truth_levels) { + if (!.focal_level %in% truth_levels) { abort( - "{.arg treatment_level} '{treatment_level}' not found in {.arg truth} levels: {.val {truth_levels}}", + "{.arg .focal_level} '{(.focal_level)}' not found in {.arg truth} levels: {.val {truth_levels}}", error_class = "halfmoon_reference_error" ) } - event_level <- treatment_level + event_level <- .focal_level } else { # Default: use second level as event event_level <- truth_levels[[2]] @@ -336,14 +336,14 @@ compute_roc_curve_imp <- function( } else { # For non-factors, determine event level unique_vals <- sort(unique(truth)) - if (!is.null(treatment_level)) { - if (!treatment_level %in% unique_vals) { + if (!is.null(.focal_level)) { + if (!.focal_level %in% unique_vals) { abort( - "{.arg treatment_level} '{treatment_level}' not found in {.arg truth} values: {.val {unique_vals}}", + "{.arg .focal_level} '{(.focal_level)}' not found in {.arg truth} values: {.val {unique_vals}}", error_class = "halfmoon_reference_error" ) } - event_level <- treatment_level + event_level <- .focal_level } else { # Default: use second unique value as event event_level <- unique_vals[[2]] diff --git a/R/check_qq.R b/R/check_qq.R index 383e249..d8e3c22 100644 --- a/R/check_qq.R +++ b/R/check_qq.R @@ -12,23 +12,23 @@ #' #' @param .data A data frame containing the variables. #' @param .var Variable to compute quantiles for. Supports tidyselect syntax. -#' @param .group Column name of treatment/group variable. Supports tidyselect syntax. -#' @param .wts Optional weighting variable(s). Can be unquoted variable names (supports tidyselect syntax), +#' @param .exposure Column name of treatment/group variable. Supports tidyselect syntax. +#' @param .weights Optional weighting variable(s). Can be unquoted variable names (supports tidyselect syntax), #' a character vector, or NULL. Multiple weights can be provided to compare #' different weighting schemes. Default is NULL (unweighted). #' @param quantiles Numeric vector of quantiles to compute. Default is #' `seq(0.01, 0.99, 0.01)` for 99 quantiles. -#' @param include_observed Logical. If using `.wts`, also compute observed +#' @param include_observed Logical. If using `.weights`, also compute observed #' (unweighted) quantiles? Defaults to TRUE. -#' @param treatment_level The reference treatment level to use for comparisons. +#' @param .reference_level The reference treatment level to use for comparisons. #' If `NULL` (default), uses the last level for factors or the maximum value for numeric variables. #' @param na.rm Logical; if TRUE, drop NA values before computation. #' #' @return A tibble with class "halfmoon_qq" containing columns: #' \item{method}{Character. The weighting method ("observed" or weight variable name).} #' \item{quantile}{Numeric. The quantile probability (0-1).} -#' \item{treated_quantiles}{Numeric. The quantile value for the treatment group.} -#' \item{untreated_quantiles}{Numeric. The quantile value for the control group.} +#' \item{exposed_quantiles}{Numeric. The quantile value for the exposed group.} +#' \item{unexposed_quantiles}{Numeric. The quantile value for the unexposed group.} #' #' @family balance functions #' @seealso [bal_qq()] for single weight QQ data, [plot_qq()] for visualization @@ -37,29 +37,29 @@ #' check_qq(nhefs_weights, age, qsmk) #' #' # With weighting -#' check_qq(nhefs_weights, age, qsmk, .wts = w_ate) +#' check_qq(nhefs_weights, age, qsmk, .weights = w_ate) #' #' # Compare multiple weighting schemes -#' check_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) +#' check_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) #' #' @export check_qq <- function( .data, .var, - .group, - .wts = NULL, + .exposure, + .weights = NULL, quantiles = seq(0.01, 0.99, 0.01), include_observed = TRUE, - treatment_level = NULL, + .reference_level = NULL, na.rm = FALSE ) { # Handle both quoted and unquoted column names var_quo <- rlang::enquo(.var) - group_quo <- rlang::enquo(.group) - wts_quo <- rlang::enquo(.wts) + exposure_quo <- rlang::enquo(.exposure) + wts_quo <- rlang::enquo(.weights) var_name <- get_column_name(var_quo, ".var") - group_name <- get_column_name(group_quo, ".group") + exposure_name <- get_column_name(exposure_quo, ".exposure") # Validate inputs if (!var_name %in% names(.data)) { @@ -69,9 +69,9 @@ check_qq <- function( ) } - if (!group_name %in% names(.data)) { + if (!exposure_name %in% names(.data)) { abort( - "Column {.code {group_name}} not found in data", + "Column {.code {exposure_name}} not found in data", error_class = "halfmoon_column_error" ) } @@ -84,16 +84,16 @@ check_qq <- function( } # Get group levels - group_var <- .data[[group_name]] - group_levels <- if (is.factor(group_var)) { - levels(group_var) + exposure_var <- .data[[exposure_name]] + exposure_levels <- if (is.factor(exposure_var)) { + levels(exposure_var) } else { - sort(unique(group_var[!is.na(group_var)])) + sort(unique(exposure_var[!is.na(exposure_var)])) } - if (length(group_levels) != 2) { + if (length(exposure_levels) != 2) { abort( - "Group variable must have exactly 2 levels", + "Exposure variable must have exactly 2 levels", error_class = "halfmoon_group_error" ) } @@ -107,36 +107,36 @@ check_qq <- function( error_class = "halfmoon_na_error" ) } - if (any(is.na(group_var))) { + if (any(is.na(exposure_var))) { abort( - "Group variable {.code {group_name}} contains missing values and {.arg na.rm = FALSE}", + "Exposure variable {.code {exposure_name}} contains missing values and {.arg na.rm = FALSE}", error_class = "halfmoon_na_error" ) } } - # Handle NULL treatment_level - if (is.null(treatment_level)) { - if (is.factor(group_var)) { + # Handle NULL .reference_level + if (is.null(.reference_level)) { + if (is.factor(exposure_var)) { # For factors, use the last level - treatment_level <- group_levels[length(group_levels)] + .reference_level <- exposure_levels[length(exposure_levels)] } else { # For numeric, use the maximum value - treatment_level <- max(group_levels) + .reference_level <- max(exposure_levels) } } - # Validate treatment_level exists - if (!treatment_level %in% group_levels) { + # Validate .reference_level exists + if (!.reference_level %in% exposure_levels) { abort( - "{.arg treatment_level} '{treatment_level}' not found in {.arg .group} levels: {.val {group_levels}}", + "{.arg .reference_level} '{(.reference_level)}' not found in {.arg .group} levels: {.val {exposure_levels}}", error_class = "halfmoon_reference_error" ) } # Determine reference and comparison groups - ref_group <- treatment_level - comp_group <- setdiff(group_levels, treatment_level) + ref_group <- .reference_level + comp_group <- setdiff(exposure_levels, .reference_level) # Create list of methods to compute methods <- character(0) @@ -153,7 +153,7 @@ check_qq <- function( compute_method_quantiles, .data = .data, var_name = var_name, - group_name = group_name, + exposure_name = exposure_name, ref_group = ref_group, comp_group = comp_group, quantiles = quantiles, @@ -176,7 +176,7 @@ check_qq <- function( #' @param method Character string indicating the method ("observed" or weight column name) #' @param .data Data frame #' @param var_name Variable name to compute quantiles for -#' @param group_name Group variable name +#' @param exposure_name Group variable name #' @param ref_group Reference group level #' @param comp_group Comparison group level #' @param quantiles Numeric vector of quantiles @@ -189,15 +189,15 @@ compute_method_quantiles <- function( method, .data, var_name, - group_name, + exposure_name, ref_group, comp_group, quantiles, na.rm ) { # Filter data by group - ref_data <- .data[.data[[group_name]] == ref_group, ] - comp_data <- .data[.data[[group_name]] == comp_group, ] + ref_data <- .data[.data[[exposure_name]] == ref_group, ] + comp_data <- .data[.data[[exposure_name]] == comp_group, ] if (na.rm) { ref_data <- ref_data[!is.na(ref_data[[var_name]]), ] @@ -229,15 +229,15 @@ compute_method_quantiles <- function( comp_wts <- comp_wts[!is.na(comp_data[[var_name]])] } - ref_q <- weighted_quantile(ref_vals, quantiles, .wts = ref_wts) - comp_q <- weighted_quantile(comp_vals, quantiles, .wts = comp_wts) + ref_q <- weighted_quantile(ref_vals, quantiles, .weights = ref_wts) + comp_q <- weighted_quantile(comp_vals, quantiles, .weights = comp_wts) } dplyr::tibble( method = method, quantile = quantiles, - treated_quantiles = ref_q, - untreated_quantiles = comp_q + exposed_quantiles = ref_q, + unexposed_quantiles = comp_q ) } @@ -249,7 +249,7 @@ compute_method_quantiles <- function( #' #' @param values Numeric vector of values to compute quantiles for. #' @param quantiles Numeric vector of probabilities with values between 0 and 1. -#' @param .wts Numeric vector of non-negative weights, same length as `values`. +#' @param .weights Numeric vector of non-negative weights, same length as `values`. #' #' @return Numeric vector of weighted quantiles corresponding to the requested probabilities. #' @@ -261,9 +261,9 @@ compute_method_quantiles <- function( #' weighted_quantile(1:10, c(0.25, 0.5, 0.75), 1:10) #' #' @export -weighted_quantile <- function(values, quantiles, .wts) { +weighted_quantile <- function(values, quantiles, .weights) { # Extract numeric data from weights (handles both numeric and psw objects) - .wts <- extract_weight_data(.wts) + .wts <- extract_weight_data(.weights) # Remove NA values if present na_idx <- is.na(values) | is.na(.wts) diff --git a/R/compute_balance.R b/R/compute_balance.R index a802ea5..36976e3 100644 --- a/R/compute_balance.R +++ b/R/compute_balance.R @@ -25,39 +25,39 @@ #' #' # With weights #' bal_smd(nhefs_weights$wt71, nhefs_weights$qsmk, -#' weights = nhefs_weights$w_ate) +#' .weights = nhefs_weights$w_ate) #' #' # Categorical exposure (returns named vector) #' bal_smd(nhefs_weights$age, nhefs_weights$alcoholfreq_cat) #' -#' # Specify reference group +#' # Specify reference level #' bal_smd(nhefs_weights$age, nhefs_weights$alcoholfreq_cat, -#' reference_group = "daily") +#' .reference_level = "daily") #' #' # With categorical weights #' bal_smd(nhefs_weights$wt71, nhefs_weights$alcoholfreq_cat, -#' weights = nhefs_weights$w_cat_ate) +#' .weights = nhefs_weights$w_cat_ate) #' #' @export bal_smd <- function( - covariate, - group, - weights = NULL, - reference_group = NULL, + .covariate, + .exposure, + .weights = NULL, + .reference_level = NULL, na.rm = FALSE ) { - validate_numeric(covariate) - validate_not_empty(covariate) - validate_equal_length(covariate, group) - validate_weights(weights, length(covariate)) + validate_numeric(.covariate) + validate_not_empty(.covariate) + validate_equal_length(.covariate, .exposure) + validate_weights(.weights, length(.covariate)) # Check if exposure is categorical first - if (is_categorical_exposure(group)) { + if (is_categorical_exposure(.exposure)) { return(.bal_smd_categorical( - covariate = covariate, - group = group, - weights = weights, - reference_group = reference_group, + covariate = .covariate, + group = .exposure, + weights = .weights, + reference_group = .reference_level, na.rm = na.rm )) } @@ -65,44 +65,44 @@ bal_smd <- function( # Handle missing values for binary exposures if (!na.rm) { # Check for missing values - if (is.null(weights)) { - if (any(is.na(covariate) | is.na(group))) return(NA_real_) + if (is.null(.weights)) { + if (any(is.na(.covariate) | is.na(.exposure))) return(NA_real_) } else { - if (any(is.na(covariate) | is.na(group) | is.na(weights))) { + if (any(is.na(.covariate) | is.na(.exposure) | is.na(.weights))) { return(NA_real_) } } } # Binary exposure handling (existing code) - # Convert reference_group to index for smd package - levels_g <- unique(stats::na.omit(group)) + # Convert .reference_level to index for smd package + levels_g <- unique(stats::na.omit(.exposure)) # Validate we have exactly two levels if (length(levels_g) != 2) { abort( - "Group variable must have exactly two levels, got {length(levels_g)}", + "Exposure variable must have exactly two levels, got {length(levels_g)}", error_class = "halfmoon_group_error" ) } # Determine gref_index for smd package - if (is.null(reference_group)) { + if (is.null(.reference_level)) { gref_index <- 1L } else { - # If reference_group is a level value, convert to index - if (reference_group %in% levels_g) { - gref_index <- which(levels_g == reference_group) + # If .reference_level is a level value, convert to index + if (.reference_level %in% levels_g) { + gref_index <- which(levels_g == .reference_level) } else { # Use it directly as an index - gref_index <- reference_group + gref_index <- .reference_level } } res <- smd::smd( - x = covariate, - g = group, - w = extract_weight_data(weights), + x = .covariate, + g = .exposure, + w = extract_weight_data(.weights), gref = gref_index, na.rm = na.rm ) @@ -145,58 +145,63 @@ is_binary <- function(x) { #' #' # With weights #' bal_vr(nhefs_weights$wt71, nhefs_weights$qsmk, -#' weights = nhefs_weights$w_ate) +#' .weights = nhefs_weights$w_ate) #' #' # Categorical exposure (returns named vector) #' bal_vr(nhefs_weights$age, nhefs_weights$alcoholfreq_cat) #' -#' # Specify reference group +#' # Specify reference level #' bal_vr(nhefs_weights$age, nhefs_weights$alcoholfreq_cat, -#' reference_group = "2_3_per_week") +#' .reference_level = "2_3_per_week") #' #' # With categorical weights #' bal_vr(nhefs_weights$wt71, nhefs_weights$alcoholfreq_cat, -#' weights = nhefs_weights$w_cat_ate) +#' .weights = nhefs_weights$w_cat_ate) #' #' @export bal_vr <- function( - covariate, - group, - weights = NULL, - reference_group = NULL, + .covariate, + .exposure, + .weights = NULL, + .reference_level = NULL, na.rm = FALSE ) { # Input validation - validate_numeric(covariate) - validate_not_empty(covariate) - validate_equal_length(covariate, group) - validate_weights(weights, length(covariate)) + validate_numeric(.covariate) + validate_not_empty(.covariate) + validate_equal_length(.covariate, .exposure) + validate_weights(.weights, length(.covariate)) # Check if exposure is categorical - if (is_categorical_exposure(group)) { + if (is_categorical_exposure(.exposure)) { return(.bal_vr_categorical( - covariate = covariate, - group = group, - weights = weights, - reference_group = reference_group, + covariate = .covariate, + group = .exposure, + weights = .weights, + reference_group = .reference_level, na.rm = na.rm )) } # Binary exposure handling (existing code) # Identify reference and comparison indices - group_splits <- split_by_group(covariate, group, reference_group) + group_splits <- split_by_group(.covariate, .exposure, .reference_level) idx_ref <- group_splits$reference idx_other <- group_splits$comparison # Handle missing values if (na.rm) { - idx_ref <- filter_na_indices(idx_ref, covariate, weights, na.rm = TRUE) - idx_other <- filter_na_indices(idx_other, covariate, weights, na.rm = TRUE) + idx_ref <- filter_na_indices(idx_ref, .covariate, .weights, na.rm = TRUE) + idx_other <- filter_na_indices( + idx_other, + .covariate, + .weights, + na.rm = TRUE + ) } else { if ( check_na_return( - covariate[c(idx_ref, idx_other)], - extract_weight_data(weights)[c(idx_ref, idx_other)] %||% NULL, + .covariate[c(idx_ref, idx_other)], + extract_weight_data(.weights)[c(idx_ref, idx_other)] %||% NULL, na.rm = FALSE ) ) { @@ -209,33 +214,33 @@ bal_vr <- function( return(NA_real_) } # Compute variances - if (is_binary(covariate)) { + if (is_binary(.covariate)) { # For binary variables, use p*(1-p) formula - var_ref <- if (is.null(weights)) { - p <- mean(covariate[idx_ref]) + var_ref <- if (is.null(.weights)) { + p <- mean(.covariate[idx_ref]) p * (1 - p) } else { - wr <- extract_weight_data(weights)[idx_ref] - xr <- covariate[idx_ref] + wr <- extract_weight_data(.weights)[idx_ref] + xr <- .covariate[idx_ref] p <- sum(wr * xr) / sum(wr) p * (1 - p) } - var_other <- if (is.null(weights)) { - p <- mean(covariate[idx_other]) + var_other <- if (is.null(.weights)) { + p <- mean(.covariate[idx_other]) p * (1 - p) } else { - wo <- extract_weight_data(weights)[idx_other] - xo <- covariate[idx_other] + wo <- extract_weight_data(.weights)[idx_other] + xo <- .covariate[idx_other] p <- sum(wo * xo) / sum(wo) p * (1 - p) } } else { # For continuous variables, use Bessel's correction - var_ref <- if (is.null(weights)) { - stats::var(covariate[idx_ref]) + var_ref <- if (is.null(.weights)) { + stats::var(.covariate[idx_ref]) } else { - wr <- extract_weight_data(weights)[idx_ref] - xr <- covariate[idx_ref] + wr <- extract_weight_data(.weights)[idx_ref] + xr <- .covariate[idx_ref] mr <- sum(wr * xr) / sum(wr) # Use Bessel's correction for weighted sample variance denom <- sum(wr) - sum(wr^2) / sum(wr) @@ -245,11 +250,11 @@ bal_vr <- function( sum(wr * (xr - mr)^2) / denom } } - var_other <- if (is.null(weights)) { - stats::var(covariate[idx_other]) + var_other <- if (is.null(.weights)) { + stats::var(.covariate[idx_other]) } else { - wo <- extract_weight_data(weights)[idx_other] - xo <- covariate[idx_other] + wo <- extract_weight_data(.weights)[idx_other] + xo <- .covariate[idx_other] mo <- sum(wo * xo) / sum(wo) # Use Bessel's correction for weighted sample variance denom <- sum(wo) - sum(wo^2) / sum(wo) @@ -310,56 +315,61 @@ bal_vr <- function( #' #' # With weights #' bal_ks(nhefs_weights$wt71, nhefs_weights$qsmk, -#' weights = nhefs_weights$w_ate) +#' .weights = nhefs_weights$w_ate) #' #' # Categorical exposure (returns named vector) #' bal_ks(nhefs_weights$age, nhefs_weights$alcoholfreq_cat) #' -#' # Specify reference group +#' # Specify reference level #' bal_ks(nhefs_weights$age, nhefs_weights$alcoholfreq_cat, -#' reference_group = "none") +#' .reference_level = "none") #' #' # With categorical weights #' bal_ks(nhefs_weights$wt71, nhefs_weights$alcoholfreq_cat, -#' weights = nhefs_weights$w_cat_ate) +#' .weights = nhefs_weights$w_cat_ate) #' @export bal_ks <- function( - covariate, - group, - weights = NULL, - reference_group = NULL, + .covariate, + .exposure, + .weights = NULL, + .reference_level = NULL, na.rm = FALSE ) { # Input validation - validate_numeric(covariate) - validate_not_empty(covariate) - validate_equal_length(covariate, group) - validate_weights(weights, length(covariate)) + validate_numeric(.covariate) + validate_not_empty(.covariate) + validate_equal_length(.covariate, .exposure) + validate_weights(.weights, length(.covariate)) # Check if exposure is categorical - if (is_categorical_exposure(group)) { + if (is_categorical_exposure(.exposure)) { return(.bal_ks_categorical( - covariate = covariate, - group = group, - weights = weights, - reference_group = reference_group, + covariate = .covariate, + group = .exposure, + weights = .weights, + reference_group = .reference_level, na.rm = na.rm )) } # Binary exposure handling (existing code) - group_splits <- split_by_group(covariate, group, reference_group) + group_splits <- split_by_group(.covariate, .exposure, .reference_level) idx_ref <- group_splits$reference idx_other <- group_splits$comparison # Handle missing values if (na.rm) { - idx_ref <- filter_na_indices(idx_ref, covariate, weights, na.rm = TRUE) - idx_other <- filter_na_indices(idx_other, covariate, weights, na.rm = TRUE) + idx_ref <- filter_na_indices(idx_ref, .covariate, .weights, na.rm = TRUE) + idx_other <- filter_na_indices( + idx_other, + .covariate, + .weights, + na.rm = TRUE + ) } else { if ( check_na_return( - covariate[c(idx_ref, idx_other)], - extract_weight_data(weights)[c(idx_ref, idx_other)] %||% NULL, + .covariate[c(idx_ref, idx_other)], + extract_weight_data(.weights)[c(idx_ref, idx_other)] %||% NULL, na.rm = FALSE ) ) { @@ -372,36 +382,36 @@ bal_ks <- function( return(NA_real_) } # For binary variables, KS statistic is just the difference in proportions - if (is_binary(covariate)) { + if (is_binary(.covariate)) { # Calculate weighted proportions - p_ref <- if (is.null(weights)) { - mean(covariate[idx_ref]) + p_ref <- if (is.null(.weights)) { + mean(.covariate[idx_ref]) } else { - sum(extract_weight_data(weights)[idx_ref] * covariate[idx_ref]) / - sum(extract_weight_data(weights)[idx_ref]) + sum(extract_weight_data(.weights)[idx_ref] * .covariate[idx_ref]) / + sum(extract_weight_data(.weights)[idx_ref]) } - p_other <- if (is.null(weights)) { - mean(covariate[idx_other]) + p_other <- if (is.null(.weights)) { + mean(.covariate[idx_other]) } else { - sum(extract_weight_data(weights)[idx_other] * covariate[idx_other]) / - sum(extract_weight_data(weights)[idx_other]) + sum(extract_weight_data(.weights)[idx_other] * .covariate[idx_other]) / + sum(extract_weight_data(.weights)[idx_other]) } return(abs(p_other - p_ref)) } # For continuous variables, compute full KS statistic # Extract and weight - x_ref <- covariate[idx_ref] - x_other <- covariate[idx_other] - w_ref <- if (is.null(weights)) { + x_ref <- .covariate[idx_ref] + x_other <- .covariate[idx_other] + w_ref <- if (is.null(.weights)) { rep(1, length(x_ref)) } else { - extract_weight_data(weights)[idx_ref] + extract_weight_data(.weights)[idx_ref] } - w_other <- if (is.null(weights)) { + w_other <- if (is.null(.weights)) { rep(1, length(x_other)) } else { - extract_weight_data(weights)[idx_other] + extract_weight_data(.weights)[idx_other] } w_ref <- w_ref / sum(w_ref) w_other <- w_other / sum(w_other) @@ -440,11 +450,11 @@ bal_ks <- function( #' with optional case weights. Uses the standard correlation formula for #' unweighted data and weighted covariance for weighted data. #' -#' @param x A numeric vector containing the first variable. -#' @param y A numeric vector containing the second variable. Must have the same -#' length as `x`. -#' @param weights An optional numeric vector of case weights. If provided, must -#' have the same length as `x` and `y`. All weights must be non-negative. +#' @param .x A numeric vector containing the first variable. +#' @param .y A numeric vector containing the second variable. Must have the same +#' length as `.x`. +#' @param .weights An optional numeric vector of case weights. If provided, must +#' have the same length as `.x` and `.y`. All weights must be non-negative. #' @param na.rm A logical value indicating whether to remove missing values #' before computation. If `FALSE` (default), missing values result in #' `NA` output. @@ -456,54 +466,54 @@ bal_ks <- function( #' bal_corr(nhefs_weights$age, nhefs_weights$wt71) #' #' @export -bal_corr <- function(x, y, weights = NULL, na.rm = FALSE) { +bal_corr <- function(.x, .y, .weights = NULL, na.rm = FALSE) { # Input validation - validate_numeric(x) - validate_numeric(y) - validate_not_empty(x) - validate_not_empty(y) - validate_equal_length(x, y) - validate_weights(weights, length(x)) + validate_numeric(.x) + validate_numeric(.y) + validate_not_empty(.x) + validate_not_empty(.y) + validate_equal_length(.x, .y) + validate_weights(.weights, length(.x)) if (na.rm) { # Handle missing values carefully - avoid logical(0) issue - if (is.null(weights)) { - idx <- !(is.na(x) | is.na(y)) + if (is.null(.weights)) { + idx <- !(is.na(.x) | is.na(.y)) } else { - idx <- !(is.na(x) | is.na(y) | is.na(weights)) + idx <- !(is.na(.x) | is.na(.y) | is.na(.weights)) } - x <- x[idx] - y <- y[idx] - if (!is.null(weights)) weights <- extract_weight_data(weights)[idx] + .x <- .x[idx] + .y <- .y[idx] + if (!is.null(.weights)) .weights <- extract_weight_data(.weights)[idx] } else { # Extract weight data if needed - if (!is.null(weights)) { - weights <- extract_weight_data(weights) + if (!is.null(.weights)) { + .weights <- extract_weight_data(.weights) } # Check for missing values - if (is.null(weights)) { - if (any(is.na(x) | is.na(y))) return(NA_real_) + if (is.null(.weights)) { + if (any(is.na(.x) | is.na(.y))) return(NA_real_) } else { - if (any(is.na(x) | is.na(y) | is.na(weights))) return(NA_real_) + if (any(is.na(.x) | is.na(.y) | is.na(.weights))) return(NA_real_) } } # Check if we have enough data after removing NAs - if (length(x) < 2) { + if (length(.x) < 2) { return(NA_real_) } - if (is.null(weights)) { - return(stats::cor(x, y)) + if (is.null(.weights)) { + return(stats::cor(.x, .y)) } # Compute weighted covariance - w_norm <- weights / sum(weights) - mx <- sum(w_norm * x) - my <- sum(w_norm * y) - cov <- sum(w_norm * (x - mx) * (y - my)) - vx <- sum(w_norm * (x - mx)^2) - vy <- sum(w_norm * (y - my)^2) + w_norm <- .weights / sum(.weights) + mx <- sum(w_norm * .x) + my <- sum(w_norm * .y) + cov <- sum(w_norm * (.x - mx) * (.y - my)) + vx <- sum(w_norm * (.x - mx)^2) + vy <- sum(w_norm * (.y - my)^2) if (vx <= 0 || vy <= 0) { return(NA_real_) @@ -517,25 +527,25 @@ bal_corr <- function(x, y, weights = NULL, na.rm = FALSE) { #' #' Computes the energy distance as a multivariate measure of covariate balance #' between groups. Energy distance captures the similarity between distributions -#' across the entire joint distribution of covariates, making it more comprehensive +#' across the entire joint distribution of .covariates, making it more comprehensive #' than univariate balance measures. #' -#' @param covariates A data frame or matrix containing the covariates to compare. -#' @param group A vector (factor or numeric) indicating group membership. For +#' @param .covariates A data frame or matrix containing the .covariates to compare. +#' @param .exposure A vector (factor or numeric) indicating group membership. For #' binary and multi-category treatments, must have 2+ unique levels. For #' continuous treatments, should be numeric. -#' @param weights An optional numeric vector of weights. If provided, must -#' have the same length as rows in `covariates`. All weights must be non-negative. +#' @param .weights An optional numeric vector of weights. If provided, must +#' have the same length as rows in `.covariates`. All weights must be non-negative. #' @param estimand Character string specifying the estimand. Options are: #' - NULL (default): Pure between-group energy distance comparing distributions #' - "ATE": Energy distance weighted to reflect balance for estimating average #' treatment effects across the entire population -#' - "ATT": Energy distance weighted to reflect balance for the treated group, +#' - "ATT": Energy distance weighted to reflect balance for the treated .exposure, #' measuring how well controls match the treated distribution -#' - "ATC": Energy distance weighted to reflect balance for the control group, +#' - "ATC": Energy distance weighted to reflect balance for the control .exposure, #' measuring how well treated units match the control distribution #' For continuous treatments, only NULL is supported. -#' @param treatment_level The treatment level for ATT/ATC. If `NULL` (default), +#' @param .focal_level The treatment level for ATT/ATC. If `NULL` (default), #' automatically determined based on estimand. #' @param use_improved Logical. Use improved energy distance for ATE? Default is TRUE. #' When TRUE, adds pairwise treatment comparisons for better group separation. @@ -556,11 +566,11 @@ bal_corr <- function(x, y, weights = NULL, na.rm = FALSE) { #' The calculation uses a quadratic form: \eqn{w^T P w + q^T w + k}, #' where the components depend on the estimand. #' -#' For binary variables in the covariates, variance is calculated as p(1-p) +#' For binary variables in the .covariates, variance is calculated as p(1-p) #' rather than sample variance to prevent over-weighting. #' #' For continuous treatments, the function uses distance correlation instead of -#' traditional energy distance, measuring independence between treatment and covariates. +#' traditional energy distance, measuring independence between treatment and .covariates. #' #' @references #' Huling, J. D., & Mak, S. (2024). Energy Balancing of Covariate Distributions. @@ -576,59 +586,59 @@ bal_corr <- function(x, y, weights = NULL, na.rm = FALSE) { #' @examples #' # Binary treatment #' bal_energy( -#' covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), -#' group = nhefs_weights$qsmk +#' .covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), +#' .exposure = nhefs_weights$qsmk #' ) #' #' # With weights #' bal_energy( -#' covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), -#' group = nhefs_weights$qsmk, -#' weights = nhefs_weights$w_ate +#' .covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), +#' .exposure = nhefs_weights$qsmk, +#' .weights = nhefs_weights$w_ate #' ) #' #' # ATT estimand #' bal_energy( -#' covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), -#' group = nhefs_weights$qsmk, -#' weights = nhefs_weights$w_att, +#' .covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), +#' .exposure = nhefs_weights$qsmk, +#' .weights = nhefs_weights$w_att, #' estimand = "ATT" #' ) #' #' @export #' @importFrom stats dist model.matrix sd bal_energy <- function( - covariates, - group, - weights = NULL, + .covariates, + .exposure, + .weights = NULL, estimand = NULL, - treatment_level = NULL, + .focal_level = NULL, use_improved = TRUE, standardized = TRUE, na.rm = FALSE ) { # Input validation - if (!is.data.frame(covariates) && !is.matrix(covariates)) { + if (!is.data.frame(.covariates) && !is.matrix(.covariates)) { abort( - "Argument {.arg covariates} must be a data frame or matrix", + "Argument {.arg .covariates} must be a data frame or matrix", error_class = "halfmoon_type_error" ) } - if (is.data.frame(covariates)) { - covariates <- create_dummy_variables(covariates, binary_as_single = TRUE) - covariates <- as.matrix(covariates) + if (is.data.frame(.covariates)) { + .covariates <- create_dummy_variables(.covariates, binary_as_single = TRUE) + .covariates <- as.matrix(.covariates) } - if (nrow(covariates) == 0) { + if (nrow(.covariates) == 0) { abort( - "Argument {.arg covariates} cannot be empty", + "Argument {.arg .covariates} cannot be empty", error_class = "halfmoon_empty_error" ) } - validate_equal_length(group, covariates, "group", "covariates") - validate_weights(weights, nrow(covariates)) + validate_equal_length(.exposure, .covariates, ".exposure", ".covariates") + validate_weights(.weights, nrow(.covariates)) if (!is.null(estimand) && !estimand %in% c("ATE", "ATT", "ATC")) { abort( @@ -637,56 +647,56 @@ bal_energy <- function( ) } - if (!na.rm && anyNA(covariates)) { + if (!na.rm && anyNA(.covariates)) { abort( - "Energy distance cannot be computed with missing values in {.arg covariates}. Set {.arg na.rm = TRUE} or remove missing values.", + "Energy distance cannot be computed with missing values in {.arg .covariates}. Set {.arg na.rm = TRUE} or remove missing values.", error_class = "halfmoon_na_error" ) } - if (!na.rm && anyNA(group)) { + if (!na.rm && anyNA(.exposure)) { abort( "Energy distance cannot be computed with missing values in {.arg group}. Set {.arg na.rm = TRUE} or remove missing values.", error_class = "halfmoon_na_error" ) } - if (!na.rm && !is.null(weights) && anyNA(weights)) { + if (!na.rm && !is.null(.weights) && anyNA(.weights)) { abort( - "Energy distance cannot be computed with missing values in {.arg weights}. Set {.arg na.rm = TRUE} or remove missing values.", + "Energy distance cannot be computed with missing values in {.arg .weights}. Set {.arg na.rm = TRUE} or remove missing values.", error_class = "halfmoon_na_error" ) } # Remove missing values if requested if (na.rm) { - complete_cases <- stats::complete.cases(covariates, group) - if (!is.null(weights)) { - complete_cases <- complete_cases & !is.na(weights) - weights <- extract_weight_data(weights)[complete_cases] + complete_cases <- stats::complete.cases(.covariates, .exposure) + if (!is.null(.weights)) { + complete_cases <- complete_cases & !is.na(.weights) + .weights <- extract_weight_data(.weights)[complete_cases] } - covariates <- covariates[complete_cases, , drop = FALSE] - group <- group[complete_cases] + .covariates <- .covariates[complete_cases, , drop = FALSE] + .exposure <- .exposure[complete_cases] - if (nrow(covariates) == 0) { + if (nrow(.covariates) == 0) { return(NA_real_) } } # Determine treatment type - unique_groups <- unique(group) + unique_groups <- unique(.exposure) n_groups <- length(unique_groups) # Special case: constant group (only one unique value) if (n_groups <= 1) { abort( - "Group variable must have at least two levels", + "Exposure variable must have at least two levels", error_class = "halfmoon_group_error" ) } # Determine if treatment is continuous - is_continuous <- is.numeric(group) && n_groups > 10 + is_continuous <- is.numeric(.exposure) && n_groups > 10 if (is_continuous && !is.null(estimand)) { abort( @@ -698,29 +708,29 @@ bal_energy <- function( # For continuous treatments, use distance correlation if (is_continuous) { return(bal_energy_continuous( - covariates = covariates, - treatment = group, - weights = weights, + .covariates = .covariates, + treatment = .exposure, + .weights = .weights, standardized = standardized )) } # For discrete treatments, proceed with energy distance # Convert group to factor for consistent handling - group <- as.factor(group) - unique_groups <- levels(group) + .exposure <- as.factor(.exposure) + unique_groups <- levels(.exposure) n_groups <- length(unique_groups) # Default weights - if (is.null(weights)) { - weights <- rep(1, nrow(covariates)) + if (is.null(.weights)) { + .weights <- rep(1, nrow(.covariates)) } # Normalize weights by group - weights_numeric <- extract_weight_data(weights) + weights_numeric <- extract_weight_data(.weights) weights_normalized <- weights_numeric for (g in unique_groups) { - group_mask <- group == g + group_mask <- .exposure == g if (any(group_mask)) { group_weights <- weights_numeric[group_mask] weights_normalized[group_mask] <- group_weights / mean(group_weights) @@ -728,24 +738,24 @@ bal_energy <- function( } # Identify binary variables (checking each column) - binary_vars <- purrr::map_lgl(as.data.frame(covariates), \(x) { + binary_vars <- purrr::map_lgl(as.data.frame(.covariates), \(x) { unique_vals <- unique(x) length(unique_vals) == 2 && all(unique_vals %in% c(0, 1)) }) - # Standardize covariates - standardized_covariates <- bal_energy_standardize( - covariates = covariates, + # Standardize .covariates + standardized_.covariates <- bal_energy_standardize( + .covariates = .covariates, weights = weights_normalized, binary_vars = binary_vars, - use_weights = is.null(weights) # Only use weights for standardization when no weights provided + use_weights = is.null(.weights) # Only use weights for standardization when no weights provided ) # Compute distance matrix - distance_matrix <- as.matrix(dist(standardized_covariates)) + distance_matrix <- as.matrix(dist(standardized_.covariates)) # Create treatment indicators - treatment_indicators <- model.matrix(~ group - 1) + treatment_indicators <- model.matrix(~ .exposure - 1) # Compute energy distance components based on estimand if (is.null(estimand)) { @@ -770,9 +780,9 @@ bal_energy <- function( distance_matrix = distance_matrix, treatment_indicators = treatment_indicators, unique_groups = unique_groups, - weights = weights_normalized, - group = group, - treatment_level = treatment_level, + .weights = weights_normalized, + .exposure = .exposure, + .focal_level = .focal_level, estimand = estimand ) } @@ -837,10 +847,10 @@ calculate_scaling_factor <- function(col, is_binary, weights_norm = NULL) { } } -#' Standardize covariates for energy distance calculation +#' Standardize .covariates for energy distance calculation #' @noRd bal_energy_standardize <- function( - covariates, + .covariates, weights, binary_vars, use_weights = TRUE @@ -850,7 +860,7 @@ bal_energy_standardize <- function( weights_norm <- weights / sum(weights) scaling_factors <- purrr::map2_dbl( - as.data.frame(covariates), + as.data.frame(.covariates), binary_vars, calculate_scaling_factor, weights_norm = weights_norm @@ -858,7 +868,7 @@ bal_energy_standardize <- function( } else { # Use unweighted standardization (to match cobalt when weights are provided) scaling_factors <- purrr::map2_dbl( - as.data.frame(covariates), + as.data.frame(.covariates), binary_vars, calculate_scaling_factor, weights_norm = NULL @@ -868,8 +878,8 @@ bal_energy_standardize <- function( # Avoid division by zero scaling_factors[scaling_factors == 0] <- 1 - # Standardize covariates - scale(covariates, center = TRUE, scale = scaling_factors) + # Standardize .covariates + scale(.covariates, center = TRUE, scale = scaling_factors) } #' Compute between-group energy distance components @@ -970,23 +980,23 @@ bal_energy_att_atc <- function( distance_matrix, treatment_indicators, unique_groups, - weights, - group, - treatment_level, + .weights, + .exposure, + .focal_level, estimand ) { n_obs <- nrow(distance_matrix) n_groups <- length(unique_groups) # Determine focal group - if (is.null(treatment_level)) { + if (is.null(.focal_level)) { if (estimand == "ATT") { # For binary, use the "treatment" group (typically coded as 1) - treatment_level <- unique_groups[which.max(as.numeric(unique_groups))] + .focal_level <- unique_groups[which.max(as.numeric(unique_groups))] } else { # ATC # Use the "control" group (typically coded as 0) - treatment_level <- unique_groups[which.min(as.numeric(unique_groups))] + .focal_level <- unique_groups[which.min(as.numeric(unique_groups))] } } @@ -1000,8 +1010,8 @@ bal_energy_att_atc <- function( nn_matrix <- tcrossprod(normalized_indicators) # Identify focal group observations - focal_mask <- group == treatment_level - focal_weights <- extract_weight_data(weights)[focal_mask] + focal_mask <- .exposure == .focal_level + focal_weights <- extract_weight_data(.weights)[focal_mask] focal_weights_norm <- focal_weights / sum(focal_weights) # Compute P matrix @@ -1028,30 +1038,30 @@ bal_energy_att_atc <- function( #' Compute distance correlation for continuous treatments #' @noRd bal_energy_continuous <- function( - covariates, + .covariates, treatment, - weights, + .weights, standardized ) { - n_obs <- nrow(covariates) + n_obs <- nrow(.covariates) # Default weights - if (is.null(weights)) { - weights <- rep(1, n_obs) + if (is.null(.weights)) { + .weights <- rep(1, n_obs) } # Normalize weights - weights_norm <- weights / sum(weights) + weights_norm <- .weights / sum(.weights) # Identify binary variables - binary_vars <- purrr::map_lgl(as.data.frame(covariates), \(x) { + binary_vars <- purrr::map_lgl(as.data.frame(.covariates), \(x) { unique_vals <- unique(x) length(unique_vals) == 2 && all(unique_vals %in% c(0, 1)) }) # Compute weighted variances for scaling covariate_vars <- purrr::map2_dbl( - as.data.frame(covariates), + as.data.frame(.covariates), binary_vars, calculate_variance, weights_norm = weights_norm @@ -1072,12 +1082,12 @@ bal_energy_continuous <- function( treatment_var <- 1 } - # Scale covariates and treatment - scaled_covariates <- scale(covariates, scale = sqrt(covariate_vars)) + # Scale .covariates and treatment + scaled_.covariates <- scale(.covariates, scale = sqrt(covariate_vars)) scaled_treatment <- treatment / sqrt(treatment_var) # Compute distance matrices - cov_dist <- as.matrix(dist(scaled_covariates)) + cov_dist <- as.matrix(dist(scaled_.covariates)) treat_dist <- as.matrix(dist(scaled_treatment)) # Double-center the distance matrices diff --git a/R/compute_balance_categorical.R b/R/compute_balance_categorical.R index adade0f..f21d09b 100644 --- a/R/compute_balance_categorical.R +++ b/R/compute_balance_categorical.R @@ -186,18 +186,18 @@ compute_pairwise_balance <- function( # Calculate balance statistic using provided function if (is.null(weights)) { balance_fn( - covariate = covariate[keep_idx], - group = binary_group[keep_idx], - weights = NULL, - reference_group = 0, # ref_group mapped to 0 + .covariate = covariate[keep_idx], + .exposure = binary_group[keep_idx], + .weights = NULL, + .reference_level = 0, # ref_group mapped to 0 na.rm = na.rm ) } else { balance_fn( - covariate = covariate[keep_idx], - group = binary_group[keep_idx], - weights = weights[keep_idx], - reference_group = 0, + .covariate = covariate[keep_idx], + .exposure = binary_group[keep_idx], + .weights = weights[keep_idx], + .reference_level = 0, na.rm = na.rm ) } diff --git a/R/geom_calibration.R b/R/geom_calibration.R index 1a832ce..cadba8f 100644 --- a/R/geom_calibration.R +++ b/R/geom_calibration.R @@ -51,7 +51,7 @@ check_model_calibration <- function( data, .fitted, .group, - treatment_level = NULL, + .focal_level = NULL, method = c("breaks", "logistic", "windowed"), bins = 10, binning_method = c("equal_width", "quantile"), @@ -82,9 +82,9 @@ check_model_calibration <- function( group_var <- data[[group_name]] - check_columns(data, fitted_name, group_name, treatment_level) + check_columns(data, fitted_name, group_name, .focal_level) - treatment_indicator <- check_treatment_level(group_var, treatment_level) + treatment_indicator <- check_treatment_level(group_var, .focal_level) df <- tibble::tibble( x_var = data[[fitted_name]], @@ -139,30 +139,30 @@ empty_calibration <- function(method = "breaks") { } } -check_treatment_level <- function(group_var, treatment_level) { +check_treatment_level <- function(group_var, .focal_level) { # Validate treatment level exists if provided - if (!is.null(treatment_level)) { + if (!is.null(.focal_level)) { unique_levels <- unique(group_var[!is.na(group_var)]) - if (length(unique_levels) > 0 && !treatment_level %in% unique_levels) { + if (length(unique_levels) > 0 && !.focal_level %in% unique_levels) { abort( - "{.code treatment_level} {.code {treatment_level}} not found in {.code .group} variable", + "{.code .focal_level} {.code {.focal_level}} not found in {.code .group} variable", error_class = "halfmoon_reference_error" ) } } # Use the helper function to create treatment indicator - create_treatment_indicator(group_var, treatment_level) + create_treatment_indicator(group_var, .focal_level) } check_columns <- function( data, fitted_name, group_name, - treatment_level, + .focal_level, call = rlang::caller_env() ) { - if (is.null(treatment_level)) { + if (is.null(.focal_level)) { if (!fitted_name %in% names(data)) { abort( "Column {.code {fitted_name}} not found in data", @@ -474,7 +474,7 @@ StatCalibration <- ggplot2::ggproto( params$conf_level <- params$conf_level %||% 0.95 params$window_size <- params$window_size %||% 0.1 params$step_size <- params$step_size %||% (params$window_size / 2) - params$treatment_level <- params$treatment_level %||% NULL + params$.focal_level <- params$.focal_level %||% NULL params$k <- params$k %||% 10 params }, @@ -487,7 +487,7 @@ StatCalibration <- ggplot2::ggproto( conf_level = 0.95, window_size = 0.1, step_size = window_size / 2, - treatment_level = NULL, + .focal_level = NULL, k = 10, binning_method = "equal_width", na.rm = FALSE @@ -521,7 +521,7 @@ StatCalibration <- ggplot2::ggproto( # Process the combined data compute_calibration_for_group( combined_data, - treatment_level, + .focal_level, method, bins, binning_method, @@ -540,7 +540,7 @@ StatCalibration <- ggplot2::ggproto( # Single group or no groups compute_calibration_for_group( data, - treatment_level, + .focal_level, method, bins, binning_method, @@ -559,7 +559,7 @@ StatCalibration <- ggplot2::ggproto( # Helper function to compute calibration for a single group compute_calibration_for_group <- function( data, - treatment_level, + .focal_level, method, bins, binning_method, @@ -574,7 +574,7 @@ compute_calibration_for_group <- function( ) { # Convert to binary using helper function truth <- data$truth - treatment_indicator <- create_treatment_indicator(truth, treatment_level) + treatment_indicator <- create_treatment_indicator(truth, .focal_level) # Create data frame for calibration computation df <- tibble::tibble( @@ -746,7 +746,7 @@ GeomCalibrationPoint <- ggplot2::ggproto( #' #' # Specify treatment level explicitly #' ggplot(nhefs_weights, aes(estimate = .fitted, truth = qsmk)) + -#' geom_calibration(treatment_level = "1") + +#' geom_calibration(.focal_level = "1") + #' geom_abline(intercept = 0, slope = 1, linetype = "dashed") + #' labs(x = "Propensity Score", y = "Observed Treatment Rate") #' @@ -767,7 +767,7 @@ geom_calibration <- function( conf_level = 0.95, window_size = 0.1, step_size = window_size / 2, - treatment_level = NULL, + .focal_level = NULL, k = 10, show_ribbon = TRUE, show_points = TRUE, @@ -797,7 +797,7 @@ geom_calibration <- function( conf_level = conf_level, window_size = window_size, step_size = step_size, - treatment_level = treatment_level, + .focal_level = .focal_level, k = k, na.rm = na.rm ) @@ -821,7 +821,7 @@ geom_calibration <- function( conf_level = conf_level, window_size = window_size, step_size = step_size, - treatment_level = treatment_level, + .focal_level = .focal_level, k = k, na.rm = na.rm, ... @@ -847,7 +847,7 @@ geom_calibration <- function( conf_level = conf_level, window_size = window_size, step_size = step_size, - treatment_level = treatment_level, + .focal_level = .focal_level, k = k, na.rm = na.rm ) diff --git a/R/geom_qq2.R b/R/geom_qq2.R index 7ef5688..d951260 100644 --- a/R/geom_qq2.R +++ b/R/geom_qq2.R @@ -29,7 +29,9 @@ #' @inheritParams ggplot2_params #' @param quantiles Numeric vector of quantiles to compute. Default is #' `seq(0.01, 0.99, 0.01)` for 99 quantiles. -#' @inheritParams treatment_param +#' @param .reference_level The reference treatment level to use for comparisons. +#' If `NULL` (default), uses the first level for factors or the minimum value +#' for numeric variables. #' #' @return A ggplot2 layer. #' @family ggplot2 functions @@ -74,7 +76,7 @@ geom_qq2 <- function( show.legend = NA, inherit.aes = TRUE, quantiles = seq(0.01, 0.99, 0.01), - treatment_level = NULL, + .reference_level = NULL, ... ) { ggplot2::layer( @@ -88,7 +90,7 @@ geom_qq2 <- function( params = list( na.rm = na.rm, quantiles = quantiles, - treatment_level = treatment_level, + .reference_level = .reference_level, ... ) ) @@ -106,7 +108,7 @@ geom_qq2 <- function( #' @param show.legend Show legend? Default NA. #' @param inherit.aes Inherit aesthetics? Default TRUE. #' @param quantiles Numeric vector of quantiles to compute. -#' @param treatment_level The reference treatment level to use for comparisons. +#' @param .reference_level The reference treatment level to use for comparisons. #' @param include_observed For compatibility with qq(). When weights are present, #' this determines if an additional "observed" group is added. Default FALSE #' for stat_qq2 to avoid duplication when using facets/colors. @@ -123,7 +125,7 @@ stat_qq2 <- function( show.legend = NA, inherit.aes = TRUE, quantiles = seq(0.01, 0.99, 0.01), - treatment_level = NULL, + .reference_level = NULL, include_observed = FALSE, ... ) { @@ -138,7 +140,7 @@ stat_qq2 <- function( params = list( na.rm = na.rm, quantiles = quantiles, - treatment_level = treatment_level, + .reference_level = .reference_level, include_observed = include_observed, ... ) @@ -155,7 +157,7 @@ stat_qq2 <- function( #' @param group_signatures Character vector mapping groups to signatures #' @param unique_signatures Character vector of all unique signatures #' @param aes_cols Character vector of aesthetic column names -#' @param treatment_level The treatment level to use as reference +#' @param .reference_level The treatment level to use as reference #' @param quantiles Numeric vector of quantiles to compute #' @param na.rm Logical whether to remove NA values #' @@ -167,7 +169,7 @@ process_aesthetic_group <- function( group_signatures, unique_signatures, aes_cols, - treatment_level, + .reference_level, quantiles, na.rm ) { @@ -178,7 +180,7 @@ process_aesthetic_group <- function( # Create temporary data frame with binary treatment temp_data <- data.frame( .var = combined_data$sample, - .group = as.integer(combined_data$treatment == treatment_level), + .group = as.integer(combined_data$treatment == .reference_level), stringsAsFactors = FALSE ) @@ -193,18 +195,18 @@ process_aesthetic_group <- function( qq_result <- check_qq( .data = temp_data, .var = .var, - .group = .group, - .wts = if (!is.null(wts_arg)) rlang::sym(wts_arg) else NULL, + .exposure = .group, + .weights = if (!is.null(wts_arg)) rlang::sym(wts_arg) else NULL, quantiles = quantiles, - treatment_level = 1L, # We already converted to 0/1 + .reference_level = 1L, # We already converted to 0/1 na.rm = na.rm, include_observed = FALSE ) # Build result data frame preserving aesthetics result_df <- data.frame( - treated_quantiles = qq_result$treated_quantiles, - untreated_quantiles = qq_result$untreated_quantiles, + exposed_quantiles = qq_result$exposed_quantiles, + unexposed_quantiles = qq_result$unexposed_quantiles, group = which(unique_signatures == sig), PANEL = combined_data$PANEL[1] ) @@ -228,8 +230,8 @@ StatQq2 <- ggplot2::ggproto( ggplot2::Stat, required_aes = c("sample", "treatment"), default_aes = ggplot2::aes( - x = ggplot2::after_stat(treated_quantiles), - y = ggplot2::after_stat(untreated_quantiles), + x = ggplot2::after_stat(exposed_quantiles), + y = ggplot2::after_stat(unexposed_quantiles), weight = NULL ), dropped_aes = "weight", @@ -241,24 +243,24 @@ StatQq2 <- ggplot2::ggproto( data, scales, quantiles = seq(0.01, 0.99, 0.01), - treatment_level = NULL, + .reference_level = NULL, na.rm = TRUE, include_observed = FALSE ) { - # Handle NULL treatment_level - if (is.null(treatment_level)) { + # Handle NULL .reference_level + if (is.null(.reference_level)) { if (is.factor(data$treatment)) { # Factor - use the last level - treatment_level <- levels(data$treatment)[length(levels( + .reference_level <- levels(data$treatment)[length(levels( data$treatment ))] } else { # Numeric or character treatment_values <- unique(data$treatment[!is.na(data$treatment)]) if (length(treatment_values) == 0) { - treatment_level <- 1 # Default for empty data + .reference_level <- 1 # Default for empty data } else { - treatment_level <- max(treatment_values) + .reference_level <- max(treatment_values) } } } @@ -292,7 +294,7 @@ StatQq2 <- ggplot2::ggproto( group_signatures = group_signatures, unique_signatures = unique_signatures, aes_cols = aes_cols, - treatment_level = treatment_level, + .reference_level = .reference_level, quantiles = quantiles, na.rm = na.rm ) @@ -302,7 +304,7 @@ StatQq2 <- ggplot2::ggproto( # No groups, process all data together temp_data <- data.frame( .var = data$sample, - .group = as.integer(data$treatment == treatment_level), + .group = as.integer(data$treatment == .reference_level), stringsAsFactors = FALSE ) @@ -314,21 +316,21 @@ StatQq2 <- ggplot2::ggproto( wts_arg <- NULL } - qq_result <- qq( + qq_result <- check_qq( .data = temp_data, .var = .var, - .group = .group, - .wts = if (!is.null(wts_arg)) rlang::sym(wts_arg) else NULL, + .exposure = .group, + .weights = if (!is.null(wts_arg)) rlang::sym(wts_arg) else NULL, quantiles = quantiles, - treatment_level = 1L, # We already converted to 0/1 + .reference_level = 1L, # We already converted to 0/1 na.rm = na.rm, include_observed = FALSE ) # Return data frame without x and y; let `after_stat()` handle that data.frame( - treated_quantiles = qq_result$treated_quantiles, - untreated_quantiles = qq_result$untreated_quantiles, + exposed_quantiles = qq_result$exposed_quantiles, + unexposed_quantiles = qq_result$unexposed_quantiles, PANEL = data$PANEL[1], group = 1 ) diff --git a/R/geom_roc.R b/R/geom_roc.R index bc277e2..be10138 100644 --- a/R/geom_roc.R +++ b/R/geom_roc.R @@ -4,7 +4,7 @@ #' Emphasizes the balance interpretation where AUC around 0.5 indicates good balance. #' #' @param mapping Set of aesthetic mappings. Must include `estimate` (propensity scores/predictions) -#' and `truth` (treatment/outcome variable). If specified, inherits from the plot. +#' and `exposure` (treatment/outcome variable). If specified, inherits from the plot. #' @param data Data frame to use. If not specified, inherits from the plot. #' @param stat Statistical transformation to use. Default is "roc". #' @param position Position adjustment. Default is "identity". @@ -19,7 +19,7 @@ #' @examples #' # Basic usage #' library(ggplot2) -#' ggplot(nhefs_weights, aes(estimate = .fitted, truth = qsmk)) + +#' ggplot(nhefs_weights, aes(estimate = .fitted, exposure = qsmk)) + #' geom_roc() + #' geom_abline(intercept = 0, slope = 1, linetype = "dashed") #' @@ -31,7 +31,7 @@ #' values_to = "weight" #' ) #' -#' ggplot(long_data, aes(estimate = .fitted, truth = qsmk, weight = weight)) + +#' ggplot(long_data, aes(estimate = .fitted, exposure = qsmk, weight = weight)) + #' geom_roc(aes(color = weight_type)) + #' geom_abline(intercept = 0, slope = 1, linetype = "dashed") #' @@ -45,7 +45,7 @@ geom_roc <- function( show.legend = NA, inherit.aes = TRUE, linewidth = 0.5, - treatment_level = NULL, + .focal_level = NULL, ... ) { ggplot2::layer( @@ -59,7 +59,7 @@ geom_roc <- function( params = list( na.rm = na.rm, linewidth = linewidth, - treatment_level = treatment_level, + .focal_level = .focal_level, ... ) ) @@ -83,7 +83,7 @@ stat_roc <- function( na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, - treatment_level = NULL, + .focal_level = NULL, ... ) { ggplot2::layer( @@ -96,7 +96,7 @@ stat_roc <- function( inherit.aes = inherit.aes, params = list( na.rm = na.rm, - treatment_level = treatment_level, + .focal_level = .focal_level, ... ) ) @@ -109,7 +109,7 @@ stat_roc <- function( StatRoc <- ggplot2::ggproto( "StatRoc", ggplot2::Stat, - required_aes = c("estimate", "truth"), + required_aes = c("estimate", "exposure"), default_aes = ggplot2::aes( x = ggplot2::after_stat(fpr), # 1 - specificity y = ggplot2::after_stat(tpr), # sensitivity @@ -117,19 +117,19 @@ StatRoc <- ggplot2::ggproto( ), dropped_aes = "weight", # Tell ggplot2 to drop weight after computation - compute_panel = function(data, scales, na.rm = TRUE, treatment_level = NULL) { + compute_panel = function(data, scales, na.rm = TRUE, .focal_level = NULL) { # If we have multiple groups, identify which ones should be merged if ("group" %in% names(data) && length(unique(data$group)) > 1) { groups <- split(data, data$group) # Create signatures for each group based on aesthetic values - # We want to merge groups that differ only by truth factor levels + # We want to merge groups that differ only by exposure factor levels # but preserve groups that differ by other aesthetics like colour aes_cols <- setdiff( names(data), c( "estimate", - "truth", + "exposure", "weight", "PANEL", "group", @@ -156,79 +156,79 @@ StatRoc <- ggplot2::ggproto( group_id <- groups[[matching_groups[1]]]$group[1] # Process the combined data - compute_roc_for_group(combined_data, na.rm, treatment_level, group_id) + compute_roc_for_group(combined_data, na.rm, .focal_level, group_id) }) results } else { # Single group or no groups - compute_roc_for_group(data, na.rm, treatment_level, data$group[1]) + compute_roc_for_group(data, na.rm, .focal_level, data$group[1]) } } ) # Helper function to compute ROC for a single group -compute_roc_for_group <- function(data, na.rm, treatment_level, group_id) { - # Extract estimate (predictor) and truth +compute_roc_for_group <- function(data, na.rm, .focal_level, group_id) { + # Extract estimate (predictor) and exposure estimate <- data$estimate - truth <- data$truth + exposure <- data$exposure weights <- data$weight %||% rep(1, length(estimate)) # Remove missing values if requested if (na.rm) { - complete_cases <- stats::complete.cases(estimate, truth, weights) + complete_cases <- stats::complete.cases(estimate, exposure, weights) estimate <- estimate[complete_cases] - truth <- truth[complete_cases] + exposure <- exposure[complete_cases] weights <- weights[complete_cases] } - # Check that truth has exactly 2 unique values - unique_truth <- if (is.factor(truth)) { - levels(truth) + # Check that exposure has exactly 2 unique values + unique_exposure <- if (is.factor(exposure)) { + levels(exposure) } else { - unique(truth[!is.na(truth)]) + unique(exposure[!is.na(exposure)]) } - if (length(unique_truth) != 2) { + if (length(unique_exposure) != 2) { abort( - "truth must have exactly 2 unique values for ROC curve", + "exposure must have exactly 2 unique values for ROC curve", error_class = "halfmoon_group_error" ) } - # Convert truth to binary - if (is.null(treatment_level)) { - treatment_level <- if (is.factor(truth)) { - levels(truth)[length(levels(truth))] + # Convert exposure to binary + if (is.null(.focal_level)) { + .focal_level <- if (is.factor(exposure)) { + levels(exposure)[length(levels(exposure))] } else { - max(unique_truth) + max(unique_exposure) } } - # Handle both factor and non-factor truth variables - if (is.factor(truth)) { + # Handle both factor and non-factor exposure variables + if (is.factor(exposure)) { # For factors, ensure we're comparing as character to handle numeric-looking levels - truth_binary <- as.integer( - as.character(truth) == as.character(treatment_level) + exposure_binary <- as.integer( + as.character(exposure) == as.character(.focal_level) ) } else { - truth_binary <- as.integer(truth == treatment_level) + exposure_binary <- as.integer(exposure == .focal_level) } # Create a factor for compute_roc_curve_imp - truth_factor <- factor(truth_binary, levels = c(0, 1)) + exposure_factor <- factor(exposure_binary, levels = c(0, 1)) roc_data <- compute_roc_curve_imp( - truth_factor, + exposure_factor, estimate, weights, - treatment_level = "1" # We've already converted to binary + .focal_level = "1" # We've already converted to binary ) # Get aesthetic columns to preserve (like colour, linetype, etc.) aes_cols <- setdiff( names(data), - c("estimate", "truth", "weight", "PANEL", "group", "x", "y") + c("estimate", "exposure", "weight", "PANEL", "group", "x", "y") ) # Create base result diff --git a/R/plot_balance.R b/R/plot_balance.R index 4454d23..51ca7c4 100644 --- a/R/plot_balance.R +++ b/R/plot_balance.R @@ -46,7 +46,7 @@ #' nhefs_weights, #' c(age, education, race), #' qsmk, -#' .wts = c(w_ate, w_att) +#' .weights = c(w_ate, w_att) #' ) #' #' # Create balance plot @@ -67,7 +67,7 @@ #' nhefs_weights, #' c(age, wt71, sex), #' alcoholfreq_cat, -#' .wts = w_cat_ate, +#' .weights = w_cat_ate, #' .metrics = c("smd", "vr") #' ) #' plot_balance(balance_cat) diff --git a/R/plot_calibration.R b/R/plot_calibration.R index 281c01b..87f3909 100644 --- a/R/plot_calibration.R +++ b/R/plot_calibration.R @@ -44,7 +44,7 @@ #' plot_model_calibration(nhefs_weights, .fitted, qsmk, method = "windowed") #' #' # Specify treatment level explicitly -#' plot_model_calibration(nhefs_weights, .fitted, qsmk, treatment_level = "1") +#' plot_model_calibration(nhefs_weights, .fitted, qsmk, .focal_level = "1") #' #' # Method 2: Using model objects #' # Fit a propensity score model @@ -72,7 +72,7 @@ plot_model_calibration <- function(x, ...) { #' Can be unquoted (e.g., `.fitted`) or quoted (e.g., `".fitted"`). #' @param .group Column name of treatment/group variable. #' Can be unquoted (e.g., `qsmk`) or quoted (e.g., `"qsmk"`). -#' @param treatment_level Value indicating which level of `.group` represents treatment. +#' @param .focal_level Value indicating which level of `.group` represents treatment. #' If NULL (default), uses the last level for factors or max value for numeric. #' @param method Character; calibration method - "breaks", "logistic", or "windowed". #' @param bins Integer >1; number of bins for the "breaks" method. @@ -90,7 +90,7 @@ plot_model_calibration.data.frame <- function( x, .fitted, .group, - treatment_level = NULL, + .focal_level = NULL, method = "breaks", bins = 10, smooth = TRUE, @@ -123,7 +123,7 @@ plot_model_calibration.data.frame <- function( conf_level = conf_level, window_size = window_size, step_size = step_size, - treatment_level = treatment_level, + .focal_level = .focal_level, k = k, show_ribbon = include_ribbon, show_points = include_points, @@ -172,7 +172,7 @@ plot_model_calibration.data.frame <- function( #' @export plot_model_calibration.glm <- function( x, - treatment_level = NULL, + .focal_level = NULL, method = "breaks", bins = 10, smooth = TRUE, @@ -206,7 +206,7 @@ plot_model_calibration.glm <- function( plot_data, .fitted = .fitted, .group = .group, - treatment_level = treatment_level, + .focal_level = .focal_level, method = method, bins = bins, smooth = smooth, diff --git a/R/plot_ess.R b/R/plot_ess.R index c3c4332..26f4e38 100644 --- a/R/plot_ess.R +++ b/R/plot_ess.R @@ -25,7 +25,7 @@ #' #' @param .data A data frame, either: #' - Output from `check_ess()` containing ESS calculations -#' - Raw data to compute ESS from (requires `.wts` to be specified) +#' - Raw data to compute ESS from (requires `.weights` to be specified) #' @inheritParams check_ess #' @param fill_color Color for the bars when `.group` is not provided. #' Default is "#0172B1". @@ -44,41 +44,41 @@ #' #' @examples #' # Overall ESS for different weighting schemes -#' plot_ess(nhefs_weights, .wts = c(w_ate, w_att, w_atm)) +#' plot_ess(nhefs_weights, .weights = c(w_ate, w_att, w_atm)) #' #' # ESS by treatment group (binary exposure) -#' plot_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk) +#' plot_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk) #' #' # ESS by treatment group (categorical exposure) -#' plot_ess(nhefs_weights, .wts = w_cat_ate, .group = alcoholfreq_cat) +#' plot_ess(nhefs_weights, .weights = w_cat_ate, .group = alcoholfreq_cat) #' #' # ESS by age quartiles -#' plot_ess(nhefs_weights, .wts = w_ate, .group = age) +#' plot_ess(nhefs_weights, .weights = w_ate, .group = age) #' #' # Customize quantiles for continuous variable -#' plot_ess(nhefs_weights, .wts = w_ate, .group = age, +#' plot_ess(nhefs_weights, .weights = w_ate, .group = age, #' n_tiles = 5, tile_labels = c("Youngest", "Young", "Middle", "Older", "Oldest")) #' #' # Without percentage labels -#' plot_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk, +#' plot_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk, #' show_labels = FALSE) #' #' # Custom styling -#' plot_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk, +#' plot_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk, #' alpha = 0.6, fill_color = "steelblue", #' reference_line_color = "red") #' #' # Using pre-computed ESS data -#' ess_data <- check_ess(nhefs_weights, .wts = c(w_ate, w_att)) +#' ess_data <- check_ess(nhefs_weights, .weights = c(w_ate, w_att)) #' plot_ess(ess_data) #' #' # Show ESS on original scale instead of percentage -#' plot_ess(nhefs_weights, .wts = c(w_ate, w_att), percent_scale = FALSE) +#' plot_ess(nhefs_weights, .weights = c(w_ate, w_att), percent_scale = FALSE) #' #' @export plot_ess <- function( .data, - .wts = NULL, + .weights = NULL, .group = NULL, include_observed = TRUE, n_tiles = 4, @@ -98,7 +98,7 @@ plot_ess <- function( # Compute ESS from raw data .data <- check_ess( .data = .data, - .wts = {{ .wts }}, + .weights = {{ .weights }}, .group = {{ .group }}, include_observed = include_observed, n_tiles = n_tiles, diff --git a/R/plot_mirror_distributions.R b/R/plot_mirror_distributions.R index 2934c07..a14a819 100644 --- a/R/plot_mirror_distributions.R +++ b/R/plot_mirror_distributions.R @@ -22,10 +22,10 @@ #' #' @param .data A data frame containing the variables. #' @param .var The variable to plot. Supports tidyselect syntax. Can be unquoted. -#' @param .group Column name of treatment/group variable. Supports tidyselect syntax. Can be unquoted. +#' @param .exposure Column name of treatment/group variable. Supports tidyselect syntax. Can be unquoted. #' For binary variables, must have exactly 2 levels. For categorical variables (>2 levels), #' creates pairwise comparisons against a reference group. -#' @param .wts Optional weighting variable(s). Can be unquoted variable names, tidyselect syntax, +#' @param .weights Optional weighting variable(s). Can be unquoted variable names, tidyselect syntax, #' a character vector, or NULL. Multiple weights can be provided to compare #' different weighting schemes. Default is NULL (unweighted). #' @param type Character; type of plot - "histogram" or "density". Default is "histogram". @@ -37,13 +37,13 @@ #' Can be numeric or character (e.g., "nrd0", "sj"). #' @param adjust Numeric; bandwidth adjustment factor for density. Only used when #' type = "density". Default is 1. -#' @param include_unweighted Logical. If using `.wts`, also show unweighted +#' @param include_unweighted Logical. If using `.weights`, also show unweighted #' distribution? Defaults to TRUE. #' @param alpha Numeric; transparency level for fills. Default is 0.6. #' @param na.rm Logical; if TRUE, drop NA values before plotting. -#' @param reference_group The reference group level for categorical exposures (>2 levels). +#' @param .reference_level The reference group level for categorical exposures (>2 levels). #' Can be a string (group level) or numeric (position). Defaults to 1 (first level). -#' Only used when .group has more than 2 levels. +#' Only used when .exposure has more than 2 levels. #' #' @return A ggplot2 object. #' @@ -63,15 +63,15 @@ #' plot_mirror_distributions(nhefs_weights, age, qsmk, type = "density") #' #' # With weighting -#' plot_mirror_distributions(nhefs_weights, age, qsmk, .wts = w_ate) +#' plot_mirror_distributions(nhefs_weights, age, qsmk, .weights = w_ate) #' #' # Compare multiple weighting schemes -#' plot_mirror_distributions(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) +#' plot_mirror_distributions(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) #' #' # Customize appearance #' plot_mirror_distributions( #' nhefs_weights, age, qsmk, -#' .wts = w_ate, +#' .weights = w_ate, #' type = "density", #' alpha = 0.7 #' ) @@ -79,7 +79,7 @@ #' # Without unweighted comparison #' plot_mirror_distributions( #' nhefs_weights, age, qsmk, -#' .wts = w_ate, +#' .weights = w_ate, #' include_unweighted = FALSE #' ) #' @@ -96,16 +96,16 @@ #' nhefs_weights, #' wt71, #' alcoholfreq_cat, -#' .wts = w_cat_ate, -#' reference_group = "none" +#' .weights = w_cat_ate, +#' .reference_level = "none" #' ) #' #' @export plot_mirror_distributions <- function( .data, .var, - .group, - .wts = NULL, + .exposure, + .weights = NULL, type = c("histogram", "density"), mirror_axis = "y", bins = 30, @@ -115,21 +115,21 @@ plot_mirror_distributions <- function( include_unweighted = TRUE, alpha = 0.6, na.rm = FALSE, - reference_group = 1L + .reference_level = 1L ) { type <- match.arg(type) var_quo <- rlang::enquo(.var) - group_quo <- rlang::enquo(.group) - wts_quo <- rlang::enquo(.wts) + exposure_quo <- rlang::enquo(.exposure) + wts_quo <- rlang::enquo(.weights) validate_data_frame(.data) var_name <- get_column_name(var_quo, ".var") - group_name <- get_column_name(group_quo, ".group") + group_name <- get_column_name(exposure_quo, ".exposure") validate_column_exists(.data, var_name, ".var") - validate_column_exists(.data, group_name, ".group") + validate_column_exists(.data, group_name, ".exposure") if (!na.rm && any(is.na(.data[[var_name]]))) { abort( @@ -153,19 +153,19 @@ plot_mirror_distributions <- function( if (is_categorical) { # Categorical exposure - reference_group <- determine_reference_group(group_var, reference_group) + .reference_level <- determine_reference_group(group_var, .reference_level) # Create binary comparisons using purrr - comparison_levels <- setdiff(group_levels, reference_group) + comparison_levels <- setdiff(group_levels, .reference_level) .data <- purrr::map_dfr(comparison_levels, \(level) { comparison_df <- .data |> - dplyr::filter(.data[[group_name]] %in% c(reference_group, level)) |> - dplyr::mutate(comparison = paste0(level, " vs ", reference_group)) + dplyr::filter(.data[[group_name]] %in% c(.reference_level, level)) |> + dplyr::mutate(comparison = paste0(level, " vs ", .reference_level)) # Update the group factor to only have the two levels comparison_df[[group_name]] <- factor( comparison_df[[group_name]], - levels = c(reference_group, level) + levels = c(.reference_level, level) ) comparison_df }) @@ -174,7 +174,7 @@ plot_mirror_distributions <- function( group_levels <- extract_group_levels(group_var, require_binary = TRUE) } else { abort( - "Group variable must have at least two levels", + "Exposure variable must have at least two levels", error_class = "halfmoon_group_error" ) } diff --git a/R/plot_qq.R b/R/plot_qq.R index 09de206..bb0b642 100644 --- a/R/plot_qq.R +++ b/R/plot_qq.R @@ -18,14 +18,14 @@ #' @param ... Arguments passed to methods (see Methods section). #' @param .var Variable to plot. Can be unquoted (e.g., `age`) or quoted (e.g., `"age"`). #' @param .group Column name of treatment/group variable. Can be unquoted (e.g., `qsmk`) or quoted (e.g., `"qsmk"`). -#' @param .wts Optional weighting variable(s). Can be unquoted variable names, +#' @param .weights Optional weighting variable(s). Can be unquoted variable names, #' a character vector, or NULL. Multiple weights can be provided to compare #' different weighting schemes. Default is NULL (unweighted). #' @param quantiles Numeric vector of quantiles to compute. Default is #' `seq(0.01, 0.99, 0.01)` for 99 quantiles. -#' @param include_observed Logical. If using `.wts`, also show observed +#' @param include_observed Logical. If using `.weights`, also show observed #' (unweighted) QQ plot? Defaults to TRUE. -#' @param treatment_level The reference treatment level to use for comparisons. +#' @param .reference_level The reference treatment level to use for comparisons. #' If `NULL` (default), uses the last level for factors or the maximum value for numeric variables. #' @param na.rm Logical; if TRUE, drop NA values before computation. #' @@ -49,16 +49,16 @@ #' plot_qq(nhefs_weights, age, qsmk) #' #' # With weighting -#' plot_qq(nhefs_weights, age, qsmk, .wts = w_ate) +#' plot_qq(nhefs_weights, age, qsmk, .weights = w_ate) #' #' # Compare multiple weighting schemes -#' plot_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) +#' plot_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) #' #' # For propensity scores -#' plot_qq(nhefs_weights, .fitted, qsmk, .wts = w_ate) +#' plot_qq(nhefs_weights, .fitted, qsmk, .weights = w_ate) #' #' # Without observed comparison -#' plot_qq(nhefs_weights, age, qsmk, .wts = w_ate, include_observed = FALSE) +#' plot_qq(nhefs_weights, age, qsmk, .weights = w_ate, include_observed = FALSE) #' #' @export plot_qq <- function(.data, ...) { @@ -71,10 +71,10 @@ plot_qq.default <- function( .data, .var, .group, - .wts = NULL, + .weights = NULL, quantiles = seq(0.01, 0.99, 0.01), include_observed = TRUE, - treatment_level = NULL, + .reference_level = NULL, na.rm = FALSE, ... ) { @@ -116,38 +116,38 @@ plot_qq.default <- function( if (length(group_levels) != 2) { abort( - "Group variable must have exactly 2 levels", + "Exposure variable must have exactly 2 levels", error_class = "halfmoon_group_error" ) } - # Handle NULL treatment_level - if (is.null(treatment_level)) { + # Handle NULL .reference_level + if (is.null(.reference_level)) { if (is.factor(group_var)) { # For factors, use the last level - treatment_level <- group_levels[length(group_levels)] + .reference_level <- group_levels[length(group_levels)] } else { # For numeric, use the maximum value - treatment_level <- max(group_levels) + .reference_level <- max(group_levels) } } - # Validate treatment_level exists - if (!treatment_level %in% group_levels) { + # Validate .reference_level exists + if (!.reference_level %in% group_levels) { abort( - "{.arg treatment_level} '{treatment_level}' not found in {.arg .group} levels: {.val {group_levels}}", + "{.arg .reference_level} '{(.reference_level)}' not found in {.arg .group} levels: {.val {group_levels}}", error_class = "halfmoon_reference_error" ) } - ref_group <- treatment_level - comp_group <- setdiff(group_levels, treatment_level) + ref_group <- .reference_level + comp_group <- setdiff(group_levels, .reference_level) # Get variable name for labels var_name <- get_column_name(var_quo, ".var") # Prepare data in long format - wts_quo <- rlang::enquo(.wts) + wts_quo <- rlang::enquo(.weights) if (!rlang::quo_is_null(wts_quo)) { # Get weight columns @@ -192,7 +192,7 @@ plot_qq.default <- function( geom_qq2( ggplot2::aes(color = method), quantiles = quantiles, - treatment_level = treatment_level, + .reference_level = .reference_level, na.rm = na.rm ) } else { @@ -203,7 +203,7 @@ plot_qq.default <- function( ) + geom_qq2( quantiles = quantiles, - treatment_level = treatment_level, + .reference_level = .reference_level, na.rm = na.rm ) } @@ -234,8 +234,8 @@ plot_qq.halfmoon_qq <- function(.data, ...) { p <- ggplot2::ggplot( .data, ggplot2::aes( - x = .data$untreated_quantiles, - y = .data$treated_quantiles, + x = .data$unexposed_quantiles, + y = .data$exposed_quantiles, color = .data$method ) ) + @@ -244,7 +244,7 @@ plot_qq.halfmoon_qq <- function(.data, ...) { } else { p <- ggplot2::ggplot( .data, - ggplot2::aes(x = .data$untreated_quantiles, y = .data$treated_quantiles) + ggplot2::aes(x = .data$unexposed_quantiles, y = .data$exposed_quantiles) ) + ggplot2::geom_line(linewidth = 1) + ggplot2::geom_point(size = 0.5, alpha = 0.7) @@ -260,8 +260,8 @@ plot_qq.halfmoon_qq <- function(.data, ...) { alpha = 0.8 ) + ggplot2::labs( - x = "Control group quantiles", - y = "Treatment group quantiles" + x = "Unexposed group quantiles", + y = "Exposed group quantiles" ) + ggplot2::theme_minimal() + ggplot2::coord_equal() diff --git a/R/plot_stratified_residuals.R b/R/plot_stratified_residuals.R index 1236ffe..e203ba1 100644 --- a/R/plot_stratified_residuals.R +++ b/R/plot_stratified_residuals.R @@ -1,21 +1,21 @@ #' Create stratified residual diagnostic plots #' -#' Create diagnostic plots to assess differences between treatment group after adjustment. +#' Create diagnostic plots to assess differences between .exposure group after adjustment. #' This function plots residuals #' from an outcome model against propensity scores (or fitted values), -#' stratified by treatment group, to reveal model mis-specification. +#' stratified by .exposure group, to reveal model mis-specification. #' #' @details #' This diagnostic plot was originally suggested by Rosenbaum and Rubin (1983) #' and revisited by D'Agostino McGowan, D'Agostino, and D'Agostino (2023). #' The key idea is that plotting residuals against propensity scores -#' or fitted values by treatment group can reveal non-linear relationships or -#' heterogeneous treatment effects that might be obscured in standard +#' or fitted values by .exposure group can reveal non-linear relationships or +#' heterogeneous .exposure effects that might be obscured in standard #' residuals-vs-fitted plots. #' #' The function supports two approaches: #' - For regression models (lm/glm): Extracts residuals and fitted values automatically -#' - For data frames: Uses specified columns for residuals, treatment, and x-axis values +#' - For data frames: Uses specified columns for residuals, .exposure, and x-axis values #' #' @param x Either a fitted model object (lm or glm) or a data frame #' @param ... Additional arguments passed to methods @@ -26,33 +26,33 @@ #' \dontrun{ #' library(ggplot2) #' -#' # Simulate data with treatment effect heterogeneity +#' # Simulate data with .exposure effect heterogeneity #' set.seed(8) #' n <- 1000 #' x <- rnorm(n) #' ps <- plogis(x) # True propensity score -#' treatment <- rbinom(n, 1, ps) +#' .exposure <- rbinom(n, 1, ps) #' y1 <- 0.5 * x + rnorm(n) #' y0 <- -0.5 * x + rnorm(n) -#' y <- treatment * y1 + (1 - treatment) * y0 +#' y <- .exposure * y1 + (1 - .exposure) * y0 #' #' # Method 1: Using model objects #' # Fit misspecified model (missing interaction) -#' model_wrong <- lm(y ~ treatment + x) +#' model_wrong <- lm(y ~ .exposure + x) #' #' # Plot with fitted values #' plot_stratified_residuals( #' model_wrong, -#' treatment = treatment, +#' .exposure = .exposure, #' plot_type = "both" #' ) #' #' # Plot with propensity scores -#' ps_model <- glm(treatment ~ x, family = binomial) +#' ps_model <- glm(.exposure ~ x, family = binomial) #' #' plot_stratified_residuals( #' model_wrong, -#' treatment = treatment, +#' .exposure = .exposure, #' ps_model = ps_model, #' plot_type = "color" #' ) @@ -60,7 +60,7 @@ #' # Method 2: Using data frame #' library(dplyr) #' plot_data <- data.frame( -#' treatment = treatment, +#' .exposure = .exposure, #' residuals = residuals(model_wrong), #' fitted_values = fitted(model_wrong), #' propensity_score = fitted(ps_model) @@ -68,7 +68,7 @@ #' #' plot_stratified_residuals( #' plot_data, -#' treatment = treatment, +#' .exposure = .exposure, #' residuals = residuals, #' x_var = propensity_score, #' plot_type = "facet" @@ -94,14 +94,14 @@ plot_stratified_residuals <- function(x, ...) { } #' @rdname plot_stratified_residuals -#' @param treatment A vector indicating treatment group membership. +#' @param .exposure A vector indicating .exposure group membership. #' Must have exactly two unique levels. For data frames, can be #' an unquoted column name. #' @param ps_model Optional propensity score model (glm object). #' If provided, uses propensity scores instead of fitted values. #' @param plot_type Character; type of plot - "color" (default), "facet", or "both". -#' - "color": Single plot with points colored by treatment -#' - "facet": Separate facets for each treatment group +#' - "color": Single plot with points colored by .exposure +#' - "facet": Separate facets for each .exposure group #' - "both": Both color and faceting #' @param smooth Logical; whether to add loess smoothing curves. Default is TRUE. #' @param smooth_span Numeric; span parameter for loess smoothing. Default is 1. @@ -110,7 +110,7 @@ plot_stratified_residuals <- function(x, ...) { #' @export plot_stratified_residuals.lm <- function( x, - treatment, + .exposure, ps_model = NULL, plot_type = c("color", "facet", "both"), smooth = TRUE, @@ -122,9 +122,9 @@ plot_stratified_residuals.lm <- function( plot_type <- rlang::arg_match(plot_type) # Validate required arguments - if (missing(treatment)) { + if (missing(.exposure)) { abort( - "Argument {.arg treatment} is required", + "Argument {.arg .exposure} is required", error_class = "halfmoon_arg_error" ) } @@ -153,7 +153,7 @@ plot_stratified_residuals.lm <- function( plot_stratified_residuals_impl( .residuals = .residuals, .ps_or_fitted = .ps_or_fitted, - .treatment = treatment, + ..exposure = .exposure, plot_type = plot_type, smooth = smooth, smooth_span = smooth_span, @@ -174,7 +174,7 @@ plot_stratified_residuals.glm <- plot_stratified_residuals.lm #' @export plot_stratified_residuals.data.frame <- function( x, - treatment, + .exposure, residuals, x_var, plot_type = c("color", "facet", "both"), @@ -190,14 +190,14 @@ plot_stratified_residuals.data.frame <- function( validate_data_frame(x) # Extract column names using tidyselect - treatment_quo <- rlang::enquo(treatment) + .exposure_quo <- rlang::enquo(.exposure) residuals_quo <- rlang::enquo(residuals) x_var_quo <- rlang::enquo(x_var) - # Get treatment column - treatment_name <- get_column_name(treatment_quo, "treatment") - validate_column_exists(x, treatment_name, "treatment") - .treatment <- x[[treatment_name]] + # Get .exposure column + .exposure_name <- get_column_name(.exposure_quo, ".exposure") + validate_column_exists(x, .exposure_name, ".exposure") + ..exposure <- x[[.exposure_name]] # Get residuals column residuals_name <- get_column_name(residuals_quo, "residuals") @@ -220,7 +220,7 @@ plot_stratified_residuals.data.frame <- function( plot_stratified_residuals_impl( .residuals = .residuals, .ps_or_fitted = .ps_or_fitted, - .treatment = .treatment, + ..exposure = ..exposure, plot_type = plot_type, smooth = smooth, smooth_span = smooth_span, @@ -234,7 +234,7 @@ plot_stratified_residuals.data.frame <- function( plot_stratified_residuals_impl <- function( .residuals, .ps_or_fitted, - .treatment, + ..exposure, plot_type, smooth, smooth_span, @@ -246,8 +246,8 @@ plot_stratified_residuals_impl <- function( validate_numeric(.residuals, ".residuals") validate_numeric(.ps_or_fitted, ".ps_or_fitted") - # Validate treatment has exactly 2 levels - validate_binary_group(.treatment, ".treatment") + # Validate .exposure has exactly 2 levels + validate_binary_group(..exposure, ".exposure", call = rlang::caller_env()) # Check lengths validate_equal_length( @@ -256,13 +256,13 @@ plot_stratified_residuals_impl <- function( ".residuals", ".ps_or_fitted" ) - validate_equal_length(.residuals, .treatment, ".residuals", ".treatment") + validate_equal_length(.residuals, ..exposure, ".residuals", "..exposure") # Create data frame for plotting plot_data <- data.frame( residuals = .residuals, x_var = .ps_or_fitted, - treatment = as.factor(.treatment) + .exposure = as.factor(..exposure) ) # Handle missing values @@ -280,7 +280,7 @@ plot_stratified_residuals_impl <- function( if (plot_type %in% c("color", "both")) { p <- p + ggplot2::geom_point( - ggplot2::aes(color = .data$treatment), + ggplot2::aes(color = .data$.exposure), alpha = alpha ) } else { @@ -292,7 +292,7 @@ plot_stratified_residuals_impl <- function( if (plot_type %in% c("color", "both")) { p <- p + ggplot2::geom_smooth( - ggplot2::aes(color = .data$treatment), + ggplot2::aes(color = .data$.exposure), method = "loess", formula = y ~ x, se = FALSE, @@ -311,7 +311,7 @@ plot_stratified_residuals_impl <- function( # Add faceting if requested if (plot_type %in% c("facet", "both")) { - p <- p + ggplot2::facet_wrap(~treatment) + p <- p + ggplot2::facet_wrap(~.exposure) } # Styling diff --git a/R/utils-documentation.R b/R/utils-documentation.R index 7f33075..5543393 100644 --- a/R/utils-documentation.R +++ b/R/utils-documentation.R @@ -4,12 +4,12 @@ #' #' This function exists solely to document parameters shared across balance functions. #' -#' @param covariate A numeric vector containing the covariate values to compare. -#' @param group A vector (factor or numeric) indicating group membership. Must +#' @param .covariate A numeric vector containing the covariate values to compare. +#' @param .exposure A vector (factor or numeric) indicating group membership. Must #' have exactly two unique levels. -#' @param weights An optional numeric vector of case weights. If provided, must +#' @param .weights An optional numeric vector of case weights. If provided, must #' have the same length as other input vectors. All weights must be non-negative. -#' @param reference_group The reference group level for comparisons. Can be either +#' @param .reference_level The reference group level for comparisons. Can be either #' a group level value or a numeric index. If `NULL` (default), uses the first level. #' @param na.rm A logical value indicating whether to remove missing values #' before computation. If `FALSE` (default), missing values in the input @@ -25,11 +25,11 @@ NULL #' @param .data A data frame containing the variables to analyze. #' @param .vars Variables for which to calculate metrics. Can be unquoted #' variable names, a character vector, or a tidyselect expression. -#' @param .group Grouping variable, e.g., treatment or exposure group. -#' @param .wts Optional weighting variables. Can be unquoted variable names, +#' @param .exposure Grouping variable, e.g., treatment or exposure group. +#' @param .weights Optional weighting variables. Can be unquoted variable names, #' a character vector, or NULL. Multiple weights can be provided to compare #' different weighting schemes. -#' @param include_observed Logical. If using `.wts`, also calculate observed +#' @param include_observed Logical. If using `.weights`, also calculate observed #' (unweighted) metrics? Defaults to TRUE. #' @keywords internal #' @name check_params @@ -37,7 +37,7 @@ NULL #' Parameter Documentation for Treatment Level #' -#' @param treatment_level The level of the outcome variable to consider as the +#' @param .focal_level The level of the outcome variable to consider as the #' treatment/event. If `NULL` (default), uses the last level for factors or #' the maximum value for numeric variables. #' @keywords internal diff --git a/R/utils-group.R b/R/utils-group.R index 4e11ac3..3654883 100644 --- a/R/utils-group.R +++ b/R/utils-group.R @@ -17,7 +17,7 @@ extract_group_levels <- function( if (require_binary && length(levels) != 2) { abort( - "Group variable must have exactly two levels, got {length(levels)}", + "Exposure variable must have exactly two levels, got {length(levels)}", error_class = "halfmoon_group_error", call = call ) @@ -48,7 +48,7 @@ determine_reference_group <- function( if (is.numeric(reference_group) && length(reference_group) == 1) { if (reference_group > length(levels) || reference_group < 1) { abort( - "Reference group index {reference_group} out of bounds", + ".reference_level index {reference_group} out of bounds", error_class = "halfmoon_range_error", call = call ) @@ -58,7 +58,7 @@ determine_reference_group <- function( # Otherwise, it's an invalid reference group abort( - "{.arg reference_group} {.val {reference_group}} not found in grouping variable", + "{.arg .reference_level} {.val {reference_group}} not found in grouping variable", error_class = "halfmoon_reference_error", call = call ) diff --git a/R/utils-validation.R b/R/utils-validation.R index 7683900..9df5b55 100644 --- a/R/utils-validation.R +++ b/R/utils-validation.R @@ -20,7 +20,7 @@ validate_numeric <- function( validate_weights <- function( weights, n, - arg_name = "weights", + arg_name = ".weights", call = rlang::caller_env() ) { if (is.null(weights)) { @@ -202,13 +202,13 @@ get_exposure_type <- function(group, call = rlang::caller_env()) { "categorical" } else if (n_levels == 1) { abort( - "Group variable has only one level", + "Exposure variable has only one level", error_class = "halfmoon_group_error", call = call ) } else { abort( - "Group variable has no non-missing values", + "Exposure variable has no non-missing values", error_class = "halfmoon_empty_error", call = call ) diff --git a/README.Rmd b/README.Rmd index c4ef5b9..dddc90f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -59,7 +59,7 @@ library(ggplot2) # weighted mirrored histograms ggplot(nhefs_weights, aes(.fitted)) + geom_mirror_histogram( - aes(group = qsmk), + aes(exposure = qsmk), bins = 50 ) + geom_mirror_histogram( @@ -81,8 +81,8 @@ ggplot( plot_df <- check_balance( nhefs_weights, race:active, - .group = qsmk, - .wts = c(w_ate, w_att, w_atm, w_ato), + .exposure = qsmk, + .weights = c(w_ate, w_att, w_atm, w_ato), .metrics = "smd" ) @@ -110,16 +110,16 @@ Assess how well your propensity score model discriminates between treatment grou # Check AUC across different weighting methods roc_results <- check_model_roc_curve( nhefs_weights, - .truth = qsmk, + .exposure = qsmk, .estimate = .fitted, - .wts = c(w_ate, w_att, w_atm, w_ato) + .weights = c(w_ate, w_att, w_atm, w_ato) ) auc_results <- check_model_auc( nhefs_weights, - .truth = qsmk, + .exposure = qsmk, .estimate = .fitted, - .wts = c(w_ate, w_att, w_atm, w_ato) + .weights = c(w_ate, w_att, w_atm, w_ato) ) # Plot ROC curves @@ -147,8 +147,8 @@ Assess balance across multiple metrics simultaneously: balance_results <- check_balance( nhefs_weights, .vars = race:active, - .group = qsmk, - .wts = c(w_ate, w_att, w_atm, w_ato), + .exposure = qsmk, + .weights = c(w_ate, w_att, w_atm, w_ato), .metrics = c("smd", "vr", "ks", "energy") ) @@ -164,7 +164,7 @@ ggplot(balance_results, aes(x = abs(estimate), y = variable)) + Assess distributional balance between treatment groups: ```{r qq-example} -plot_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) +plot_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) ``` ## Example: Matching @@ -193,7 +193,7 @@ matched_data <- get_matches(m.out1) match_smd <- check_balance( matched_data, c(age, educ, race, nodegree, married, re74, re75), - .group = treat, + .exposure = treat, .metrics = "smd" ) @@ -213,8 +213,8 @@ head(matches) many_matched_smds <- check_balance( matches, c(age, educ, race, nodegree, married, re74, re75), - .group = treat, - .wts = c(m.out1, m.out2), + .exposure = treat, + .weights = c(m.out1, m.out2), .metrics = "smd" ) @@ -229,7 +229,7 @@ matches$ps <- m.out1$distance ggplot(matches, aes(ps)) + geom_mirror_histogram( - aes(group = factor(treat)), + aes(exposure = factor(treat)), bins = 50 ) + geom_mirror_histogram( diff --git a/README.md b/README.md index 25f11f6..0fbab59 100644 --- a/README.md +++ b/README.md @@ -52,7 +52,7 @@ library(ggplot2) # weighted mirrored histograms ggplot(nhefs_weights, aes(.fitted)) + geom_mirror_histogram( - aes(group = qsmk), + aes(exposure = qsmk), bins = 50 ) + geom_mirror_histogram( @@ -60,6 +60,8 @@ ggplot(nhefs_weights, aes(.fitted)) + bins = 50, alpha = 0.5 ) + scale_y_continuous(labels = abs) +#> Warning in ggplot2::geom_histogram(mapping = mapping, data = data, stat = +#> StatMirrorCount, : Ignoring unknown aesthetics: exposure ``` @@ -84,8 +86,8 @@ ggplot( plot_df <- check_balance( nhefs_weights, race:active, - .group = qsmk, - .wts = c(w_ate, w_att, w_atm, w_ato), + .exposure = qsmk, + .weights = c(w_ate, w_att, w_atm, w_ato), .metrics = "smd" ) @@ -119,16 +121,16 @@ about 0.5 (what you would observe from a randomized experiment): # Check AUC across different weighting methods roc_results <- check_model_roc_curve( nhefs_weights, - .truth = qsmk, + .exposure = qsmk, .estimate = .fitted, - .wts = c(w_ate, w_att, w_atm, w_ato) + .weights = c(w_ate, w_att, w_atm, w_ato) ) auc_results <- check_model_auc( nhefs_weights, - .truth = qsmk, + .exposure = qsmk, .estimate = .fitted, - .wts = c(w_ate, w_att, w_atm, w_ato) + .weights = c(w_ate, w_att, w_atm, w_ato) ) # Plot ROC curves @@ -165,8 +167,8 @@ Assess balance across multiple metrics simultaneously: balance_results <- check_balance( nhefs_weights, .vars = race:active, - .group = qsmk, - .wts = c(w_ate, w_att, w_atm, w_ato), + .exposure = qsmk, + .weights = c(w_ate, w_att, w_atm, w_ato), .metrics = c("smd", "vr", "ks", "energy") ) @@ -184,7 +186,7 @@ ggplot(balance_results, aes(x = abs(estimate), y = variable)) + Assess distributional balance between treatment groups: ``` r -plot_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) +plot_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) ``` @@ -217,7 +219,7 @@ matched_data <- get_matches(m.out1) match_smd <- check_balance( matched_data, c(age, educ, race, nodegree, married, re74, re75), - .group = treat, + .exposure = treat, .metrics = "smd" ) @@ -253,8 +255,8 @@ matches, we can more easily compare multiple matched datasets with many_matched_smds <- check_balance( matches, c(age, educ, race, nodegree, married, re74, re75), - .group = treat, - .wts = c(m.out1, m.out2), + .exposure = treat, + .weights = c(m.out1, m.out2), .metrics = "smd" ) @@ -273,7 +275,7 @@ matches$ps <- m.out1$distance ggplot(matches, aes(ps)) + geom_mirror_histogram( - aes(group = factor(treat)), + aes(exposure = factor(treat)), bins = 50 ) + geom_mirror_histogram( @@ -281,6 +283,8 @@ ggplot(matches, aes(ps)) + bins = 50, alpha = 0.5 ) + scale_y_continuous(labels = abs) +#> Warning in ggplot2::geom_histogram(mapping = mapping, data = data, stat = +#> StatMirrorCount, : Ignoring unknown aesthetics: exposure ``` diff --git a/man/bal_corr.Rd b/man/bal_corr.Rd index 1a79b49..172076a 100644 --- a/man/bal_corr.Rd +++ b/man/bal_corr.Rd @@ -4,16 +4,16 @@ \alias{bal_corr} \title{Balance Weighted or Unweighted Pearson Correlation} \usage{ -bal_corr(x, y, weights = NULL, na.rm = FALSE) +bal_corr(.x, .y, .weights = NULL, na.rm = FALSE) } \arguments{ -\item{x}{A numeric vector containing the first variable.} +\item{.x}{A numeric vector containing the first variable.} -\item{y}{A numeric vector containing the second variable. Must have the same -length as \code{x}.} +\item{.y}{A numeric vector containing the second variable. Must have the same +length as \code{.x}.} -\item{weights}{An optional numeric vector of case weights. If provided, must -have the same length as \code{x} and \code{y}. All weights must be non-negative.} +\item{.weights}{An optional numeric vector of case weights. If provided, must +have the same length as \code{.x} and \code{.y}. All weights must be non-negative.} \item{na.rm}{A logical value indicating whether to remove missing values before computation. If \code{FALSE} (default), missing values result in diff --git a/man/bal_energy.Rd b/man/bal_energy.Rd index a5660a5..dc6da3d 100644 --- a/man/bal_energy.Rd +++ b/man/bal_energy.Rd @@ -5,39 +5,39 @@ \title{Balance Energy Distance} \usage{ bal_energy( - covariates, - group, - weights = NULL, + .covariates, + .exposure, + .weights = NULL, estimand = NULL, - treatment_level = NULL, + .focal_level = NULL, use_improved = TRUE, standardized = TRUE, na.rm = FALSE ) } \arguments{ -\item{covariates}{A data frame or matrix containing the covariates to compare.} +\item{.covariates}{A data frame or matrix containing the .covariates to compare.} -\item{group}{A vector (factor or numeric) indicating group membership. For +\item{.exposure}{A vector (factor or numeric) indicating group membership. For binary and multi-category treatments, must have 2+ unique levels. For continuous treatments, should be numeric.} -\item{weights}{An optional numeric vector of weights. If provided, must -have the same length as rows in \code{covariates}. All weights must be non-negative.} +\item{.weights}{An optional numeric vector of weights. If provided, must +have the same length as rows in \code{.covariates}. All weights must be non-negative.} \item{estimand}{Character string specifying the estimand. Options are: \itemize{ \item NULL (default): Pure between-group energy distance comparing distributions \item "ATE": Energy distance weighted to reflect balance for estimating average treatment effects across the entire population -\item "ATT": Energy distance weighted to reflect balance for the treated group, +\item "ATT": Energy distance weighted to reflect balance for the treated .exposure, measuring how well controls match the treated distribution -\item "ATC": Energy distance weighted to reflect balance for the control group, +\item "ATC": Energy distance weighted to reflect balance for the control .exposure, measuring how well treated units match the control distribution For continuous treatments, only NULL is supported. }} -\item{treatment_level}{The treatment level for ATT/ATC. If \code{NULL} (default), +\item{.focal_level}{The treatment level for ATT/ATC. If \code{NULL} (default), automatically determined based on estimand.} \item{use_improved}{Logical. Use improved energy distance for ATE? Default is TRUE. @@ -59,7 +59,7 @@ coefficient (0 = independence, 1 = perfect dependence). \description{ Computes the energy distance as a multivariate measure of covariate balance between groups. Energy distance captures the similarity between distributions -across the entire joint distribution of covariates, making it more comprehensive +across the entire joint distribution of .covariates, making it more comprehensive than univariate balance measures. } \details{ @@ -68,31 +68,31 @@ and implemented following Huling & Mak (2024) and Huling et al. (2024). The calculation uses a quadratic form: \eqn{w^T P w + q^T w + k}, where the components depend on the estimand. -For binary variables in the covariates, variance is calculated as p(1-p) +For binary variables in the .covariates, variance is calculated as p(1-p) rather than sample variance to prevent over-weighting. For continuous treatments, the function uses distance correlation instead of -traditional energy distance, measuring independence between treatment and covariates. +traditional energy distance, measuring independence between treatment and .covariates. } \examples{ # Binary treatment bal_energy( - covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), - group = nhefs_weights$qsmk + .covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), + .exposure = nhefs_weights$qsmk ) # With weights bal_energy( - covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), - group = nhefs_weights$qsmk, - weights = nhefs_weights$w_ate + .covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), + .exposure = nhefs_weights$qsmk, + .weights = nhefs_weights$w_ate ) # ATT estimand bal_energy( - covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), - group = nhefs_weights$qsmk, - weights = nhefs_weights$w_att, + .covariates = dplyr::select(nhefs_weights, age, wt71, smokeyrs), + .exposure = nhefs_weights$qsmk, + .weights = nhefs_weights$w_att, estimand = "ATT" ) diff --git a/man/bal_ess.Rd b/man/bal_ess.Rd index 87f3aa9..b9e38c8 100644 --- a/man/bal_ess.Rd +++ b/man/bal_ess.Rd @@ -4,10 +4,10 @@ \alias{bal_ess} \title{Calculate Effective Sample Size for Single Weight Vector} \usage{ -bal_ess(.wts, na.rm = FALSE) +bal_ess(.weights, na.rm = FALSE) } \arguments{ -\item{.wts}{A numeric vector of weights or a single weight column from a data frame.} +\item{.weights}{A numeric vector of weights or a single weight column from a data frame.} \item{na.rm}{A logical value indicating whether to remove missing values before computation. If \code{FALSE} (default), missing values in the input diff --git a/man/bal_ks.Rd b/man/bal_ks.Rd index ceb69b2..351d57f 100644 --- a/man/bal_ks.Rd +++ b/man/bal_ks.Rd @@ -4,18 +4,24 @@ \alias{bal_ks} \title{Balance Kolmogorov-Smirnov (KS) Statistic for Two Groups} \usage{ -bal_ks(covariate, group, weights = NULL, reference_group = NULL, na.rm = FALSE) +bal_ks( + .covariate, + .exposure, + .weights = NULL, + .reference_level = NULL, + na.rm = FALSE +) } \arguments{ -\item{covariate}{A numeric vector containing the covariate values to compare.} +\item{.covariate}{A numeric vector containing the covariate values to compare.} -\item{group}{A vector (factor or numeric) indicating group membership. Must +\item{.exposure}{A vector (factor or numeric) indicating group membership. Must have exactly two unique levels.} -\item{weights}{An optional numeric vector of case weights. If provided, must +\item{.weights}{An optional numeric vector of case weights. If provided, must have the same length as other input vectors. All weights must be non-negative.} -\item{reference_group}{The reference group level for comparisons. Can be either +\item{.reference_level}{The reference group level for comparisons. Can be either a group level value or a numeric index. If \code{NULL} (default), uses the first level.} \item{na.rm}{A logical value indicating whether to remove missing values @@ -54,18 +60,18 @@ bal_ks(nhefs_weights$age, nhefs_weights$qsmk) # With weights bal_ks(nhefs_weights$wt71, nhefs_weights$qsmk, - weights = nhefs_weights$w_ate) + .weights = nhefs_weights$w_ate) # Categorical exposure (returns named vector) bal_ks(nhefs_weights$age, nhefs_weights$alcoholfreq_cat) -# Specify reference group +# Specify reference level bal_ks(nhefs_weights$age, nhefs_weights$alcoholfreq_cat, - reference_group = "none") + .reference_level = "none") # With categorical weights bal_ks(nhefs_weights$wt71, nhefs_weights$alcoholfreq_cat, - weights = nhefs_weights$w_cat_ate) + .weights = nhefs_weights$w_cat_ate) } \seealso{ \code{\link[=check_balance]{check_balance()}} for computing multiple balance metrics at once diff --git a/man/bal_model_auc.Rd b/man/bal_model_auc.Rd index 7f7c038..a3ca113 100644 --- a/man/bal_model_auc.Rd +++ b/man/bal_model_auc.Rd @@ -6,28 +6,28 @@ \usage{ bal_model_auc( .data, - .truth, + .exposure, .estimate, - .wts = NULL, + .weights = NULL, na.rm = TRUE, - treatment_level = NULL + .focal_level = NULL ) } \arguments{ \item{.data}{A data frame containing the variables.} -\item{.truth}{The treatment/outcome variable (unquoted).} +\item{.exposure}{The treatment/outcome variable (unquoted).} \item{.estimate}{The propensity score or fitted values (unquoted).} -\item{.wts}{Optional single weight variable (unquoted). If NULL, computes +\item{.weights}{Optional single weight variable (unquoted). If NULL, computes unweighted AUC.} \item{na.rm}{A logical value indicating whether to remove missing values before computation. If \code{FALSE} (default), missing values in the input will produce \code{NA} in the output.} -\item{treatment_level}{The level of the outcome variable to consider as the +\item{.focal_level}{The level of the outcome variable to consider as the treatment/event. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} } diff --git a/man/bal_model_roc_curve.Rd b/man/bal_model_roc_curve.Rd index c04a134..d3e147d 100644 --- a/man/bal_model_roc_curve.Rd +++ b/man/bal_model_roc_curve.Rd @@ -6,28 +6,28 @@ \usage{ bal_model_roc_curve( .data, - .truth, + .exposure, .estimate, - .wts = NULL, + .weights = NULL, na.rm = TRUE, - treatment_level = NULL + .focal_level = NULL ) } \arguments{ \item{.data}{A data frame containing the variables.} -\item{.truth}{The treatment/outcome variable (unquoted).} +\item{.exposure}{The treatment/outcome variable (unquoted).} \item{.estimate}{The propensity score or fitted values (unquoted).} -\item{.wts}{Optional single weight variable (unquoted). If NULL, computes +\item{.weights}{Optional single weight variable (unquoted). If NULL, computes unweighted ROC curve.} \item{na.rm}{A logical value indicating whether to remove missing values before computation. If \code{FALSE} (default), missing values in the input will produce \code{NA} in the output.} -\item{treatment_level}{The level of the outcome variable to consider as the +\item{.focal_level}{The level of the outcome variable to consider as the treatment/event. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} } diff --git a/man/bal_prognostic_score.Rd b/man/bal_prognostic_score.Rd index 934bd5a..f9e5e67 100644 --- a/man/bal_prognostic_score.Rd +++ b/man/bal_prognostic_score.Rd @@ -7,12 +7,12 @@ bal_prognostic_score( .data, outcome = NULL, - covariates = everything(), - treatment, + .covariates = everything(), + .exposure, formula = NULL, - treatment_level = NULL, + .reference_level = NULL, family = gaussian(), - weights = NULL, + .weights = NULL, na.rm = FALSE, ... ) @@ -23,24 +23,24 @@ bal_prognostic_score( \item{outcome}{The outcome variable. Can be specified as a bare name or character string. Ignored if \code{formula} is provided.} -\item{covariates}{Variables to include in the outcome model. Defaults to +\item{.covariates}{Variables to include in the outcome model. Defaults to \code{everything()} which includes all variables except the outcome and treatment. Supports tidyselect syntax. Ignored if \code{formula} is provided.} -\item{treatment}{The treatment variable. Can be specified as a bare name or +\item{.exposure}{The treatment variable. Can be specified as a bare name or character string.} \item{formula}{Optional formula for the outcome model. If provided, \code{outcome} -and \code{covariates} arguments are ignored. The formula should not include the +and \code{.covariates} arguments are ignored. The formula should not include the treatment variable.} -\item{treatment_level}{The level of treatment that represents the control group. +\item{.reference_level}{The level of treatment that represents the control group. If NULL (default), the first level is used as control.} \item{family}{A family object for the GLM. Defaults to \code{gaussian()} for continuous outcomes. Use \code{binomial()} for binary outcomes.} -\item{weights}{Optional weights for the outcome model. Can be a numeric vector +\item{.weights}{Optional weights for the outcome model. Can be a numeric vector or bare name of a variable in \code{.data}.} \item{na.rm}{Logical. Should missing values be removed? Defaults to FALSE.} @@ -84,27 +84,27 @@ treatment groups. prog_scores <- bal_prognostic_score( nhefs_weights, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex, race, wt71) + .exposure = qsmk, + .covariates = c(age, sex, race, wt71) ) # Using formula interface prog_scores_formula <- bal_prognostic_score( nhefs_weights, - treatment = qsmk, + .exposure = qsmk, formula = wt82_71 ~ age + sex + race + wt71 + I(age^2) ) # Add to data and check balance nhefs_with_prog <- nhefs_weights nhefs_with_prog$prog_score <- prog_scores -check_balance(nhefs_with_prog, prog_score, qsmk, .wts = w_ate) +check_balance(nhefs_with_prog, prog_score, qsmk, .weights = w_ate) # For binary outcome prog_scores_binary <- bal_prognostic_score( nhefs_weights, outcome = death, - treatment = qsmk, + .exposure = qsmk, family = binomial() ) diff --git a/man/bal_qq.Rd b/man/bal_qq.Rd index 3274e1c..f1b33b6 100644 --- a/man/bal_qq.Rd +++ b/man/bal_qq.Rd @@ -7,10 +7,10 @@ bal_qq( .data, .var, - .group, - .wts = NULL, + .exposure, + .weights = NULL, quantiles = seq(0.01, 0.99, 0.01), - treatment_level = NULL, + .reference_level = NULL, na.rm = FALSE ) } @@ -19,17 +19,16 @@ bal_qq( \item{.var}{Variable to compute quantiles for (unquoted).} -\item{.group}{Column name of treatment/group variable (unquoted).} +\item{.exposure}{Column name of treatment/group variable (unquoted).} -\item{.wts}{Optional single weight variable (unquoted). If NULL, computes +\item{.weights}{Optional single weight variable (unquoted). If NULL, computes unweighted quantiles.} \item{quantiles}{Numeric vector of quantiles to compute. Default is \code{seq(0.01, 0.99, 0.01)} for 99 quantiles.} -\item{treatment_level}{The level of the outcome variable to consider as the -treatment/event. If \code{NULL} (default), uses the last level for factors or -the maximum value for numeric variables.} +\item{.reference_level}{The reference group level for comparisons. Can be either +a group level value or a numeric index. If \code{NULL} (default), uses the first level.} \item{na.rm}{A logical value indicating whether to remove missing values before computation. If \code{FALSE} (default), missing values in the input @@ -38,8 +37,8 @@ will produce \code{NA} in the output.} \value{ A tibble with columns: \item{quantile}{Numeric. The quantile probability (0-1).} -\item{treated_quantiles}{Numeric. The quantile value for the treatment group.} -\item{untreated_quantiles}{Numeric. The quantile value for the control group.} +\item{exposed_quantiles}{Numeric. The quantile value for the exposed group.} +\item{unexposed_quantiles}{Numeric. The quantile value for the unexposed group.} } \description{ Calculate quantile-quantile data comparing the distribution of a variable @@ -62,10 +61,10 @@ line y = x. bal_qq(nhefs_weights, age, qsmk) # Weighted QQ data -bal_qq(nhefs_weights, age, qsmk, .wts = w_ate) +bal_qq(nhefs_weights, age, qsmk, .weights = w_ate) # Custom quantiles -bal_qq(nhefs_weights, age, qsmk, .wts = w_ate, +bal_qq(nhefs_weights, age, qsmk, .weights = w_ate, quantiles = seq(0.1, 0.9, 0.1)) } diff --git a/man/bal_smd.Rd b/man/bal_smd.Rd index bc8b253..6f66b44 100644 --- a/man/bal_smd.Rd +++ b/man/bal_smd.Rd @@ -5,23 +5,23 @@ \title{Balance Standardized Mean Difference (SMD)} \usage{ bal_smd( - covariate, - group, - weights = NULL, - reference_group = NULL, + .covariate, + .exposure, + .weights = NULL, + .reference_level = NULL, na.rm = FALSE ) } \arguments{ -\item{covariate}{A numeric vector containing the covariate values to compare.} +\item{.covariate}{A numeric vector containing the covariate values to compare.} -\item{group}{A vector (factor or numeric) indicating group membership. Must +\item{.exposure}{A vector (factor or numeric) indicating group membership. Must have exactly two unique levels.} -\item{weights}{An optional numeric vector of case weights. If provided, must +\item{.weights}{An optional numeric vector of case weights. If provided, must have the same length as other input vectors. All weights must be non-negative.} -\item{reference_group}{The reference group level for comparisons. Can be either +\item{.reference_level}{The reference group level for comparisons. Can be either a group level value or a numeric index. If \code{NULL} (default), uses the first level.} \item{na.rm}{A logical value indicating whether to remove missing values @@ -53,18 +53,18 @@ bal_smd(nhefs_weights$age, nhefs_weights$qsmk) # With weights bal_smd(nhefs_weights$wt71, nhefs_weights$qsmk, - weights = nhefs_weights$w_ate) + .weights = nhefs_weights$w_ate) # Categorical exposure (returns named vector) bal_smd(nhefs_weights$age, nhefs_weights$alcoholfreq_cat) -# Specify reference group +# Specify reference level bal_smd(nhefs_weights$age, nhefs_weights$alcoholfreq_cat, - reference_group = "daily") + .reference_level = "daily") # With categorical weights bal_smd(nhefs_weights$wt71, nhefs_weights$alcoholfreq_cat, - weights = nhefs_weights$w_cat_ate) + .weights = nhefs_weights$w_cat_ate) } \seealso{ diff --git a/man/bal_vr.Rd b/man/bal_vr.Rd index 3aeb5c8..84e1744 100644 --- a/man/bal_vr.Rd +++ b/man/bal_vr.Rd @@ -4,18 +4,24 @@ \alias{bal_vr} \title{Balance Variance Ratio for Two Groups} \usage{ -bal_vr(covariate, group, weights = NULL, reference_group = NULL, na.rm = FALSE) +bal_vr( + .covariate, + .exposure, + .weights = NULL, + .reference_level = NULL, + na.rm = FALSE +) } \arguments{ -\item{covariate}{A numeric vector containing the covariate values to compare.} +\item{.covariate}{A numeric vector containing the covariate values to compare.} -\item{group}{A vector (factor or numeric) indicating group membership. Must +\item{.exposure}{A vector (factor or numeric) indicating group membership. Must have exactly two unique levels.} -\item{weights}{An optional numeric vector of case weights. If provided, must +\item{.weights}{An optional numeric vector of case weights. If provided, must have the same length as other input vectors. All weights must be non-negative.} -\item{reference_group}{The reference group level for comparisons. Can be either +\item{.reference_level}{The reference group level for comparisons. Can be either a group level value or a numeric index. If \code{NULL} (default), uses the first level.} \item{na.rm}{A logical value indicating whether to remove missing values @@ -50,18 +56,18 @@ bal_vr(nhefs_weights$age, nhefs_weights$qsmk) # With weights bal_vr(nhefs_weights$wt71, nhefs_weights$qsmk, - weights = nhefs_weights$w_ate) + .weights = nhefs_weights$w_ate) # Categorical exposure (returns named vector) bal_vr(nhefs_weights$age, nhefs_weights$alcoholfreq_cat) -# Specify reference group +# Specify reference level bal_vr(nhefs_weights$age, nhefs_weights$alcoholfreq_cat, - reference_group = "2_3_per_week") + .reference_level = "2_3_per_week") # With categorical weights bal_vr(nhefs_weights$wt71, nhefs_weights$alcoholfreq_cat, - weights = nhefs_weights$w_cat_ate) + .weights = nhefs_weights$w_cat_ate) } \seealso{ diff --git a/man/balance_params.Rd b/man/balance_params.Rd index cc85e0d..c43752a 100644 --- a/man/balance_params.Rd +++ b/man/balance_params.Rd @@ -4,15 +4,15 @@ \alias{balance_params} \title{Parameter Documentation for Balance Functions} \arguments{ -\item{covariate}{A numeric vector containing the covariate values to compare.} +\item{.covariate}{A numeric vector containing the covariate values to compare.} -\item{group}{A vector (factor or numeric) indicating group membership. Must +\item{.exposure}{A vector (factor or numeric) indicating group membership. Must have exactly two unique levels.} -\item{weights}{An optional numeric vector of case weights. If provided, must +\item{.weights}{An optional numeric vector of case weights. If provided, must have the same length as other input vectors. All weights must be non-negative.} -\item{reference_group}{The reference group level for comparisons. Can be either +\item{.reference_level}{The reference group level for comparisons. Can be either a group level value or a numeric index. If \code{NULL} (default), uses the first level.} \item{na.rm}{A logical value indicating whether to remove missing values diff --git a/man/check_balance.Rd b/man/check_balance.Rd index 2645f07..e723801 100644 --- a/man/check_balance.Rd +++ b/man/check_balance.Rd @@ -7,11 +7,11 @@ check_balance( .data, .vars, - .group, - .wts = NULL, + .exposure, + .weights = NULL, .metrics = c("smd", "vr", "ks", "energy"), include_observed = TRUE, - reference_group = 1L, + .reference_level = 1L, na.rm = FALSE, make_dummy_vars = TRUE, squares = FALSE, @@ -25,9 +25,9 @@ check_balance( \item{.vars}{Variables for which to calculate metrics. Can be unquoted variable names, a character vector, or a tidyselect expression.} -\item{.group}{Grouping variable, e.g., treatment or exposure group.} +\item{.exposure}{Grouping variable, e.g., treatment or exposure group.} -\item{.wts}{Optional weighting variables. Can be unquoted variable names, +\item{.weights}{Optional weighting variables. Can be unquoted variable names, a character vector, or NULL. Multiple weights can be provided to compare different weighting schemes.} @@ -36,10 +36,10 @@ Available options: "smd" (standardized mean difference), "vr" (variance ratio), "ks" (Kolmogorov-Smirnov), "correlation" (for continuous exposures), "energy" (multivariate energy distance). Defaults to c("smd", "vr", "ks", "energy").} -\item{include_observed}{Logical. If using \code{.wts}, also calculate observed +\item{include_observed}{Logical. If using \code{.weights}, also calculate observed (unweighted) metrics? Defaults to TRUE.} -\item{reference_group}{The reference group level to use for comparisons. +\item{.reference_level}{The reference group level to use for comparisons. Defaults to 1 (first level).} \item{na.rm}{A logical value indicating whether to remove missing values @@ -101,21 +101,21 @@ is included in the results. } \examples{ # Basic usage with binary exposure -check_balance(nhefs_weights, c(age, wt71), qsmk, .wts = c(w_ate, w_att)) +check_balance(nhefs_weights, c(age, wt71), qsmk, .weights = c(w_ate, w_att)) # With specific metrics only check_balance(nhefs_weights, c(age, wt71), qsmk, .metrics = c("smd", "energy")) # Categorical exposure check_balance(nhefs_weights, c(age, wt71), alcoholfreq_cat, - .wts = c(w_cat_ate, w_cat_att_2_3wk)) + .weights = c(w_cat_ate, w_cat_att_2_3wk)) # Specify reference group for categorical exposure check_balance(nhefs_weights, c(age, wt71, sex), alcoholfreq_cat, - reference_group = "daily", .metrics = c("smd", "vr")) + .reference_level = "daily", .metrics = c("smd", "vr")) # Exclude observed results -check_balance(nhefs_weights, c(age, wt71), qsmk, .wts = w_ate, +check_balance(nhefs_weights, c(age, wt71), qsmk, .weights = w_ate, include_observed = FALSE) # Use correlation for continuous exposure diff --git a/man/check_ess.Rd b/man/check_ess.Rd index 752eb78..30a1698 100644 --- a/man/check_ess.Rd +++ b/man/check_ess.Rd @@ -6,7 +6,7 @@ \usage{ check_ess( .data, - .wts = NULL, + .weights = NULL, .group = NULL, include_observed = TRUE, n_tiles = 4, @@ -16,7 +16,7 @@ check_ess( \arguments{ \item{.data}{A data frame containing the variables to analyze.} -\item{.wts}{Optional weighting variables. Can be unquoted variable names, +\item{.weights}{Optional weighting variables. Can be unquoted variable names, a character vector, or NULL. Multiple weights can be provided to compare different weighting schemes.} @@ -24,7 +24,7 @@ different weighting schemes.} separately for each group level. For continuous variables, groups are created using quantiles.} -\item{include_observed}{Logical. If using \code{.wts}, also calculate observed +\item{include_observed}{Logical. If using \code{.weights}, also calculate observed (unweighted) metrics? Defaults to TRUE.} \item{n_tiles}{For continuous \code{.group} variables, the number of quantile @@ -66,23 +66,23 @@ further analysis. } \examples{ # Overall ESS for different weighting schemes -check_ess(nhefs_weights, .wts = c(w_ate, w_att, w_atm)) +check_ess(nhefs_weights, .weights = c(w_ate, w_att, w_atm)) # ESS by treatment group (binary exposure) -check_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk) +check_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk) # ESS by treatment group (categorical exposure) -check_ess(nhefs_weights, .wts = w_cat_ate, .group = alcoholfreq_cat) +check_ess(nhefs_weights, .weights = w_cat_ate, .group = alcoholfreq_cat) # ESS by quartiles of a continuous variable -check_ess(nhefs_weights, .wts = w_ate, .group = age, n_tiles = 4) +check_ess(nhefs_weights, .weights = w_ate, .group = age, n_tiles = 4) # Custom labels for continuous groups -check_ess(nhefs_weights, .wts = w_ate, .group = age, +check_ess(nhefs_weights, .weights = w_ate, .group = age, n_tiles = 3, tile_labels = c("Young", "Middle", "Older")) # Without unweighted comparison -check_ess(nhefs_weights, .wts = w_ate, .group = qsmk, +check_ess(nhefs_weights, .weights = w_ate, .group = qsmk, include_observed = FALSE) } diff --git a/man/check_model_auc.Rd b/man/check_model_auc.Rd index d8e614e..531cfe9 100644 --- a/man/check_model_auc.Rd +++ b/man/check_model_auc.Rd @@ -6,31 +6,31 @@ \usage{ check_model_auc( .data, - .truth, + .exposure, .estimate, - .wts, + .weights, include_observed = TRUE, na.rm = TRUE, - treatment_level = NULL + .focal_level = NULL ) } \arguments{ \item{.data}{A data frame containing the variables.} -\item{.truth}{The treatment/outcome variable.} +\item{.exposure}{The treatment/outcome variable.} \item{.estimate}{The propensity score or fitted values.} -\item{.wts}{Weighting variables (supports tidyselect).} +\item{.weights}{Weighting variables (supports tidyselect).} -\item{include_observed}{Logical. If using \code{.wts}, also calculate observed +\item{include_observed}{Logical. If using \code{.weights}, also calculate observed (unweighted) metrics? Defaults to TRUE.} \item{na.rm}{A logical value indicating whether to remove missing values before computation. If \code{FALSE} (default), missing values in the input will produce \code{NA} in the output.} -\item{treatment_level}{The level of the outcome variable to consider as the +\item{.focal_level}{The level of the outcome variable to consider as the treatment/event. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} } diff --git a/man/check_model_calibration.Rd b/man/check_model_calibration.Rd index ed7d8c8..bb1ef41 100644 --- a/man/check_model_calibration.Rd +++ b/man/check_model_calibration.Rd @@ -8,7 +8,7 @@ check_model_calibration( data, .fitted, .group, - treatment_level = NULL, + .focal_level = NULL, method = c("breaks", "logistic", "windowed"), bins = 10, binning_method = c("equal_width", "quantile"), @@ -29,7 +29,7 @@ Can be unquoted (e.g., \code{p}) or quoted (e.g., \code{"p"}).} \item{.group}{Column name of treatment/group variable. Can be unquoted (e.g., \code{g}) or quoted (e.g., \code{"g"}).} -\item{treatment_level}{The level of the outcome variable to consider as the +\item{.focal_level}{The level of the outcome variable to consider as the treatment/event. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} diff --git a/man/check_model_roc_curve.Rd b/man/check_model_roc_curve.Rd index a167a4e..2c2fe77 100644 --- a/man/check_model_roc_curve.Rd +++ b/man/check_model_roc_curve.Rd @@ -6,28 +6,28 @@ \usage{ check_model_roc_curve( .data, - .truth, + .exposure, .estimate, - .wts = NULL, + .weights = NULL, include_observed = TRUE, na.rm = TRUE, - treatment_level = NULL + .focal_level = NULL ) } \arguments{ \item{.data}{A data frame containing the variables.} -\item{.truth}{The treatment/outcome variable (unquoted).} +\item{.exposure}{The treatment/outcome variable (unquoted).} \item{.estimate}{The propensity score or covariate (unquoted).} -\item{.wts}{Optional weighting variables (unquoted, can be multiple).} +\item{.weights}{Optional weighting variables (unquoted, can be multiple).} \item{include_observed}{Include unweighted results? Default TRUE.} \item{na.rm}{Remove missing values? Default TRUE.} -\item{treatment_level}{The level of \code{.truth} to consider as the treatment/event. +\item{.focal_level}{The level of \code{.exposure} to consider as the treatment/event. Default is NULL, which uses the second level.} } \value{ diff --git a/man/check_params.Rd b/man/check_params.Rd index 8aa1044..21ba370 100644 --- a/man/check_params.Rd +++ b/man/check_params.Rd @@ -9,13 +9,13 @@ \item{.vars}{Variables for which to calculate metrics. Can be unquoted variable names, a character vector, or a tidyselect expression.} -\item{.group}{Grouping variable, e.g., treatment or exposure group.} +\item{.exposure}{Grouping variable, e.g., treatment or exposure group.} -\item{.wts}{Optional weighting variables. Can be unquoted variable names, +\item{.weights}{Optional weighting variables. Can be unquoted variable names, a character vector, or NULL. Multiple weights can be provided to compare different weighting schemes.} -\item{include_observed}{Logical. If using \code{.wts}, also calculate observed +\item{include_observed}{Logical. If using \code{.weights}, also calculate observed (unweighted) metrics? Defaults to TRUE.} } \description{ diff --git a/man/check_qq.Rd b/man/check_qq.Rd index be28d0c..4fd6e1f 100644 --- a/man/check_qq.Rd +++ b/man/check_qq.Rd @@ -7,11 +7,11 @@ check_qq( .data, .var, - .group, - .wts = NULL, + .exposure, + .weights = NULL, quantiles = seq(0.01, 0.99, 0.01), include_observed = TRUE, - treatment_level = NULL, + .reference_level = NULL, na.rm = FALSE ) } @@ -20,19 +20,19 @@ check_qq( \item{.var}{Variable to compute quantiles for. Supports tidyselect syntax.} -\item{.group}{Column name of treatment/group variable. Supports tidyselect syntax.} +\item{.exposure}{Column name of treatment/group variable. Supports tidyselect syntax.} -\item{.wts}{Optional weighting variable(s). Can be unquoted variable names (supports tidyselect syntax), +\item{.weights}{Optional weighting variable(s). Can be unquoted variable names (supports tidyselect syntax), a character vector, or NULL. Multiple weights can be provided to compare different weighting schemes. Default is NULL (unweighted).} \item{quantiles}{Numeric vector of quantiles to compute. Default is \code{seq(0.01, 0.99, 0.01)} for 99 quantiles.} -\item{include_observed}{Logical. If using \code{.wts}, also compute observed +\item{include_observed}{Logical. If using \code{.weights}, also compute observed (unweighted) quantiles? Defaults to TRUE.} -\item{treatment_level}{The reference treatment level to use for comparisons. +\item{.reference_level}{The reference treatment level to use for comparisons. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} \item{na.rm}{Logical; if TRUE, drop NA values before computation.} @@ -41,8 +41,8 @@ If \code{NULL} (default), uses the last level for factors or the maximum value f A tibble with class "halfmoon_qq" containing columns: \item{method}{Character. The weighting method ("observed" or weight variable name).} \item{quantile}{Numeric. The quantile probability (0-1).} -\item{treated_quantiles}{Numeric. The quantile value for the treatment group.} -\item{untreated_quantiles}{Numeric. The quantile value for the control group.} +\item{exposed_quantiles}{Numeric. The quantile value for the exposed group.} +\item{unexposed_quantiles}{Numeric. The quantile value for the unexposed group.} } \description{ Calculate quantile-quantile data comparing the distribution of a variable @@ -60,10 +60,10 @@ it first computes the weighted ECDF and then inverts it to obtain quantiles. check_qq(nhefs_weights, age, qsmk) # With weighting -check_qq(nhefs_weights, age, qsmk, .wts = w_ate) +check_qq(nhefs_weights, age, qsmk, .weights = w_ate) # Compare multiple weighting schemes -check_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) +check_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) } \seealso{ diff --git a/man/geom_calibration.Rd b/man/geom_calibration.Rd index 03bc860..30eddc8 100644 --- a/man/geom_calibration.Rd +++ b/man/geom_calibration.Rd @@ -14,7 +14,7 @@ geom_calibration( conf_level = 0.95, window_size = 0.1, step_size = window_size/2, - treatment_level = NULL, + .focal_level = NULL, k = 10, show_ribbon = TRUE, show_points = TRUE, @@ -45,7 +45,7 @@ geom_calibration( \item{step_size}{Numeric; distance between window centers for "windowed" method.} -\item{treatment_level}{The level of the outcome variable to consider as the +\item{.focal_level}{The level of the outcome variable to consider as the treatment/event. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} @@ -110,7 +110,7 @@ ggplot(nhefs_weights, aes(estimate = .fitted, truth = qsmk)) + # Specify treatment level explicitly ggplot(nhefs_weights, aes(estimate = .fitted, truth = qsmk)) + - geom_calibration(treatment_level = "1") + + geom_calibration(.focal_level = "1") + geom_abline(intercept = 0, slope = 1, linetype = "dashed") + labs(x = "Propensity Score", y = "Observed Treatment Rate") diff --git a/man/geom_qq2.Rd b/man/geom_qq2.Rd index 765a6ef..20d7fb7 100644 --- a/man/geom_qq2.Rd +++ b/man/geom_qq2.Rd @@ -13,7 +13,7 @@ geom_qq2( show.legend = NA, inherit.aes = TRUE, quantiles = seq(0.01, 0.99, 0.01), - treatment_level = NULL, + .reference_level = NULL, ... ) } @@ -40,9 +40,9 @@ combining with them.} \item{quantiles}{Numeric vector of quantiles to compute. Default is \code{seq(0.01, 0.99, 0.01)} for 99 quantiles.} -\item{treatment_level}{The level of the outcome variable to consider as the -treatment/event. If \code{NULL} (default), uses the last level for factors or -the maximum value for numeric variables.} +\item{.reference_level}{The reference treatment level to use for comparisons. +If \code{NULL} (default), uses the first level for factors or the minimum value +for numeric variables.} \item{...}{Other arguments passed on to layer().} } diff --git a/man/geom_roc.Rd b/man/geom_roc.Rd index 373c840..90ef38e 100644 --- a/man/geom_roc.Rd +++ b/man/geom_roc.Rd @@ -13,13 +13,13 @@ geom_roc( show.legend = NA, inherit.aes = TRUE, linewidth = 0.5, - treatment_level = NULL, + .focal_level = NULL, ... ) } \arguments{ \item{mapping}{Set of aesthetic mappings. Must include \code{estimate} (propensity scores/predictions) -and \code{truth} (treatment/outcome variable). If specified, inherits from the plot.} +and \code{exposure} (treatment/outcome variable). If specified, inherits from the plot.} \item{data}{Data frame to use. If not specified, inherits from the plot.} @@ -38,7 +38,7 @@ combining with them.} \item{linewidth}{Width of the ROC curve line. Default is 0.5.} -\item{treatment_level}{The level of the outcome variable to consider as the +\item{.focal_level}{The level of the outcome variable to consider as the treatment/event. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} @@ -54,7 +54,7 @@ Emphasizes the balance interpretation where AUC around 0.5 indicates good balanc \examples{ # Basic usage library(ggplot2) -ggplot(nhefs_weights, aes(estimate = .fitted, truth = qsmk)) + +ggplot(nhefs_weights, aes(estimate = .fitted, exposure = qsmk)) + geom_roc() + geom_abline(intercept = 0, slope = 1, linetype = "dashed") @@ -66,7 +66,7 @@ long_data <- tidyr::pivot_longer( values_to = "weight" ) -ggplot(long_data, aes(estimate = .fitted, truth = qsmk, weight = weight)) + +ggplot(long_data, aes(estimate = .fitted, exposure = qsmk, weight = weight)) + geom_roc(aes(color = weight_type)) + geom_abline(intercept = 0, slope = 1, linetype = "dashed") diff --git a/man/plot_balance.Rd b/man/plot_balance.Rd index 3a937df..f087fd2 100644 --- a/man/plot_balance.Rd +++ b/man/plot_balance.Rd @@ -76,7 +76,7 @@ balance_data <- check_balance( nhefs_weights, c(age, education, race), qsmk, - .wts = c(w_ate, w_att) + .weights = c(w_ate, w_att) ) # Create balance plot @@ -97,7 +97,7 @@ balance_cat <- check_balance( nhefs_weights, c(age, wt71, sex), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = c("smd", "vr") ) plot_balance(balance_cat) diff --git a/man/plot_ess.Rd b/man/plot_ess.Rd index 8834d22..8faf88a 100644 --- a/man/plot_ess.Rd +++ b/man/plot_ess.Rd @@ -6,7 +6,7 @@ \usage{ plot_ess( .data, - .wts = NULL, + .weights = NULL, .group = NULL, include_observed = TRUE, n_tiles = 4, @@ -24,10 +24,10 @@ plot_ess( \item{.data}{A data frame, either: \itemize{ \item Output from \code{check_ess()} containing ESS calculations -\item Raw data to compute ESS from (requires \code{.wts} to be specified) +\item Raw data to compute ESS from (requires \code{.weights} to be specified) }} -\item{.wts}{Optional weighting variables. Can be unquoted variable names, +\item{.weights}{Optional weighting variables. Can be unquoted variable names, a character vector, or NULL. Multiple weights can be provided to compare different weighting schemes.} @@ -35,7 +35,7 @@ different weighting schemes.} separately for each group level. For continuous variables, groups are created using quantiles.} -\item{include_observed}{Logical. If using \code{.wts}, also calculate observed +\item{include_observed}{Logical. If using \code{.weights}, also calculate observed (unweighted) metrics? Defaults to TRUE.} \item{n_tiles}{For continuous \code{.group} variables, the number of quantile @@ -92,36 +92,36 @@ Lower ESS percentages indicate: } \examples{ # Overall ESS for different weighting schemes -plot_ess(nhefs_weights, .wts = c(w_ate, w_att, w_atm)) +plot_ess(nhefs_weights, .weights = c(w_ate, w_att, w_atm)) # ESS by treatment group (binary exposure) -plot_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk) +plot_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk) # ESS by treatment group (categorical exposure) -plot_ess(nhefs_weights, .wts = w_cat_ate, .group = alcoholfreq_cat) +plot_ess(nhefs_weights, .weights = w_cat_ate, .group = alcoholfreq_cat) # ESS by age quartiles -plot_ess(nhefs_weights, .wts = w_ate, .group = age) +plot_ess(nhefs_weights, .weights = w_ate, .group = age) # Customize quantiles for continuous variable -plot_ess(nhefs_weights, .wts = w_ate, .group = age, +plot_ess(nhefs_weights, .weights = w_ate, .group = age, n_tiles = 5, tile_labels = c("Youngest", "Young", "Middle", "Older", "Oldest")) # Without percentage labels -plot_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk, +plot_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk, show_labels = FALSE) # Custom styling -plot_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk, +plot_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk, alpha = 0.6, fill_color = "steelblue", reference_line_color = "red") # Using pre-computed ESS data -ess_data <- check_ess(nhefs_weights, .wts = c(w_ate, w_att)) +ess_data <- check_ess(nhefs_weights, .weights = c(w_ate, w_att)) plot_ess(ess_data) # Show ESS on original scale instead of percentage -plot_ess(nhefs_weights, .wts = c(w_ate, w_att), percent_scale = FALSE) +plot_ess(nhefs_weights, .weights = c(w_ate, w_att), percent_scale = FALSE) } \seealso{ diff --git a/man/plot_mirror_distributions.Rd b/man/plot_mirror_distributions.Rd index debb36f..015c5e3 100644 --- a/man/plot_mirror_distributions.Rd +++ b/man/plot_mirror_distributions.Rd @@ -7,8 +7,8 @@ plot_mirror_distributions( .data, .var, - .group, - .wts = NULL, + .exposure, + .weights = NULL, type = c("histogram", "density"), mirror_axis = "y", bins = 30, @@ -18,7 +18,7 @@ plot_mirror_distributions( include_unweighted = TRUE, alpha = 0.6, na.rm = FALSE, - reference_group = 1L + .reference_level = 1L ) } \arguments{ @@ -26,11 +26,11 @@ plot_mirror_distributions( \item{.var}{The variable to plot. Supports tidyselect syntax. Can be unquoted.} -\item{.group}{Column name of treatment/group variable. Supports tidyselect syntax. Can be unquoted. +\item{.exposure}{Column name of treatment/group variable. Supports tidyselect syntax. Can be unquoted. For binary variables, must have exactly 2 levels. For categorical variables (>2 levels), creates pairwise comparisons against a reference group.} -\item{.wts}{Optional weighting variable(s). Can be unquoted variable names, tidyselect syntax, +\item{.weights}{Optional weighting variable(s). Can be unquoted variable names, tidyselect syntax, a character vector, or NULL. Multiple weights can be provided to compare different weighting schemes. Default is NULL (unweighted).} @@ -49,16 +49,16 @@ Can be numeric or character (e.g., "nrd0", "sj").} \item{adjust}{Numeric; bandwidth adjustment factor for density. Only used when type = "density". Default is 1.} -\item{include_unweighted}{Logical. If using \code{.wts}, also show unweighted +\item{include_unweighted}{Logical. If using \code{.weights}, also show unweighted distribution? Defaults to TRUE.} \item{alpha}{Numeric; transparency level for fills. Default is 0.6.} \item{na.rm}{Logical; if TRUE, drop NA values before plotting.} -\item{reference_group}{The reference group level for categorical exposures (>2 levels). +\item{.reference_level}{The reference group level for categorical exposures (>2 levels). Can be a string (group level) or numeric (position). Defaults to 1 (first level). -Only used when .group has more than 2 levels.} +Only used when .exposure has more than 2 levels.} } \value{ A ggplot2 object. @@ -94,15 +94,15 @@ plot_mirror_distributions(nhefs_weights, age, qsmk) plot_mirror_distributions(nhefs_weights, age, qsmk, type = "density") # With weighting -plot_mirror_distributions(nhefs_weights, age, qsmk, .wts = w_ate) +plot_mirror_distributions(nhefs_weights, age, qsmk, .weights = w_ate) # Compare multiple weighting schemes -plot_mirror_distributions(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) +plot_mirror_distributions(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) # Customize appearance plot_mirror_distributions( nhefs_weights, age, qsmk, - .wts = w_ate, + .weights = w_ate, type = "density", alpha = 0.7 ) @@ -110,7 +110,7 @@ plot_mirror_distributions( # Without unweighted comparison plot_mirror_distributions( nhefs_weights, age, qsmk, - .wts = w_ate, + .weights = w_ate, include_unweighted = FALSE ) @@ -127,8 +127,8 @@ plot_mirror_distributions( nhefs_weights, wt71, alcoholfreq_cat, - .wts = w_cat_ate, - reference_group = "none" + .weights = w_cat_ate, + .reference_level = "none" ) } diff --git a/man/plot_model_calibration.Rd b/man/plot_model_calibration.Rd index 778ec65..d0516d3 100644 --- a/man/plot_model_calibration.Rd +++ b/man/plot_model_calibration.Rd @@ -14,7 +14,7 @@ plot_model_calibration(x, ...) x, .fitted, .group, - treatment_level = NULL, + .focal_level = NULL, method = "breaks", bins = 10, smooth = TRUE, @@ -31,7 +31,7 @@ plot_model_calibration(x, ...) \method{plot_model_calibration}{glm}( x, - treatment_level = NULL, + .focal_level = NULL, method = "breaks", bins = 10, smooth = TRUE, @@ -48,7 +48,7 @@ plot_model_calibration(x, ...) \method{plot_model_calibration}{lm}( x, - treatment_level = NULL, + .focal_level = NULL, method = "breaks", bins = 10, smooth = TRUE, @@ -82,7 +82,7 @@ Can be unquoted (e.g., \code{.fitted}) or quoted (e.g., \code{".fitted"}).} \item{.group}{Column name of treatment/group variable. Can be unquoted (e.g., \code{qsmk}) or quoted (e.g., \code{"qsmk"}).} -\item{treatment_level}{Value indicating which level of \code{.group} represents treatment. +\item{.focal_level}{Value indicating which level of \code{.group} represents treatment. If NULL (default), uses the last level for factors or max value for numeric.} \item{method}{Character; calibration method - "breaks", "logistic", or "windowed".} @@ -154,7 +154,7 @@ plot_model_calibration(nhefs_weights, .fitted, qsmk, method = "logistic") plot_model_calibration(nhefs_weights, .fitted, qsmk, method = "windowed") # Specify treatment level explicitly -plot_model_calibration(nhefs_weights, .fitted, qsmk, treatment_level = "1") +plot_model_calibration(nhefs_weights, .fitted, qsmk, .focal_level = "1") # Method 2: Using model objects # Fit a propensity score model diff --git a/man/plot_qq.Rd b/man/plot_qq.Rd index 9a418e2..abe0eb2 100644 --- a/man/plot_qq.Rd +++ b/man/plot_qq.Rd @@ -12,10 +12,10 @@ plot_qq(.data, ...) .data, .var, .group, - .wts = NULL, + .weights = NULL, quantiles = seq(0.01, 0.99, 0.01), include_observed = TRUE, - treatment_level = NULL, + .reference_level = NULL, na.rm = FALSE, ... ) @@ -31,17 +31,17 @@ plot_qq(.data, ...) \item{.group}{Column name of treatment/group variable. Can be unquoted (e.g., \code{qsmk}) or quoted (e.g., \code{"qsmk"}).} -\item{.wts}{Optional weighting variable(s). Can be unquoted variable names, +\item{.weights}{Optional weighting variable(s). Can be unquoted variable names, a character vector, or NULL. Multiple weights can be provided to compare different weighting schemes. Default is NULL (unweighted).} \item{quantiles}{Numeric vector of quantiles to compute. Default is \code{seq(0.01, 0.99, 0.01)} for 99 quantiles.} -\item{include_observed}{Logical. If using \code{.wts}, also show observed +\item{include_observed}{Logical. If using \code{.weights}, also show observed (unweighted) QQ plot? Defaults to TRUE.} -\item{treatment_level}{The reference treatment level to use for comparisons. +\item{.reference_level}{The reference treatment level to use for comparisons. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} \item{na.rm}{Logical; if TRUE, drop NA values before computation.} @@ -79,16 +79,16 @@ library(ggplot2) plot_qq(nhefs_weights, age, qsmk) # With weighting -plot_qq(nhefs_weights, age, qsmk, .wts = w_ate) +plot_qq(nhefs_weights, age, qsmk, .weights = w_ate) # Compare multiple weighting schemes -plot_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) +plot_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) # For propensity scores -plot_qq(nhefs_weights, .fitted, qsmk, .wts = w_ate) +plot_qq(nhefs_weights, .fitted, qsmk, .weights = w_ate) # Without observed comparison -plot_qq(nhefs_weights, age, qsmk, .wts = w_ate, include_observed = FALSE) +plot_qq(nhefs_weights, age, qsmk, .weights = w_ate, include_observed = FALSE) } \seealso{ diff --git a/man/plot_stratified_residuals.Rd b/man/plot_stratified_residuals.Rd index f102eee..eb5ba68 100644 --- a/man/plot_stratified_residuals.Rd +++ b/man/plot_stratified_residuals.Rd @@ -11,7 +11,7 @@ plot_stratified_residuals(x, ...) \method{plot_stratified_residuals}{lm}( x, - treatment, + .exposure, ps_model = NULL, plot_type = c("color", "facet", "both"), smooth = TRUE, @@ -23,7 +23,7 @@ plot_stratified_residuals(x, ...) \method{plot_stratified_residuals}{glm}( x, - treatment, + .exposure, ps_model = NULL, plot_type = c("color", "facet", "both"), smooth = TRUE, @@ -35,7 +35,7 @@ plot_stratified_residuals(x, ...) \method{plot_stratified_residuals}{data.frame}( x, - treatment, + .exposure, residuals, x_var, plot_type = c("color", "facet", "both"), @@ -51,7 +51,7 @@ plot_stratified_residuals(x, ...) \item{...}{Additional arguments passed to methods} -\item{treatment}{A vector indicating treatment group membership. +\item{.exposure}{A vector indicating .exposure group membership. Must have exactly two unique levels. For data frames, can be an unquoted column name.} @@ -60,8 +60,8 @@ If provided, uses propensity scores instead of fitted values.} \item{plot_type}{Character; type of plot - "color" (default), "facet", or "both". \itemize{ -\item "color": Single plot with points colored by treatment -\item "facet": Separate facets for each treatment group +\item "color": Single plot with points colored by .exposure +\item "facet": Separate facets for each .exposure group \item "both": Both color and faceting }} @@ -82,56 +82,56 @@ Supports tidyselect syntax.} A ggplot2 object } \description{ -Create diagnostic plots to assess differences between treatment group after adjustment. +Create diagnostic plots to assess differences between .exposure group after adjustment. This function plots residuals from an outcome model against propensity scores (or fitted values), -stratified by treatment group, to reveal model mis-specification. +stratified by .exposure group, to reveal model mis-specification. } \details{ This diagnostic plot was originally suggested by Rosenbaum and Rubin (1983) and revisited by D'Agostino McGowan, D'Agostino, and D'Agostino (2023). The key idea is that plotting residuals against propensity scores -or fitted values by treatment group can reveal non-linear relationships or -heterogeneous treatment effects that might be obscured in standard +or fitted values by .exposure group can reveal non-linear relationships or +heterogeneous .exposure effects that might be obscured in standard residuals-vs-fitted plots. The function supports two approaches: \itemize{ \item For regression models (lm/glm): Extracts residuals and fitted values automatically -\item For data frames: Uses specified columns for residuals, treatment, and x-axis values +\item For data frames: Uses specified columns for residuals, .exposure, and x-axis values } } \examples{ \dontrun{ library(ggplot2) -# Simulate data with treatment effect heterogeneity +# Simulate data with .exposure effect heterogeneity set.seed(8) n <- 1000 x <- rnorm(n) ps <- plogis(x) # True propensity score -treatment <- rbinom(n, 1, ps) +.exposure <- rbinom(n, 1, ps) y1 <- 0.5 * x + rnorm(n) y0 <- -0.5 * x + rnorm(n) -y <- treatment * y1 + (1 - treatment) * y0 +y <- .exposure * y1 + (1 - .exposure) * y0 # Method 1: Using model objects # Fit misspecified model (missing interaction) -model_wrong <- lm(y ~ treatment + x) +model_wrong <- lm(y ~ .exposure + x) # Plot with fitted values plot_stratified_residuals( model_wrong, - treatment = treatment, + .exposure = .exposure, plot_type = "both" ) # Plot with propensity scores -ps_model <- glm(treatment ~ x, family = binomial) +ps_model <- glm(.exposure ~ x, family = binomial) plot_stratified_residuals( model_wrong, - treatment = treatment, + .exposure = .exposure, ps_model = ps_model, plot_type = "color" ) @@ -139,7 +139,7 @@ plot_stratified_residuals( # Method 2: Using data frame library(dplyr) plot_data <- data.frame( - treatment = treatment, + .exposure = .exposure, residuals = residuals(model_wrong), fitted_values = fitted(model_wrong), propensity_score = fitted(ps_model) @@ -147,7 +147,7 @@ plot_data <- data.frame( plot_stratified_residuals( plot_data, - treatment = treatment, + .exposure = .exposure, residuals = residuals, x_var = propensity_score, plot_type = "facet" diff --git a/man/stat_qq2.Rd b/man/stat_qq2.Rd index ea490f9..fdede43 100644 --- a/man/stat_qq2.Rd +++ b/man/stat_qq2.Rd @@ -15,7 +15,7 @@ stat_qq2( show.legend = NA, inherit.aes = TRUE, quantiles = seq(0.01, 0.99, 0.01), - treatment_level = NULL, + .reference_level = NULL, include_observed = FALSE, ... ) @@ -37,7 +37,7 @@ stat_qq2( \item{quantiles}{Numeric vector of quantiles to compute.} -\item{treatment_level}{The reference treatment level to use for comparisons.} +\item{.reference_level}{The reference treatment level to use for comparisons.} \item{include_observed}{For compatibility with qq(). When weights are present, this determines if an additional "observed" group is added. Default FALSE diff --git a/man/stat_roc.Rd b/man/stat_roc.Rd index 078e28b..05f0563 100644 --- a/man/stat_roc.Rd +++ b/man/stat_roc.Rd @@ -14,7 +14,7 @@ stat_roc( na.rm = TRUE, show.legend = NA, inherit.aes = TRUE, - treatment_level = NULL, + .focal_level = NULL, ... ) } @@ -39,7 +39,7 @@ If \code{TRUE}, missing values are silently removed.} \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, rather than combining with them.} -\item{treatment_level}{The level of the outcome variable to consider as the +\item{.focal_level}{The level of the outcome variable to consider as the treatment/event. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} diff --git a/man/treatment_param.Rd b/man/treatment_param.Rd index 0e5bdc6..a729a30 100644 --- a/man/treatment_param.Rd +++ b/man/treatment_param.Rd @@ -4,7 +4,7 @@ \alias{treatment_param} \title{Parameter Documentation for Treatment Level} \arguments{ -\item{treatment_level}{The level of the outcome variable to consider as the +\item{.focal_level}{The level of the outcome variable to consider as the treatment/event. If \code{NULL} (default), uses the last level for factors or the maximum value for numeric variables.} } diff --git a/man/weighted_quantile.Rd b/man/weighted_quantile.Rd index f1cd7a0..a74a473 100644 --- a/man/weighted_quantile.Rd +++ b/man/weighted_quantile.Rd @@ -4,14 +4,14 @@ \alias{weighted_quantile} \title{Compute weighted quantiles} \usage{ -weighted_quantile(values, quantiles, .wts) +weighted_quantile(values, quantiles, .weights) } \arguments{ \item{values}{Numeric vector of values to compute quantiles for.} \item{quantiles}{Numeric vector of probabilities with values between 0 and 1.} -\item{.wts}{Numeric vector of non-negative weights, same length as \code{values}.} +\item{.weights}{Numeric vector of non-negative weights, same length as \code{values}.} } \value{ Numeric vector of weighted quantiles corresponding to the requested probabilities. diff --git a/tests/testthat/_snaps/autoplot-methods/autoplot-halfmoon-qq.svg b/tests/testthat/_snaps/autoplot-methods/autoplot-halfmoon-qq.svg index 15d3179..d769a35 100644 --- a/tests/testthat/_snaps/autoplot-methods/autoplot-halfmoon-qq.svg +++ b/tests/testthat/_snaps/autoplot-methods/autoplot-halfmoon-qq.svg @@ -367,8 +367,8 @@ 50 60 70 -Control group quantiles -Treatment group quantiles +Unexposed group quantiles +Exposed group quantiles method diff --git a/tests/testthat/_snaps/autoplot-methods/plot-halfmoon-qq.svg b/tests/testthat/_snaps/autoplot-methods/plot-halfmoon-qq.svg index 3aeb1ac..11da3b6 100644 --- a/tests/testthat/_snaps/autoplot-methods/plot-halfmoon-qq.svg +++ b/tests/testthat/_snaps/autoplot-methods/plot-halfmoon-qq.svg @@ -267,8 +267,8 @@ 50 60 70 -Control group quantiles -Treatment group quantiles +Unexposed group quantiles +Exposed group quantiles method diff --git a/tests/testthat/_snaps/bal_model_auc.md b/tests/testthat/_snaps/bal_model_auc.md index a632fe6..663d318 100644 --- a/tests/testthat/_snaps/bal_model_auc.md +++ b/tests/testthat/_snaps/bal_model_auc.md @@ -22,5 +22,5 @@ expr Condition Error in `bal_model_auc()`: - ! `.wts` must select exactly one variable or be NULL + ! `.weights` must select exactly one variable or be NULL diff --git a/tests/testthat/_snaps/bal_model_roc_curve.md b/tests/testthat/_snaps/bal_model_roc_curve.md index 77e0d36..7ae68cf 100644 --- a/tests/testthat/_snaps/bal_model_roc_curve.md +++ b/tests/testthat/_snaps/bal_model_roc_curve.md @@ -22,5 +22,5 @@ expr Condition Error in `bal_model_roc_curve()`: - ! `.wts` must select exactly one variable or be NULL + ! `.weights` must select exactly one variable or be NULL diff --git a/tests/testthat/_snaps/bal_qq.md b/tests/testthat/_snaps/bal_qq.md index abed0eb..758a2d7 100644 --- a/tests/testthat/_snaps/bal_qq.md +++ b/tests/testthat/_snaps/bal_qq.md @@ -20,7 +20,7 @@ expr Condition Error: - ! Column `nonexistent` not found in `.group` + ! Column `nonexistent` not found in `.exposure` --- @@ -28,7 +28,7 @@ expr Condition Error in `bal_qq()`: - ! Group variable must have exactly two levels, got 5 + ! Exposure variable must have exactly two levels, got 5 --- @@ -36,7 +36,7 @@ expr Condition Error in `bal_qq()`: - ! `.wts` must select exactly one variable or be NULL + ! `.weights` must select exactly one variable or be NULL # bal_qq works with different treatment levels @@ -44,5 +44,5 @@ expr Condition Error in `bal_qq()`: - ! `treatment_level` '2' not found in `.group` levels: "0" and "1" + ! `.reference_level` '2' not found in `.exposure` levels: "0" and "1" diff --git a/tests/testthat/_snaps/check_balance.md b/tests/testthat/_snaps/check_balance.md index dc7f287..1f69d4f 100644 --- a/tests/testthat/_snaps/check_balance.md +++ b/tests/testthat/_snaps/check_balance.md @@ -37,7 +37,7 @@ expr Condition Error in `check_balance()`: - ! Group variable must have at least two levels for metrics: "smd", "vr", "ks", and "energy". Got 1 level. + ! Exposure variable must have at least two levels for metrics: "smd", "vr", "ks", and "energy". Got 1 level. # check_balance correlation requires numeric group variable @@ -45,7 +45,7 @@ expr Condition Error in `check_balance()`: - ! Group variable must be numeric when using correlation metric + ! Exposure variable must be numeric when using correlation metric # check_balance handles mixed metrics with correlation @@ -53,5 +53,5 @@ expr Condition Error in `check_balance()`: - ! Group variable must be numeric when using correlation metric + ! Exposure variable must be numeric when using correlation metric diff --git a/tests/testthat/_snaps/check_model_auc.md b/tests/testthat/_snaps/check_model_auc.md index ef3a210..0cc2dab 100644 --- a/tests/testthat/_snaps/check_model_auc.md +++ b/tests/testthat/_snaps/check_model_auc.md @@ -12,7 +12,7 @@ expr Condition Error in `check_model_roc_curve()`: - ! `.truth` must have exactly 2 unique values + ! `.exposure` must have exactly 2 unique values # error messages use proper cli formatting @@ -36,7 +36,7 @@ expr Condition Error in `check_model_roc_curve()`: - ! `.truth` must have exactly 2 levels + ! `.exposure` must have exactly 2 levels # treatment_level parameter works correctly @@ -44,5 +44,5 @@ expr Condition Error in `compute_roc_curve_imp()`: - ! `treatment_level` 'invalid' not found in `truth` levels: "0" and "1" + ! `.focal_level` 'invalid' not found in `truth` levels: "0" and "1" diff --git a/tests/testthat/_snaps/compute_balance.md b/tests/testthat/_snaps/compute_balance.md index defb489..470d246 100644 --- a/tests/testthat/_snaps/compute_balance.md +++ b/tests/testthat/_snaps/compute_balance.md @@ -4,7 +4,7 @@ expr Condition Error in `bal_smd()`: - ! Group variable must have exactly two levels, got 1 + ! Exposure variable must have exactly two levels, got 1 --- @@ -12,7 +12,7 @@ expr Condition Error in `bal_smd()`: - ! `covariate` and `group` must have the same length + ! `.covariate` and `.exposure` must have the same length --- @@ -20,7 +20,7 @@ expr Condition Error in `bal_smd()`: - ! `weights` must have length 100, got 50 + ! `.weights` must have length 100, got 50 # bal_vr error handling @@ -28,7 +28,7 @@ expr Condition Error in `split_by_group()`: - ! Group variable must have exactly two levels, got 1 + ! Exposure variable must have exactly two levels, got 1 --- @@ -36,7 +36,7 @@ expr Condition Error in `bal_vr()`: - ! `covariate` and `group` must have the same length + ! `.covariate` and `.exposure` must have the same length --- @@ -44,7 +44,7 @@ expr Condition Error in `bal_vr()`: - ! `weights` must have length 100, got 50 + ! `.weights` must have length 100, got 50 # bal_ks error handling @@ -52,7 +52,7 @@ expr Condition Error in `split_by_group()`: - ! Group variable must have exactly two levels, got 1 + ! Exposure variable must have exactly two levels, got 1 --- @@ -60,7 +60,7 @@ expr Condition Error in `bal_ks()`: - ! `covariate` and `group` must have the same length + ! `.covariate` and `.exposure` must have the same length --- @@ -68,7 +68,7 @@ expr Condition Error in `bal_ks()`: - ! `weights` must have length 100, got 50 + ! `.weights` must have length 100, got 50 # bal_corr handles edge cases @@ -92,7 +92,7 @@ expr Condition Error in `bal_corr()`: - ! `x` and `y` must have the same length + ! `.x` and `.y` must have the same length --- @@ -100,7 +100,7 @@ expr Condition Error in `bal_corr()`: - ! `weights` must have length 100, got 50 + ! `.weights` must have length 100, got 50 # bal_energy handles continuous treatments @@ -116,7 +116,7 @@ expr Condition Error in `bal_energy()`: - ! Energy distance cannot be computed with missing values in `covariates`. Set `na.rm = TRUE` or remove missing values. + ! Energy distance cannot be computed with missing values in `.covariates`. Set `na.rm = TRUE` or remove missing values. # bal_energy error handling @@ -124,7 +124,7 @@ expr Condition Error in `bal_energy()`: - ! `group` and `covariates` must have the same length + ! `.exposure` and `.covariates` must have the same length --- @@ -132,7 +132,7 @@ expr Condition Error in `bal_energy()`: - ! Group variable must have at least two levels + ! Exposure variable must have at least two levels --- @@ -140,5 +140,5 @@ expr Condition Error in `bal_energy()`: - ! `weights` cannot contain negative values + ! `.weights` cannot contain negative values diff --git a/tests/testthat/_snaps/compute_balance_categorical.md b/tests/testthat/_snaps/compute_balance_categorical.md index b1b2024..aed000e 100644 --- a/tests/testthat/_snaps/compute_balance_categorical.md +++ b/tests/testthat/_snaps/compute_balance_categorical.md @@ -4,5 +4,5 @@ expr Condition Error: - ! Group variable has only one level + ! Exposure variable has only one level diff --git a/tests/testthat/_snaps/compute_qq.md b/tests/testthat/_snaps/compute_qq.md index 63f274c..92cbbc9 100644 --- a/tests/testthat/_snaps/compute_qq.md +++ b/tests/testthat/_snaps/compute_qq.md @@ -20,7 +20,7 @@ expr Condition Error in `check_qq()`: - ! Group variable must have exactly 2 levels + ! Exposure variable must have exactly 2 levels # check_qq handles NA values correctly diff --git a/tests/testthat/_snaps/error-messages.md b/tests/testthat/_snaps/error-messages.md index e430920..d98ad66 100644 --- a/tests/testthat/_snaps/error-messages.md +++ b/tests/testthat/_snaps/error-messages.md @@ -1,18 +1,20 @@ # error messages show user-facing function names Code - plot_mirror_distributions(nhefs_weights, age, alcoholfreq_cat, reference_group = "invalid") + plot_mirror_distributions(nhefs_weights, age, alcoholfreq_cat, + .reference_level = "invalid") Condition Error in `plot_mirror_distributions()`: - ! `reference_group` "invalid" not found in grouping variable + ! `.reference_level` "invalid" not found in grouping variable --- Code - plot_mirror_distributions(nhefs_weights, age, alcoholfreq_cat, reference_group = 10) + plot_mirror_distributions(nhefs_weights, age, alcoholfreq_cat, + .reference_level = 10) Condition Error in `plot_mirror_distributions()`: - ! Reference group index 10 out of bounds + ! .reference_level index 10 out of bounds --- @@ -33,10 +35,10 @@ --- Code - plot_qq(nhefs_weights, age, qsmk, treatment_level = "invalid") + plot_qq(nhefs_weights, age, qsmk, .reference_level = "invalid") Condition Error in `plot_qq()`: - ! `treatment_level` 'invalid' not found in `.group` levels: "0" and "1" + ! `.reference_level` 'invalid' not found in `.group` levels: "0" and "1" --- @@ -44,20 +46,20 @@ plot_stratified_residuals(model) Condition Error in `plot_stratified_residuals()`: - ! Argument `treatment` is required + ! Argument `.exposure` is required --- Code check_balance(nhefs_weights, .vars = age, .group = rep(1, nrow(nhefs_weights))) - Condition - Error in `as_string()`: - ! Can't convert a call to a string. + Condition + Error in `check_balance()`: + ! unused argument (.group = rep(1, nrow(nhefs_weights))) --- Code - bal_prognostic_score(nhefs_weights, treatment = qsmk, formula = wt82_71 ~ age + + bal_prognostic_score(nhefs_weights, .exposure = qsmk, formula = wt82_71 ~ age + qsmk + wt71) Condition Error in `bal_prognostic_score()`: @@ -67,18 +69,17 @@ Code check_balance(nhefs_weights, .vars = age, .group = "not_numeric") - Condition + Condition Error in `check_balance()`: - ! Column `not_numeric` not found in `data` + ! unused argument (.group = "not_numeric") --- Code check_balance(data.frame(), .vars = age, .group = qsmk) - Condition + Condition Error in `check_balance()`: - ! Can't select columns that don't exist. - x Column `age` doesn't exist. + ! unused argument (.group = qsmk) # errors have correct custom classes @@ -86,7 +87,7 @@ expr Condition Error in `plot_mirror_distributions()`: - ! `reference_group` "invalid" not found in grouping variable + ! `.reference_level` "invalid" not found in grouping variable --- @@ -94,7 +95,7 @@ expr Condition Error in `plot_mirror_distributions()`: - ! Reference group index 10 out of bounds + ! .reference_level index 10 out of bounds --- diff --git a/tests/testthat/_snaps/geom_qq2/geom-qq2-basic.svg b/tests/testthat/_snaps/geom_qq2/geom-qq2-basic.svg index 51d2379..b268a9a 100644 --- a/tests/testthat/_snaps/geom_qq2/geom-qq2-basic.svg +++ b/tests/testthat/_snaps/geom_qq2/geom-qq2-basic.svg @@ -150,8 +150,8 @@ 50 60 70 -treated_quantiles -untreated_quantiles +exposed_quantiles +unexposed_quantiles geom_qq2 basic diff --git a/tests/testthat/_snaps/geom_qq2/geom-qq2-custom-quantiles.svg b/tests/testthat/_snaps/geom_qq2/geom-qq2-custom-quantiles.svg index 7a3df06..9a766cc 100644 --- a/tests/testthat/_snaps/geom_qq2/geom-qq2-custom-quantiles.svg +++ b/tests/testthat/_snaps/geom_qq2/geom-qq2-custom-quantiles.svg @@ -52,8 +52,8 @@ 40 50 60 -treated_quantiles -untreated_quantiles +exposed_quantiles +unexposed_quantiles geom_qq2 custom quantiles diff --git a/tests/testthat/_snaps/geom_qq2/geom-qq2-multiple-weights.svg b/tests/testthat/_snaps/geom_qq2/geom-qq2-multiple-weights.svg index 7ec843d..0a42fbb 100644 --- a/tests/testthat/_snaps/geom_qq2/geom-qq2-multiple-weights.svg +++ b/tests/testthat/_snaps/geom_qq2/geom-qq2-multiple-weights.svg @@ -249,8 +249,8 @@ 50 60 70 -treated_quantiles -untreated_quantiles +exposed_quantiles +unexposed_quantiles weight_type diff --git a/tests/testthat/_snaps/geom_qq2/geom-qq2-weighted.svg b/tests/testthat/_snaps/geom_qq2/geom-qq2-weighted.svg index 4ffad8c..3e05b8c 100644 --- a/tests/testthat/_snaps/geom_qq2/geom-qq2-weighted.svg +++ b/tests/testthat/_snaps/geom_qq2/geom-qq2-weighted.svg @@ -150,8 +150,8 @@ 50 60 70 -treated_quantiles -untreated_quantiles +exposed_quantiles +unexposed_quantiles geom_qq2 weighted diff --git a/tests/testthat/_snaps/geom_roc/geom-roc-treatment-level-0.svg b/tests/testthat/_snaps/geom_roc/geom-roc-treatment-level-0.svg index 75a0e90..1f6e186 100644 --- a/tests/testthat/_snaps/geom_roc/geom-roc-treatment-level-0.svg +++ b/tests/testthat/_snaps/geom_roc/geom-roc-treatment-level-0.svg @@ -53,6 +53,6 @@ 1.00 fpr tpr -ROC with treatment_level = '0' +ROC with .focal_level = '0' diff --git a/tests/testthat/_snaps/geom_roc/geom-roc-treatment-level-1.svg b/tests/testthat/_snaps/geom_roc/geom-roc-treatment-level-1.svg index 96c8aea..9644111 100644 --- a/tests/testthat/_snaps/geom_roc/geom-roc-treatment-level-1.svg +++ b/tests/testthat/_snaps/geom_roc/geom-roc-treatment-level-1.svg @@ -53,6 +53,6 @@ 1.00 fpr tpr -ROC with treatment_level = '1' +ROC with .focal_level = '1' diff --git a/tests/testthat/_snaps/plot_mirror_distributions.md b/tests/testthat/_snaps/plot_mirror_distributions.md index cb17796..32bfed5 100644 --- a/tests/testthat/_snaps/plot_mirror_distributions.md +++ b/tests/testthat/_snaps/plot_mirror_distributions.md @@ -20,7 +20,7 @@ expr Condition Error in `plot_mirror_distributions()`: - ! Argument `.group` is required + ! Argument `.exposure` is required --- @@ -36,7 +36,7 @@ expr Condition Error in `plot_mirror_distributions()`: - ! Group variable must have at least two levels + ! Exposure variable must have at least two levels # plot_mirror_distributions validates categorical reference group @@ -44,7 +44,7 @@ expr Condition Error in `plot_mirror_distributions()`: - ! `reference_group` "invalid" not found in grouping variable + ! `.reference_level` "invalid" not found in grouping variable --- @@ -52,5 +52,5 @@ expr Condition Error in `plot_mirror_distributions()`: - ! Reference group index 10 out of bounds + ! .reference_level index 10 out of bounds diff --git a/tests/testthat/_snaps/plot_qq.md b/tests/testthat/_snaps/plot_qq.md index e3c1d2f..a47eca8 100644 --- a/tests/testthat/_snaps/plot_qq.md +++ b/tests/testthat/_snaps/plot_qq.md @@ -36,7 +36,7 @@ expr Condition Error in `plot_qq()`: - ! Group variable must have exactly 2 levels + ! Exposure variable must have exactly 2 levels # plot_qq handles NA values diff --git a/tests/testthat/_snaps/plot_stratified_residuals.md b/tests/testthat/_snaps/plot_stratified_residuals.md index eec068d..d4f8c09 100644 --- a/tests/testthat/_snaps/plot_stratified_residuals.md +++ b/tests/testthat/_snaps/plot_stratified_residuals.md @@ -4,7 +4,7 @@ expr Condition Error in `plot_stratified_residuals()`: - ! Argument `treatment` is required + ! Argument `.exposure` is required --- @@ -20,7 +20,7 @@ expr Condition Error in `plot_stratified_residuals()`: - ! Argument `treatment` is required + ! Argument `.exposure` is required --- @@ -43,6 +43,6 @@ Code expr Condition - Error in `plot_stratified_residuals_impl()`: - ! `.treatment` must have exactly two levels, got 3 + Error in `plot_stratified_residuals()`: + ! `.exposure` must have exactly two levels, got 3 diff --git a/tests/testthat/_snaps/plot_stratified_residuals/sr-df-fitted-wrong.svg b/tests/testthat/_snaps/plot_stratified_residuals/sr-df-fitted-wrong.svg index 68eca03..1c1dff4 100644 --- a/tests/testthat/_snaps/plot_stratified_residuals/sr-df-fitted-wrong.svg +++ b/tests/testthat/_snaps/plot_stratified_residuals/sr-df-fitted-wrong.svg @@ -21,1016 +21,1016 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -4 @@ -1041,24 +1041,24 @@ - - - -0.200 -0.225 -0.250 -fitted_vals + + + +0.200 +0.225 +0.250 +fitted_vals residuals - -treatment - - - - - - -0 -1 + +.exposure + + + + + + +0 +1 sr df fitted wrong diff --git a/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-both-wrong.svg b/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-both-wrong.svg index 93e2ef5..e58acf0 100644 --- a/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-both-wrong.svg +++ b/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-both-wrong.svg @@ -21,1064 +21,1064 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - -0 + + +0 - - + + - - -1 + + +1 - - - -0.200 -0.225 -0.250 - - - -0.200 -0.225 -0.250 + + + +0.200 +0.225 +0.250 + + + +0.200 +0.225 +0.250 -4 -2 0 @@ -1087,18 +1087,18 @@ -Fitted values +Fitted values residuals - -treatment - - - - - - -0 -1 + +.exposure + + + + + + +0 +1 sr lm both wrong diff --git a/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-color-wrong.svg b/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-color-wrong.svg index d2afb7a..fd1fef5 100644 --- a/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-color-wrong.svg +++ b/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-color-wrong.svg @@ -21,1016 +21,1016 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -4 @@ -1041,24 +1041,24 @@ - - - -0.200 -0.225 -0.250 -Fitted values + + + +0.200 +0.225 +0.250 +Fitted values residuals - -treatment - - - - - - -0 -1 + +.exposure + + + + + + +0 +1 sr lm color wrong diff --git a/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-correct.svg b/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-correct.svg index f3fdbdc..e93f5c0 100644 --- a/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-correct.svg +++ b/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-correct.svg @@ -21,1064 +21,1064 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + - - -0 + + +0 - - + + - - -1 + + +1 - - - --1 -0 -1 - - - --1 -0 -1 + + + +-1 +0 +1 + + + +-1 +0 +1 -4 -2 0 @@ -1087,18 +1087,18 @@ -Fitted values +Fitted values residuals - -treatment - - - - - - -0 -1 + +.exposure + + + + + + +0 +1 sr lm correct diff --git a/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-ps-wrong.svg b/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-ps-wrong.svg index ff28cca..137124d 100644 --- a/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-ps-wrong.svg +++ b/tests/testthat/_snaps/plot_stratified_residuals/sr-lm-ps-wrong.svg @@ -21,1016 +21,1016 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -4 @@ -1041,24 +1041,24 @@ - - - -0.25 -0.50 -0.75 -Propensity score + + + +0.25 +0.50 +0.75 +Propensity score residuals - -treatment - - - - - - -0 -1 + +.exposure + + + + + + +0 +1 sr lm ps wrong diff --git a/tests/testthat/test-autoplot-methods.R b/tests/testthat/test-autoplot-methods.R index 72d8934..65ede16 100644 --- a/tests/testthat/test-autoplot-methods.R +++ b/tests/testthat/test-autoplot-methods.R @@ -1,5 +1,10 @@ test_that("autoplot works for halfmoon_balance", { - balance_data <- check_balance(nhefs_weights, c(age, wt71), qsmk, .wts = w_ate) + balance_data <- check_balance( + nhefs_weights, + c(age, wt71), + qsmk, + .weights = w_ate + ) p <- autoplot(balance_data) expect_s3_class(p, "ggplot") @@ -17,7 +22,7 @@ test_that("autoplot works for halfmoon_auc", { }) test_that("autoplot works for halfmoon_ess", { - ess_data <- check_ess(nhefs_weights, .wts = c(w_ate, w_att)) + ess_data <- check_ess(nhefs_weights, .weights = c(w_ate, w_att)) p <- autoplot(ess_data) expect_s3_class(p, "ggplot") @@ -53,7 +58,7 @@ test_that("autoplot works for halfmoon_roc", { }) test_that("autoplot works for halfmoon_qq", { - qq_data <- check_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) + qq_data <- check_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) p <- autoplot(qq_data) expect_s3_class(p, "ggplot") @@ -63,16 +68,21 @@ test_that("autoplot works for halfmoon_qq", { test_that("plot methods work for all halfmoon classes", { # Create all data types - balance_data <- check_balance(nhefs_weights, c(age, wt71), qsmk, .wts = w_ate) + balance_data <- check_balance( + nhefs_weights, + c(age, wt71), + qsmk, + .weights = w_ate + ) auc_data <- check_model_auc(nhefs_weights, qsmk, .fitted, w_ate) - ess_data <- check_ess(nhefs_weights, .wts = w_ate) + ess_data <- check_ess(nhefs_weights, .weights = w_ate) cal_data <- suppress_calibration_warnings(check_model_calibration( nhefs_weights, .fitted, qsmk )) roc_data <- check_model_roc_curve(nhefs_weights, qsmk, .fitted, w_ate) - qq_data <- check_qq(nhefs_weights, age, qsmk, .wts = w_ate) + qq_data <- check_qq(nhefs_weights, age, qsmk, .weights = w_ate) # Test plot() methods with vdiffr expect_doppelganger( diff --git a/tests/testthat/test-bal_model_auc.R b/tests/testthat/test-bal_model_auc.R index df28a37..3944431 100644 --- a/tests/testthat/test-bal_model_auc.R +++ b/tests/testthat/test-bal_model_auc.R @@ -75,7 +75,7 @@ test_that("bal_model_auc works with different treatment levels", { nhefs_weights, qsmk, .fitted, - treatment_level = 1 + .focal_level = 1 ) # Should be different from opposite level @@ -83,7 +83,7 @@ test_that("bal_model_auc works with different treatment levels", { nhefs_weights, qsmk, .fitted, - treatment_level = 0 + .focal_level = 0 ) expect_false(isTRUE(all.equal(auc_explicit, auc_opposite))) }) diff --git a/tests/testthat/test-bal_prognostic_score.R b/tests/testthat/test-bal_prognostic_score.R index 8698f05..05ba78b 100644 --- a/tests/testthat/test-bal_prognostic_score.R +++ b/tests/testthat/test-bal_prognostic_score.R @@ -3,8 +3,8 @@ test_that("bal_prognostic_score works with tidyselect interface", { scores <- bal_prognostic_score( nhefs_weights, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex, wt71) + .exposure = qsmk, + .covariates = c(age, sex, wt71) ) expect_type(scores, "double") @@ -15,8 +15,8 @@ test_that("bal_prognostic_score works with tidyselect interface", { scores_quoted <- bal_prognostic_score( nhefs_weights, outcome = "wt82_71", - treatment = "qsmk", - covariates = c("age", "sex", "wt71") + .exposure = "qsmk", + .covariates = c("age", "sex", "wt71") ) expect_equal(scores, scores_quoted) @@ -25,8 +25,8 @@ test_that("bal_prognostic_score works with tidyselect interface", { scores2 <- bal_prognostic_score( nhefs_weights, outcome = wt82_71, - treatment = qsmk, - covariates = matches("^(age|sex|race|education)$") + .exposure = qsmk, + .covariates = matches("^(age|sex|race|education)$") ) expect_type(scores2, "double") @@ -37,7 +37,7 @@ test_that("bal_prognostic_score works with formula interface", { # Formula interface scores_formula <- bal_prognostic_score( nhefs_weights, - treatment = qsmk, + .exposure = qsmk, formula = wt82_71 ~ age + sex + wt71 ) @@ -49,7 +49,7 @@ test_that("bal_prognostic_score validates treatment not in formula", { expect_halfmoon_error( bal_prognostic_score( nhefs_weights, - treatment = qsmk, + .exposure = qsmk, formula = wt82_71 ~ age + qsmk + wt71 ), "halfmoon_formula_error" @@ -61,8 +61,8 @@ test_that("bal_prognostic_score handles different families", { scores_binary <- bal_prognostic_score( nhefs_weights, outcome = death, - treatment = qsmk, - covariates = c(age, sex), + .exposure = qsmk, + .covariates = c(age, sex), family = binomial() ) @@ -74,9 +74,9 @@ test_that("bal_prognostic_score handles weights", { scores_weighted <- bal_prognostic_score( nhefs_weights, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex), - weights = w_ate + .exposure = qsmk, + .covariates = c(age, sex), + .weights = w_ate ) expect_type(scores_weighted, "double") @@ -86,22 +86,22 @@ test_that("bal_prognostic_score handles weights", { scores_weighted2 <- bal_prognostic_score( nhefs_weights, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex), - weights = "w_ate" + .exposure = qsmk, + .covariates = c(age, sex), + .weights = "w_ate" ) expect_equal(scores_weighted, scores_weighted2) }) -test_that("bal_prognostic_score handles treatment_level parameter", { +test_that("bal_prognostic_score handles .reference_level parameter", { # Specify control level explicitly scores_ref <- bal_prognostic_score( nhefs_weights, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex), - treatment_level = 0 + .exposure = qsmk, + .covariates = c(age, sex), + .reference_level = 0 ) expect_type(scores_ref, "double") @@ -118,8 +118,8 @@ test_that("bal_prognostic_score handles na.rm parameter correctly", { scores_with_na <- bal_prognostic_score( data_with_na, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex), + .exposure = qsmk, + .covariates = c(age, sex), na.rm = FALSE ) expect_type(scores_with_na, "double") @@ -131,8 +131,8 @@ test_that("bal_prognostic_score handles na.rm parameter correctly", { scores_na_rm <- bal_prognostic_score( data_with_na, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex), + .exposure = qsmk, + .covariates = c(age, sex), na.rm = TRUE ) @@ -149,8 +149,8 @@ test_that("bal_prognostic_score handles na.rm parameter correctly", { scores_cov_na <- bal_prognostic_score( data_with_na_cov, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex), + .exposure = qsmk, + .covariates = c(age, sex), na.rm = FALSE ) expect_length(scores_cov_na, nrow(data_with_na_cov)) @@ -159,8 +159,8 @@ test_that("bal_prognostic_score handles na.rm parameter correctly", { scores_cov_na_rm <- bal_prognostic_score( data_with_na_cov, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex), + .exposure = qsmk, + .covariates = c(age, sex), na.rm = TRUE ) expect_length( @@ -177,8 +177,8 @@ test_that("bal_prognostic_score errors with no control observations", { bal_prognostic_score( treated_only, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex) + .exposure = qsmk, + .covariates = c(age, sex) ), "halfmoon_reference_error" ) @@ -189,8 +189,8 @@ test_that("bal_prognostic_score errors when required arguments missing", { expect_halfmoon_error( bal_prognostic_score( nhefs_weights, - treatment = qsmk, - covariates = c(age, sex) + .exposure = qsmk, + .covariates = c(age, sex) ), "halfmoon_arg_error" ) @@ -199,7 +199,7 @@ test_that("bal_prognostic_score errors when required arguments missing", { expect_halfmoon_error( bal_prognostic_score( nhefs_weights, - treatment = qsmk, + .exposure = qsmk, formula = "not a formula" ), "halfmoon_formula_error" @@ -211,7 +211,7 @@ test_that("bal_prognostic_score handles everything() selector", { scores_all <- bal_prognostic_score( nhefs_weights[, c("wt82_71", "qsmk", "age", "sex", "wt71")], outcome = wt82_71, - treatment = qsmk + .exposure = qsmk ) expect_type(scores_all, "double") @@ -223,8 +223,8 @@ test_that("bal_prognostic_score integrates with balance functions", { prog_scores <- bal_prognostic_score( nhefs_weights, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex, wt71) + .exposure = qsmk, + .covariates = c(age, sex, wt71) ) # Add to data @@ -233,9 +233,9 @@ test_that("bal_prognostic_score integrates with balance functions", { # Check balance using existing functions balance_smd <- bal_smd( - test_data$prog_score, - test_data$qsmk, - weights = test_data$w_ate + .covariate = test_data$prog_score, + .exposure = test_data$qsmk, + .weights = test_data$w_ate ) expect_type(balance_smd, "double") @@ -245,7 +245,7 @@ test_that("bal_prognostic_score integrates with balance functions", { test_data, prog_score, qsmk, - .wts = w_ate + .weights = w_ate ) expect_s3_class(balance_check, "tbl_df") @@ -256,8 +256,8 @@ test_that("bal_prognostic_score produces reasonable predictions", { scores <- bal_prognostic_score( nhefs_weights, outcome = wt82_71, - treatment = qsmk, - covariates = c(age, sex, wt71) + .exposure = qsmk, + .covariates = c(age, sex, wt71) ) # Scores should be in reasonable range for weight change @@ -271,7 +271,7 @@ test_that("bal_prognostic_score handles formula with transformations", { # Formula with polynomial and interaction terms scores_complex <- bal_prognostic_score( nhefs_weights, - treatment = qsmk, + .exposure = qsmk, formula = wt82_71 ~ age + I(age^2) + sex + wt71 + age:sex ) @@ -281,7 +281,7 @@ test_that("bal_prognostic_score handles formula with transformations", { # Should produce different results than simple model scores_simple <- bal_prognostic_score( nhefs_weights, - treatment = qsmk, + .exposure = qsmk, formula = wt82_71 ~ age + sex + wt71 ) diff --git a/tests/testthat/test-bal_qq.R b/tests/testthat/test-bal_qq.R index fb9f7aa..6d083fa 100644 --- a/tests/testthat/test-bal_qq.R +++ b/tests/testthat/test-bal_qq.R @@ -4,31 +4,31 @@ test_that("bal_qq works with unweighted data", { expect_s3_class(qq_data, "tbl_df") expect_named( qq_data, - c("quantile", "treated_quantiles", "untreated_quantiles") + c("quantile", "exposed_quantiles", "unexposed_quantiles") ) # Default should be 99 quantiles expect_equal(nrow(qq_data), 99) # Quantiles should be in order - expect_true(all(diff(qq_data$treated_quantiles) >= 0)) - expect_true(all(diff(qq_data$untreated_quantiles) >= 0)) + expect_true(all(diff(qq_data$exposed_quantiles) >= 0)) + expect_true(all(diff(qq_data$unexposed_quantiles) >= 0)) }) test_that("bal_qq works with weighted data", { - qq_data <- bal_qq(nhefs_weights, age, qsmk, .wts = w_ate) + qq_data <- bal_qq(nhefs_weights, age, qsmk, .weights = w_ate) expect_s3_class(qq_data, "tbl_df") expect_named( qq_data, - c("quantile", "treated_quantiles", "untreated_quantiles") + c("quantile", "exposed_quantiles", "unexposed_quantiles") ) # Should be different from unweighted qq_unweighted <- bal_qq(nhefs_weights, age, qsmk) expect_false(identical( - qq_data$treated_quantiles, - qq_unweighted$treated_quantiles + qq_data$exposed_quantiles, + qq_unweighted$exposed_quantiles )) }) @@ -48,7 +48,7 @@ test_that("bal_qq handles missing values", { # With na.rm = TRUE qq_data <- bal_qq(nhefs_na, age, qsmk, na.rm = TRUE) expect_s3_class(qq_data, "tbl_df") - expect_false(any(is.na(qq_data$treated_quantiles))) + expect_false(any(is.na(qq_data$exposed_quantiles))) # With na.rm = FALSE should error expect_halfmoon_error( @@ -78,7 +78,7 @@ test_that("bal_qq validates inputs", { # Multiple weights should error expect_halfmoon_error( - bal_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)), + bal_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)), class = "halfmoon_arg_error" ) }) @@ -92,30 +92,30 @@ test_that("bal_qq works with different treatment levels", { nhefs_weights, age, qsmk, - treatment_level = 1, + .reference_level = 1, quantiles = c(0.25, 0.5, 0.75) ) # Default should match explicit treatment_level = 1 - expect_equal(qq_default$treated_quantiles, qq_1$treated_quantiles) - expect_equal(qq_default$untreated_quantiles, qq_1$untreated_quantiles) + expect_equal(qq_default$exposed_quantiles, qq_1$exposed_quantiles) + expect_equal(qq_default$unexposed_quantiles, qq_1$unexposed_quantiles) # Explicit treatment level = 0 qq_0 <- bal_qq( nhefs_weights, age, qsmk, - treatment_level = 0, + .reference_level = 0, quantiles = c(0.25, 0.5, 0.75) ) # Treated and untreated should swap - expect_equal(qq_1$treated_quantiles, qq_0$untreated_quantiles) - expect_equal(qq_1$untreated_quantiles, qq_0$treated_quantiles) + expect_equal(qq_1$exposed_quantiles, qq_0$unexposed_quantiles) + expect_equal(qq_1$unexposed_quantiles, qq_0$exposed_quantiles) # Invalid treatment level should error expect_halfmoon_error( - bal_qq(nhefs_weights, age, qsmk, treatment_level = 2), + bal_qq(nhefs_weights, age, qsmk, .reference_level = 2), class = "halfmoon_reference_error" ) }) @@ -133,26 +133,26 @@ test_that("bal_qq matches single method from check_qq", { qq_check_observed <- qq_check[qq_check$method == "observed", ] expect_equal(qq_single$quantile, qq_check_observed$quantile) - expect_equal(qq_single$treated_quantiles, qq_check_observed$treated_quantiles) + expect_equal(qq_single$exposed_quantiles, qq_check_observed$exposed_quantiles) expect_equal( - qq_single$untreated_quantiles, - qq_check_observed$untreated_quantiles + qq_single$unexposed_quantiles, + qq_check_observed$unexposed_quantiles ) # Test with weighted data - qq_single_wt <- bal_qq(nhefs_weights, age, qsmk, .wts = w_ate) + qq_single_wt <- bal_qq(nhefs_weights, age, qsmk, .weights = w_ate) qq_check_wt <- check_qq( nhefs_weights, age, qsmk, - .wts = w_ate, + .weights = w_ate, include_observed = FALSE ) expect_equal(qq_single_wt$quantile, qq_check_wt$quantile) - expect_equal(qq_single_wt$treated_quantiles, qq_check_wt$treated_quantiles) + expect_equal(qq_single_wt$exposed_quantiles, qq_check_wt$exposed_quantiles) expect_equal( - qq_single_wt$untreated_quantiles, - qq_check_wt$untreated_quantiles + qq_single_wt$unexposed_quantiles, + qq_check_wt$unexposed_quantiles ) }) diff --git a/tests/testthat/test-check_balance.R b/tests/testthat/test-check_balance.R index e1f6e6f..5021629 100644 --- a/tests/testthat/test-check_balance.R +++ b/tests/testthat/test-check_balance.R @@ -110,7 +110,7 @@ test_that("check_balance works with single weight", { data, age, qsmk, - .wts = w_test1, + .weights = w_test1, .metrics = "smd" ) @@ -128,7 +128,7 @@ test_that("check_balance works with multiple weights", { data, age, qsmk, - .wts = c(w_test1, w_test2), + .weights = c(w_test1, w_test2), .metrics = "smd" ) @@ -146,7 +146,7 @@ test_that("check_balance respects include_observed = FALSE", { data, age, qsmk, - .wts = w_test1, + .weights = w_test1, .metrics = "smd", include_observed = FALSE ) @@ -167,7 +167,7 @@ test_that("check_balance produces expected structure with multiple vars, weights data, c(age, wt71), qsmk, - .wts = c(w_test1, w_test2), + .weights = c(w_test1, w_test2), .metrics = c("smd", "ks") ) @@ -198,9 +198,9 @@ test_that("check_balance SMD matches bal_smd", { # Get result from bal_smd directly direct_smd <- bal_smd( - covariate = data$age, - group = data$qsmk, - reference_group = 1L + .covariate = data$age, + .exposure = data$qsmk, + .reference_level = 1L ) expect_equal(balance_smd, direct_smd, tolerance = 1e-10) @@ -218,9 +218,9 @@ test_that("check_balance vr matches bal_vr", { # Get result from bal_vr directly # check_balance uses reference_group=1L which maps to first level (0) for bal_vr direct_vr <- bal_vr( - covariate = data$age, - group = data$qsmk, - reference_group = 0 # First level of qsmk (group_levels[1]) + .covariate = data$age, + .exposure = data$qsmk, + .reference_level = 0 # First level of qsmk (group_levels[1]) ) expect_equal(balance_vr, direct_vr, tolerance = 1e-10) @@ -237,9 +237,9 @@ test_that("check_balance KS matches bal_ks", { # Get result from bal_ks directly direct_ks <- bal_ks( - covariate = data$age, - group = data$qsmk, - reference_group = 0 # First level of qsmk + .covariate = data$age, + .exposure = data$qsmk, + .reference_level = 0 # First level of qsmk ) expect_equal(balance_ks, direct_ks, tolerance = 1e-10) @@ -253,7 +253,7 @@ test_that("check_balance weighted results match individual weighted functions", data, age, qsmk, - .wts = w_test1, + .weights = w_test1, .metrics = "smd" ) balance_smd <- result$estimate[ @@ -261,10 +261,10 @@ test_that("check_balance weighted results match individual weighted functions", ] direct_smd <- bal_smd( - covariate = data$age, - group = data$qsmk, - weights = data$w_test1, - reference_group = 1L + .covariate = data$age, + .exposure = data$qsmk, + .weights = data$w_test1, + .reference_level = 1L ) expect_equal(balance_smd, direct_smd, tolerance = 1e-10) @@ -274,7 +274,7 @@ test_that("check_balance weighted results match individual weighted functions", data, age, qsmk, - .wts = w_test1, + .weights = w_test1, .metrics = "vr" ) balance_vr <- result_vr$estimate[ @@ -282,10 +282,10 @@ test_that("check_balance weighted results match individual weighted functions", ] direct_vr <- bal_vr( - covariate = data$age, - group = data$qsmk, - weights = data$w_test1, - reference_group = 0 # First level (group_levels[1]) + .covariate = data$age, + .exposure = data$qsmk, + .weights = data$w_test1, + .reference_level = 0 # First level (group_levels[1]) ) expect_equal(balance_vr, direct_vr, tolerance = 1e-10) @@ -304,14 +304,14 @@ test_that("check_balance handles different reference groups correctly", { age, qsmk, .metrics = "smd", - reference_group = 0 + .reference_level = 0 ) result2 <- check_balance_basic( data, age, qsmk, .metrics = "smd", - reference_group = 1 + .reference_level = 1 ) # SMDs should be negatives of each other @@ -331,14 +331,14 @@ test_that("check_balance handles factor reference groups", { age, sex, .metrics = "smd", - reference_group = "0" + .reference_level = "0" ) result2 <- check_balance_basic( data, age, sex, .metrics = "smd", - reference_group = "1" + .reference_level = "1" ) # SMDs should be negatives of each other @@ -382,9 +382,9 @@ test_that("check_balance handles missing values correctly", { # Verify the na.rm = TRUE result matches direct computation direct_smd <- bal_smd( - covariate = data_na$age, - group = data_na$qsmk, - reference_group = 1L, + .covariate = data_na$age, + .exposure = data_na$qsmk, + .reference_level = 1L, na.rm = TRUE ) expect_equal(result_na_true$estimate, direct_smd, tolerance = 1e-10) @@ -434,7 +434,7 @@ test_that("check_balance validates inputs correctly", { data, age, qsmk, - .wts = w_test1, + .weights = w_test1, include_observed = FALSE, .metrics = character(0) ) @@ -467,7 +467,7 @@ test_that("check_balance handles binary variables correctly", { # For binary variables, KS should equal absolute difference in proportions # Verify this matches the direct computation ks_result <- result$estimate[result$metric == "ks"] - direct_ks <- bal_ks(data$qsmk_num, data$sex_num, reference_group = 0) + direct_ks <- bal_ks(data$qsmk_num, data$sex_num, .reference_level = 0) expect_equal(ks_result, direct_ks, tolerance = 1e-10) }) @@ -479,7 +479,7 @@ test_that("check_balance handles extreme weights", { data, age, qsmk, - .wts = w_extreme, + .weights = w_extreme, .metrics = "smd" ) @@ -491,8 +491,8 @@ test_that("check_balance handles extreme weights", { direct_smd <- bal_smd( data$age, data$qsmk, - weights = data$w_extreme, - reference_group = 1L + .weights = data$w_extreme, + .reference_level = 1L ) expect_equal(weighted_estimate, direct_smd, tolerance = 1e-10) }) @@ -504,7 +504,7 @@ test_that("check_balance output is properly arranged", { data, c(age, wt71), qsmk, - .wts = c(w_test1, w_test2), + .weights = c(w_test1, w_test2), .metrics = c("smd", "ks") ) @@ -591,7 +591,7 @@ test_that("check_balance handles realistic smoking cessation balance assessment" data, all_of(covariates), qsmk, - .wts = c(w_test1, w_test2), + .weights = c(w_test1, w_test2), .metrics = c("smd", "ks") ) @@ -619,7 +619,7 @@ test_that("check_balance handles full NHEFS dataset efficiently", { nhefs_weights, c(age, wt71, smokeintensity), qsmk, - .wts = c(w_ate, w_att), + .weights = c(w_ate, w_att), .metrics = c("smd", "vr", "ks") ) }) @@ -666,7 +666,7 @@ test_that("check_balance works with real propensity score weights", { data, c(age, wt71, smokeintensity), qsmk, - .wts = c(w_ate, w_att, w_atc), + .weights = c(w_ate, w_att, w_atc), .metrics = "smd" ) @@ -711,7 +711,7 @@ test_that("check_balance correlation works with weights", { data, c(wt71, smokeintensity), age, - .wts = w_ate, + .weights = w_ate, .metrics = "correlation" ) @@ -785,7 +785,7 @@ test_that("check_balance correlation handles missing values", { expect_true(is.finite(result_na_true$estimate)) }) -test_that("check_balance supports both quoted and unquoted .wts", { +test_that("check_balance supports both quoted and unquoted .weights", { data <- get_nhefs_test_data() # Test unquoted weight @@ -793,7 +793,7 @@ test_that("check_balance supports both quoted and unquoted .wts", { data, age, qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = "smd" ) @@ -802,7 +802,7 @@ test_that("check_balance supports both quoted and unquoted .wts", { data, age, qsmk, - .wts = "w_ate", + .weights = "w_ate", .metrics = "smd" ) @@ -818,7 +818,7 @@ test_that("check_balance supports multiple weight selection with c()", { data, age, qsmk, - .wts = c(w_ate, w_att), + .weights = c(w_ate, w_att), .metrics = "smd" ) @@ -827,7 +827,7 @@ test_that("check_balance supports multiple weight selection with c()", { data, age, qsmk, - .wts = c("w_ate", "w_att"), + .weights = c("w_ate", "w_att"), .metrics = "smd" ) @@ -1099,7 +1099,7 @@ test_that("transformations work with weights", { data, c(age, wt71), qsmk, - .wts = w_test1, + .weights = w_test1, .metrics = "smd", squares = TRUE, cubes = FALSE, @@ -1178,7 +1178,7 @@ test_that("edge cases handled correctly", { expect_true(any(grepl("_x_", var_names))) # Interaction indicator }) -test_that("check_balance works with tidyselect helpers in .wts parameter", { +test_that("check_balance works with tidyselect helpers in .weights parameter", { data <- get_nhefs_test_data() # Test with starts_with() @@ -1186,7 +1186,7 @@ test_that("check_balance works with tidyselect helpers in .wts parameter", { data, c(age, wt71), qsmk, - .wts = starts_with("w_test") + .weights = starts_with("w_test") ) expect_s3_class(result1, "data.frame") @@ -1202,7 +1202,7 @@ test_that("check_balance works with tidyselect helpers in .wts parameter", { data, c(age, wt71), qsmk, - .wts = ends_with("_test1") + .weights = ends_with("_test1") ) expect_s3_class(result2, "data.frame") @@ -1213,7 +1213,7 @@ test_that("check_balance works with tidyselect helpers in .wts parameter", { data, c(age, wt71), qsmk, - .wts = contains("extreme") + .weights = contains("extreme") ) expect_s3_class(result3, "data.frame") @@ -1519,7 +1519,7 @@ test_that("check_balance works with energy metric", { data, c(age, wt71, smokeyrs), qsmk, - .wts = c(w_ate, w_att), + .weights = c(w_ate, w_att), .metrics = "energy" ) diff --git a/tests/testthat/test-check_ess.R b/tests/testthat/test-check_ess.R index 51257a1..215000c 100644 --- a/tests/testthat/test-check_ess.R +++ b/tests/testthat/test-check_ess.R @@ -9,7 +9,7 @@ test_that("check_ess works with no weights", { }) test_that("check_ess works with single weight", { - result <- check_ess(nhefs_weights, .wts = w_ate) + result <- check_ess(nhefs_weights, .weights = w_ate) expect_s3_class(result, "tbl_df") expect_equal(nrow(result), 2) @@ -19,7 +19,7 @@ test_that("check_ess works with single weight", { }) test_that("check_ess works with multiple weights", { - result <- check_ess(nhefs_weights, .wts = c(w_ate, w_att, w_atm)) + result <- check_ess(nhefs_weights, .weights = c(w_ate, w_att, w_atm)) expect_s3_class(result, "tbl_df") expect_equal(nrow(result), 4) @@ -28,14 +28,14 @@ test_that("check_ess works with multiple weights", { }) test_that("check_ess works without observed", { - result <- check_ess(nhefs_weights, .wts = w_ate, include_observed = FALSE) + result <- check_ess(nhefs_weights, .weights = w_ate, include_observed = FALSE) expect_equal(nrow(result), 1) expect_equal(result$method, "w_ate") }) test_that("check_ess works with binary groups", { - result <- check_ess(nhefs_weights, .wts = w_ate, .group = qsmk) + result <- check_ess(nhefs_weights, .weights = w_ate, .group = qsmk) expect_s3_class(result, "tbl_df") expect_true("group" %in% names(result)) @@ -44,7 +44,11 @@ test_that("check_ess works with binary groups", { }) test_that("check_ess works with categorical groups", { - result <- check_ess(nhefs_weights, .wts = w_cat_ate, .group = alcoholfreq_cat) + result <- check_ess( + nhefs_weights, + .weights = w_cat_ate, + .group = alcoholfreq_cat + ) expect_s3_class(result, "tbl_df") expect_true("group" %in% names(result)) @@ -52,7 +56,12 @@ test_that("check_ess works with categorical groups", { }) test_that("check_ess works with continuous groups", { - result <- check_ess(nhefs_weights, .wts = w_ate, .group = age, n_tiles = 4) + result <- check_ess( + nhefs_weights, + .weights = w_ate, + .group = age, + n_tiles = 4 + ) expect_s3_class(result, "tbl_df") expect_true("group" %in% names(result)) @@ -64,7 +73,7 @@ test_that("check_ess works with custom tile labels", { labels <- c("Young", "Middle", "Older") result <- check_ess( nhefs_weights, - .wts = w_ate, + .weights = w_ate, .group = age, n_tiles = 3, tile_labels = labels @@ -74,10 +83,10 @@ test_that("check_ess works with custom tile labels", { }) test_that("check_ess handles tidyselect syntax", { - result1 <- check_ess(nhefs_weights, .wts = starts_with("w_a")) + result1 <- check_ess(nhefs_weights, .weights = starts_with("w_a")) result2 <- check_ess( nhefs_weights, - .wts = c(w_ate, w_att, w_atc, w_atm, w_ato) + .weights = c(w_ate, w_att, w_atc, w_atm, w_ato) ) # Should have same number of methods (plus observed) @@ -87,7 +96,7 @@ test_that("check_ess handles tidyselect syntax", { test_that("check_ess handles psw weight objects", { # Assuming psw weights are numeric vectors with special class # The extract_weight_data function should handle conversion - result <- check_ess(nhefs_weights, .wts = w_ate) + result <- check_ess(nhefs_weights, .weights = w_ate) expect_true(is.numeric(result$ess)) expect_true(all(result$ess > 0)) @@ -107,7 +116,7 @@ test_that("check_ess validates inputs", { expect_halfmoon_error( check_ess( nhefs_weights, - .wts = w_ate, + .weights = w_ate, .group = age, n_tiles = 3, tile_labels = c("Too", "Few") @@ -123,7 +132,11 @@ test_that("ESS calculation is correct", { wts2 = c(4, 0, 0, 0) # All weight on one obs -> ESS = 1 ) - result <- check_ess(test_df, .wts = c(wts, wts2), include_observed = FALSE) + result <- check_ess( + test_df, + .weights = c(wts, wts2), + include_observed = FALSE + ) expect_equal(result$ess[result$method == "wts"], 4) expect_equal(result$ess[result$method == "wts2"], 1) @@ -136,7 +149,7 @@ test_that("check_ess handles NA values", { test_df <- nhefs_weights test_df$w_ate[1:10] <- NA - result <- check_ess(test_df, .wts = w_ate) + result <- check_ess(test_df, .weights = w_ate) # Should still compute ESS on non-NA values expect_true(all(!is.na(result$ess))) diff --git a/tests/testthat/test-check_model_auc.R b/tests/testthat/test-check_model_auc.R index fa3db7e..62049dc 100644 --- a/tests/testthat/test-check_model_auc.R +++ b/tests/testthat/test-check_model_auc.R @@ -287,7 +287,7 @@ test_that("weighted ROC/AUC integrates with check_balance patterns", { nhefs_weights, c(age, wt71), qsmk, - .wts = c(w_ate, w_att), + .weights = c(w_ate, w_att), .metrics = "smd" ) @@ -316,13 +316,13 @@ test_that("treatment_level parameter works correctly", { include_observed = TRUE ) - # Test with explicit treatment_level = "1" (same as default) + # Test with explicit focal level = "1" (same as default) roc_explicit <- check_model_roc_curve( nhefs_weights, qsmk, .fitted, include_observed = TRUE, - treatment_level = "1" + .focal_level = "1" ) # Should be identical @@ -334,7 +334,7 @@ test_that("treatment_level parameter works correctly", { qsmk, .fitted, include_observed = TRUE, - treatment_level = "0" + .focal_level = "0" ) # ROC curves should be different @@ -346,7 +346,7 @@ test_that("treatment_level parameter works correctly", { nhefs_weights, qsmk, .fitted, - treatment_level = "invalid" + .focal_level = "invalid" ) ) }) diff --git a/tests/testthat/test-compute_balance.R b/tests/testthat/test-compute_balance.R index 7f7ee25..7209f5e 100644 --- a/tests/testthat/test-compute_balance.R +++ b/tests/testthat/test-compute_balance.R @@ -45,7 +45,7 @@ test_that("bal_smd matches smd::smd estimate", { x <- rnorm(100) g <- factor(sample(c(0, 1), 100, replace = TRUE)) - out_pkg <- bal_smd(covariate = x, group = g, reference_group = 1) + out_pkg <- bal_smd(.covariate = x, .exposure = g, .reference_level = 1) out_base <- smd::smd(x, g, gref = 1)$estimate expect_equal(out_pkg, out_base) @@ -56,28 +56,28 @@ test_that("bal_smd handles different reference groups", { # Test with numeric reference groups smd_ref0 <- bal_smd( - covariate = data$x_cont, - group = data$g_balanced, - reference_group = 0 + .covariate = data$x_cont, + .exposure = data$g_balanced, + .reference_level = 0 ) smd_ref1 <- bal_smd( - covariate = data$x_cont, - group = data$g_balanced, - reference_group = 1 + .covariate = data$x_cont, + .exposure = data$g_balanced, + .reference_level = 1 ) expect_equal(smd_ref0, -smd_ref1, tolerance = 1e-10) # Test with factor reference groups smd_control <- bal_smd( - covariate = data$x_cont, - group = data$g_factor, - reference_group = "control" + .covariate = data$x_cont, + .exposure = data$g_factor, + .reference_level = "control" ) smd_treated <- bal_smd( - covariate = data$x_cont, - group = data$g_factor, - reference_group = "treated" + .covariate = data$x_cont, + .exposure = data$g_factor, + .reference_level = "treated" ) expect_equal(smd_control, -smd_treated, tolerance = 1e-10) @@ -88,13 +88,13 @@ test_that("bal_smd handles weights", { # Weighted vs unweighted should generally be different smd_unweighted <- bal_smd( - covariate = data$x_cont, - group = data$g_balanced + .covariate = data$x_cont, + .exposure = data$g_balanced ) smd_weighted <- bal_smd( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_uniform + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_uniform ) expect_false(identical(smd_unweighted, smd_weighted)) @@ -114,10 +114,14 @@ test_that("bal_smd handles missing values", { w_na <- data$w_uniform # Should return NA when na.rm = FALSE - expect_true(is.na(bal_smd(covariate = x_na, group = g_na, na.rm = FALSE))) + expect_true(is.na(bal_smd( + .covariate = x_na, + .exposure = g_na, + na.rm = FALSE + ))) # Should work when na.rm = TRUE - smd_na.rm <- bal_smd(covariate = x_na, group = g_na, na.rm = TRUE) + smd_na.rm <- bal_smd(.covariate = x_na, .exposure = g_na, na.rm = TRUE) expect_true(is.finite(smd_na.rm)) }) @@ -126,30 +130,30 @@ test_that("bal_smd error handling", { # Should error with wrong number of groups expect_halfmoon_error( - bal_smd(covariate = data$x_cont, group = rep(1, 100)), + bal_smd(.covariate = data$x_cont, .exposure = rep(1, 100)), "halfmoon_group_error" ) # Now supports 3+ groups (categorical) expect_no_error(bal_smd( - covariate = data$x_cont, - group = c(rep(1, 50), rep(2, 25), rep(3, 25)) + .covariate = data$x_cont, + .exposure = c(rep(1, 50), rep(2, 25), rep(3, 25)) )) # Should error with mismatched lengths expect_halfmoon_error( bal_smd( - covariate = data$x_cont[1:50], - group = data$g_balanced + .covariate = data$x_cont[1:50], + .exposure = data$g_balanced ), "halfmoon_length_error" ) expect_halfmoon_error( bal_smd( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_uniform[1:50] + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_uniform[1:50] ), "halfmoon_length_error" ) @@ -163,15 +167,15 @@ test_that("bal_vr handles basic cases", { data <- create_test_data() # Basic functionality - vr <- bal_vr(covariate = data$x_cont, group = data$g_balanced) + vr <- bal_vr(.covariate = data$x_cont, .exposure = data$g_balanced) expect_true(is.finite(vr)) expect_true(vr > 0) # With weights vr_weighted <- bal_vr( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_uniform + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_uniform ) expect_true(is.finite(vr_weighted)) expect_true(vr_weighted > 0) @@ -182,14 +186,14 @@ test_that("bal_vr handles reference groups", { # Different reference groups should give reciprocal results vr_ref0 <- bal_vr( - covariate = data$x_cont, - group = data$g_balanced, - reference_group = 0 + .covariate = data$x_cont, + .exposure = data$g_balanced, + .reference_level = 0 ) vr_ref1 <- bal_vr( - covariate = data$x_cont, - group = data$g_balanced, - reference_group = 1 + .covariate = data$x_cont, + .exposure = data$g_balanced, + .reference_level = 1 ) expect_equal(vr_ref0, 1 / vr_ref1, tolerance = 1e-10) @@ -200,17 +204,17 @@ test_that("bal_vr handles binary variables", { # Binary variables should use p*(1-p) variance formula vr_binary <- bal_vr( - covariate = data$x_binary, - group = data$g_balanced + .covariate = data$x_binary, + .exposure = data$g_balanced ) expect_true(is.finite(vr_binary)) expect_true(vr_binary > 0) # With weights vr_binary_weighted <- bal_vr( - covariate = data$x_binary, - group = data$g_balanced, - weights = data$w_uniform + .covariate = data$x_binary, + .exposure = data$g_balanced, + .weights = data$w_uniform ) expect_true(is.finite(vr_binary_weighted)) expect_true(vr_binary_weighted > 0) @@ -223,12 +227,12 @@ test_that("bal_vr handles edge cases", { x_zero <- c(rep(1, 50), rep(1, 50)) g <- c(rep(0, 50), rep(1, 50)) - vr_zero_both <- bal_vr(covariate = x_zero, group = g) + vr_zero_both <- bal_vr(.covariate = x_zero, .exposure = g) expect_equal(vr_zero_both, 1) # One group with zero variance x_mixed <- c(rep(1, 50), rnorm(50)) - vr_zero_one <- bal_vr(covariate = x_mixed, group = g) + vr_zero_one <- bal_vr(.covariate = x_mixed, .exposure = g) expect_true(vr_zero_one == 0 || vr_zero_one == Inf) }) @@ -242,8 +246,8 @@ test_that("bal_vr handles missing values", { # Should return NA when na.rm = FALSE expect_equal( bal_vr( - covariate = x_na, - group = data$g_balanced, + .covariate = x_na, + .exposure = data$g_balanced, na.rm = FALSE ), NA_real_ @@ -251,8 +255,8 @@ test_that("bal_vr handles missing values", { # Should work when na.rm = TRUE if enough data remains vr_na.rm <- bal_vr( - covariate = x_na, - group = data$g_balanced, + .covariate = x_na, + .exposure = data$g_balanced, na.rm = TRUE ) expect_true(is.finite(vr_na.rm) || is.na(vr_na.rm)) @@ -264,32 +268,32 @@ test_that("bal_vr error handling", { # Should error with wrong number of groups expect_halfmoon_error( bal_vr( - covariate = data$x_cont, - group = rep(1, 100) + .covariate = data$x_cont, + .exposure = rep(1, 100) ), "halfmoon_group_error" ) # Now supports 3+ groups (categorical) expect_no_error(bal_vr( - covariate = data$x_cont, - group = c(rep(1, 50), rep(2, 25), rep(3, 25)) + .covariate = data$x_cont, + .exposure = c(rep(1, 50), rep(2, 25), rep(3, 25)) )) # Should error with mismatched lengths expect_halfmoon_error( bal_vr( - covariate = data$x_cont[1:50], - group = data$g_balanced + .covariate = data$x_cont[1:50], + .exposure = data$g_balanced ), "halfmoon_length_error" ) expect_halfmoon_error( bal_vr( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_uniform[1:50] + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_uniform[1:50] ), "halfmoon_length_error" ) @@ -303,16 +307,16 @@ test_that("bal_ks handles basic cases", { data <- create_test_data() # Basic functionality - ks <- bal_ks(covariate = data$x_cont, group = data$g_balanced) + ks <- bal_ks(.covariate = data$x_cont, .exposure = data$g_balanced) expect_true(is.finite(ks)) expect_true(ks >= 0) expect_true(ks <= 1) # With weights ks_weighted <- bal_ks( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_uniform + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_uniform ) expect_true(is.finite(ks_weighted)) expect_true(ks_weighted >= 0) @@ -324,7 +328,7 @@ test_that("bal_ks gives 0 for identical distributions", { x <- c(1, 2, 3, 1, 2, 3) g <- c(0, 0, 0, 1, 1, 1) - ks_identical <- bal_ks(covariate = x, group = g) + ks_identical <- bal_ks(.covariate = x, .exposure = g) expect_equal(ks_identical, 0) }) @@ -333,7 +337,7 @@ test_that("bal_ks gives >0 for different distributions", { x <- c(1, 2, 3, 4, 5, 6) g <- c(0, 0, 0, 1, 1, 1) - ks_different <- bal_ks(covariate = x, group = g) + ks_different <- bal_ks(.covariate = x, .exposure = g) expect_true(ks_different > 0) }) @@ -341,7 +345,7 @@ test_that("bal_ks handles binary variables", { data <- create_test_data() # Binary variables should return difference in proportions - ks_binary <- bal_ks(covariate = data$x_binary, group = data$g_balanced) + ks_binary <- bal_ks(.covariate = data$x_binary, .exposure = data$g_balanced) expect_true(is.finite(ks_binary)) expect_true(ks_binary >= 0) expect_true(ks_binary <= 1) @@ -363,14 +367,14 @@ test_that("bal_ks handles missing values", { # Should return NA when na.rm = FALSE expect_equal( - bal_ks(covariate = x_na, group = data$g_balanced, na.rm = FALSE), + bal_ks(.covariate = x_na, .exposure = data$g_balanced, na.rm = FALSE), NA_real_ ) # Should work when na.rm = TRUE if enough data remains ks_na.rm <- bal_ks( - covariate = x_na, - group = data$g_balanced, + .covariate = x_na, + .exposure = data$g_balanced, na.rm = TRUE ) expect_true(is.finite(ks_na.rm) || is.na(ks_na.rm)) @@ -381,29 +385,29 @@ test_that("bal_ks error handling", { # Should error with wrong number of groups expect_halfmoon_error( - bal_ks(covariate = data$x_cont, group = rep(1, 100)), + bal_ks(.covariate = data$x_cont, .exposure = rep(1, 100)), "halfmoon_group_error" ) # Now supports 3+ groups (categorical) expect_no_error(bal_ks( - covariate = data$x_cont, - group = c(rep(1, 50), rep(2, 25), rep(3, 25)) + .covariate = data$x_cont, + .exposure = c(rep(1, 50), rep(2, 25), rep(3, 25)) )) # Should error with mismatched lengths expect_halfmoon_error( bal_ks( - covariate = data$x_cont[1:50], - group = data$g_balanced + .covariate = data$x_cont[1:50], + .exposure = data$g_balanced ), "halfmoon_length_error" ) expect_halfmoon_error( bal_ks( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_uniform[1:50] + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_uniform[1:50] ), "halfmoon_length_error" ) @@ -429,7 +433,7 @@ test_that("bal_corr handles weights correctly", { w <- c(1, 0, 0, 1) # Weighted on matching pairs (0,0) and (1,1) -> perfect correlation - cor_weighted <- bal_corr(x, y, weights = w) + cor_weighted <- bal_corr(x, y, .weights = w) expect_equal(cor_weighted, 1) }) @@ -445,7 +449,7 @@ test_that("bal_corr handles various scenarios", { cor_weighted <- bal_corr( data$x_cont, data$x_skewed, - weights = data$w_uniform + .weights = data$w_uniform ) expect_true(is.finite(cor_weighted)) expect_true(cor_weighted >= -1 && cor_weighted <= 1) @@ -513,7 +517,7 @@ test_that("bal_corr error handling", { bal_corr( data$x_cont, data$x_skewed, - weights = data$w_uniform[1:50] + .weights = data$w_uniform[1:50] ), "halfmoon_length_error" ) @@ -558,16 +562,16 @@ test_that("functions handle large datasets", { # Test all functions with large data expect_no_error({ smd_large <- bal_smd( - covariate = data_large$x_cont, - group = data_large$g_balanced + .covariate = data_large$x_cont, + .exposure = data_large$g_balanced ) vr_large <- bal_vr( - covariate = data_large$x_cont, - group = data_large$g_balanced + .covariate = data_large$x_cont, + .exposure = data_large$g_balanced ) ks_large <- bal_ks( - covariate = data_large$x_cont, - group = data_large$g_balanced + .covariate = data_large$x_cont, + .exposure = data_large$g_balanced ) cor_large <- bal_corr(data_large$x_cont, data_large$x_skewed) }) @@ -579,24 +583,24 @@ test_that("functions handle extreme weights", { # Test with extreme weights expect_no_error({ smd_extreme <- bal_smd( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_extreme + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_extreme ) vr_extreme <- bal_vr( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_extreme + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_extreme ) ks_extreme <- bal_ks( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_extreme + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_extreme ) cor_extreme <- bal_corr( data$x_cont, data$x_skewed, - weights = data$w_extreme + .weights = data$w_extreme ) }) @@ -612,12 +616,15 @@ test_that("functions handle unbalanced groups", { # Test with very unbalanced groups expect_no_error({ - smd_unbal <- bal_smd(covariate = data$x_cont, group = data$g_unbalanced) + smd_unbal <- bal_smd( + .covariate = data$x_cont, + .exposure = data$g_unbalanced + ) vr_unbal <- bal_vr( - covariate = data$x_cont, - group = data$g_unbalanced + .covariate = data$x_cont, + .exposure = data$g_unbalanced ) - ks_unbal <- bal_ks(covariate = data$x_cont, group = data$g_unbalanced) + ks_unbal <- bal_ks(.covariate = data$x_cont, .exposure = data$g_unbalanced) }) # Results should be finite @@ -637,9 +644,9 @@ test_that("bal_vr matches cobalt::col_w_vr", { # Continuous variables our_vr_cont <- bal_vr( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_uniform + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_uniform ) cobalt_vr_cont <- cobalt::col_w_vr( matrix(data$x_cont, ncol = 1), @@ -650,9 +657,9 @@ test_that("bal_vr matches cobalt::col_w_vr", { # Binary variables our_vr_bin <- bal_vr( - covariate = data$x_binary, - group = data$g_balanced, - weights = data$w_uniform + .covariate = data$x_binary, + .exposure = data$g_balanced, + .weights = data$w_uniform ) cobalt_vr_bin <- cobalt::col_w_vr( matrix(data$x_binary, ncol = 1), @@ -664,8 +671,8 @@ test_that("bal_vr matches cobalt::col_w_vr", { # Unweighted our_vr_unw <- bal_vr( - covariate = data$x_cont, - group = data$g_balanced + .covariate = data$x_cont, + .exposure = data$g_balanced ) cobalt_vr_unw <- cobalt::col_w_vr( matrix(data$x_cont, ncol = 1), @@ -681,9 +688,9 @@ test_that("bal_ks matches cobalt::col_w_ks", { # Continuous variables our_ks_cont <- bal_ks( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_uniform + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_uniform ) cobalt_ks_cont <- cobalt::col_w_ks( matrix(data$x_cont, ncol = 1), @@ -694,9 +701,9 @@ test_that("bal_ks matches cobalt::col_w_ks", { # Binary variables our_ks_bin <- bal_ks( - covariate = data$x_binary, - group = data$g_balanced, - weights = data$w_uniform + .covariate = data$x_binary, + .exposure = data$g_balanced, + .weights = data$w_uniform ) cobalt_ks_bin <- cobalt::col_w_ks( matrix(data$x_binary, ncol = 1), @@ -707,7 +714,7 @@ test_that("bal_ks matches cobalt::col_w_ks", { expect_equal(our_ks_bin, cobalt_ks_bin, tolerance = 1e-10) # Unweighted - our_ks_unw <- bal_ks(covariate = data$x_cont, group = data$g_balanced) + our_ks_unw <- bal_ks(.covariate = data$x_cont, .exposure = data$g_balanced) cobalt_ks_unw <- cobalt::col_w_ks( matrix(data$x_cont, ncol = 1), treat = data$g_balanced @@ -724,10 +731,10 @@ test_that("bal_smd matches cobalt::col_w_smd for binary variables", { # Note: cobalt uses group 1 as reference, so we specify reference_group = 1 # to match cobalt's behavior for this test our_smd_bin <- bal_smd( - covariate = data$x_binary, - group = data$g_balanced, - weights = data$w_uniform, - reference_group = 1 + .covariate = data$x_binary, + .exposure = data$g_balanced, + .weights = data$w_uniform, + .reference_level = 1 ) cobalt_smd_bin <- cobalt::col_w_smd( matrix(data$x_binary, ncol = 1), @@ -748,10 +755,10 @@ test_that("bal_smd is close to cobalt::col_w_smd for continuous variables", { # Note: cobalt uses group 1 as reference, so we specify reference_group = 1 # to match cobalt's behavior for this test our_smd_cont <- bal_smd( - covariate = data$x_cont, - group = data$g_balanced, - weights = data$w_uniform, - reference_group = 1 + .covariate = data$x_cont, + .exposure = data$g_balanced, + .weights = data$w_uniform, + .reference_level = 1 ) cobalt_smd_cont <- cobalt::col_w_smd( matrix(data$x_cont, ncol = 1), @@ -776,8 +783,8 @@ test_that("cobalt comparison with missing values", { # Both should handle missing values similarly our_vr_na <- bal_vr( - covariate = x_na, - group = data$g_balanced, + .covariate = x_na, + .exposure = data$g_balanced, na.rm = TRUE ) cobalt_vr_na <- cobalt::col_w_vr( @@ -788,8 +795,8 @@ test_that("cobalt comparison with missing values", { expect_equal(our_vr_na, cobalt_vr_na, tolerance = 1e-10) our_ks_na <- bal_ks( - covariate = x_na, - group = data$g_balanced, + .covariate = x_na, + .exposure = data$g_balanced, na.rm = TRUE ) cobalt_ks_na <- cobalt::col_w_ks( @@ -815,14 +822,14 @@ test_that("cobalt comparison with different reference groups", { # Test variance ratio with different reference groups our_vr_ref0 <- bal_vr( - covariate = data$x_cont, - group = data$g_balanced, - reference_group = 0 + .covariate = data$x_cont, + .exposure = data$g_balanced, + .reference_level = 0 ) our_vr_ref1 <- bal_vr( - covariate = data$x_cont, - group = data$g_balanced, - reference_group = 1 + .covariate = data$x_cont, + .exposure = data$g_balanced, + .reference_level = 1 ) # Cobalt always uses first group as reference @@ -883,7 +890,7 @@ test_that("bal_vr works with NHEFS data", { vr_weighted <- bal_vr( data$age, data$qsmk, - weights = data$w_uniform + .weights = data$w_uniform ) expect_true(is.finite(vr_weighted)) expect_true(vr_weighted > 0) @@ -902,12 +909,12 @@ test_that("bal_ks works with NHEFS data", { expect_true(ks_wt >= 0 && ks_wt <= 1) # Test with weights - ks_weighted <- bal_ks(data$age, data$qsmk, weights = data$w_uniform) + ks_weighted <- bal_ks(data$age, data$qsmk, .weights = data$w_uniform) expect_true(is.finite(ks_weighted)) expect_true(ks_weighted >= 0 && ks_weighted <= 1) # Test with real propensity score weights - ks_ps_weighted <- bal_ks(data$age, data$qsmk, weights = data$w_ate) + ks_ps_weighted <- bal_ks(data$age, data$qsmk, .weights = data$w_ate) expect_true(is.finite(ks_ps_weighted)) expect_true(ks_ps_weighted >= 0 && ks_ps_weighted <= 1) }) @@ -928,7 +935,7 @@ test_that("bal_corr works with NHEFS data", { cor_weighted <- bal_corr( data$age, data$wt71, - weights = data$w_uniform + .weights = data$w_uniform ) expect_true(is.finite(cor_weighted)) expect_true(cor_weighted >= -1 && cor_weighted <= 1) @@ -1007,17 +1014,17 @@ test_that("compute functions work with NHEFS extreme cases", { data <- get_nhefs_compute_data() # Test with extreme weights - smd_extreme <- bal_smd(data$age, data$qsmk, weights = data$w_extreme) + smd_extreme <- bal_smd(data$age, data$qsmk, .weights = data$w_extreme) expect_true(is.finite(smd_extreme)) vr_extreme <- bal_vr( data$age, data$qsmk, - weights = data$w_extreme + .weights = data$w_extreme ) expect_true(is.finite(vr_extreme) && vr_extreme > 0) - ks_extreme <- bal_ks(data$age, data$qsmk, weights = data$w_extreme) + ks_extreme <- bal_ks(data$age, data$qsmk, .weights = data$w_extreme) expect_true(is.finite(ks_extreme) && ks_extreme >= 0 && ks_extreme <= 1) }) @@ -1045,23 +1052,23 @@ test_that("compute functions work with real propensity score weights from nhefs_ data <- get_nhefs_compute_data() # Test all functions with ATE weights - smd_ate <- bal_smd(data$age, data$qsmk, weights = data$w_ate) + smd_ate <- bal_smd(data$age, data$qsmk, .weights = data$w_ate) expect_true(is.finite(smd_ate)) - vr_ate <- bal_vr(data$age, data$qsmk, weights = data$w_ate) + vr_ate <- bal_vr(data$age, data$qsmk, .weights = data$w_ate) expect_true(is.finite(vr_ate) && vr_ate > 0) - ks_ate <- bal_ks(data$age, data$qsmk, weights = data$w_ate) + ks_ate <- bal_ks(data$age, data$qsmk, .weights = data$w_ate) expect_true(is.finite(ks_ate) && ks_ate >= 0 && ks_ate <= 1) # Test all functions with ATT weights - smd_att <- bal_smd(data$age, data$qsmk, weights = data$w_att) + smd_att <- bal_smd(data$age, data$qsmk, .weights = data$w_att) expect_true(is.finite(smd_att)) - vr_att <- bal_vr(data$age, data$qsmk, weights = data$w_att) + vr_att <- bal_vr(data$age, data$qsmk, .weights = data$w_att) expect_true(is.finite(vr_att) && vr_att > 0) - ks_att <- bal_ks(data$age, data$qsmk, weights = data$w_att) + ks_att <- bal_ks(data$age, data$qsmk, .weights = data$w_att) expect_true(is.finite(ks_att) && ks_att >= 0 && ks_att <= 1) # ATE and ATT estimates should generally be different @@ -1078,17 +1085,17 @@ test_that("bal_energy handles basic binary treatment cases", { # Basic functionality energy <- bal_energy( - covariates = data.frame(x = data$x_cont, y = data$x_skewed), - group = data$g_balanced + .covariates = data.frame(x = data$x_cont, y = data$x_skewed), + .exposure = data$g_balanced ) expect_true(is.finite(energy)) expect_true(energy >= 0) # With weights energy_weighted <- bal_energy( - covariates = data.frame(x = data$x_cont, y = data$x_skewed), - group = data$g_balanced, - weights = data$w_uniform + .covariates = data.frame(x = data$x_cont, y = data$x_skewed), + .exposure = data$g_balanced, + .weights = data$w_uniform ) expect_true(is.finite(energy_weighted)) expect_true(energy_weighted >= 0) @@ -1100,29 +1107,29 @@ test_that("bal_energy handles different estimands", { # ATE energy_ate <- bal_energy( - covariates = covs, - group = data$g_balanced, + .covariates = covs, + .exposure = data$g_balanced, estimand = "ATE" ) # ATT energy_att <- bal_energy( - covariates = covs, - group = data$g_balanced, + .covariates = covs, + .exposure = data$g_balanced, estimand = "ATT" ) # ATC energy_atc <- bal_energy( - covariates = covs, - group = data$g_balanced, + .covariates = covs, + .exposure = data$g_balanced, estimand = "ATC" ) # Between-group only energy_between <- bal_energy( - covariates = covs, - group = data$g_balanced, + .covariates = covs, + .exposure = data$g_balanced, estimand = NULL ) @@ -1149,8 +1156,8 @@ test_that("bal_energy handles multi-category treatments", { # Should work with multi-category treatment energy_multi <- bal_energy( - covariates = covs, - group = multi_group, + .covariates = covs, + .exposure = multi_group, estimand = "ATE" ) expect_true(is.finite(energy_multi)) @@ -1168,8 +1175,8 @@ test_that("bal_energy handles continuous treatments", { # Should work with continuous treatment (uses distance correlation) energy_cont <- bal_energy( - covariates = covs, - group = continuous_treatment, + .covariates = covs, + .exposure = continuous_treatment, estimand = NULL # Must be NULL for continuous ) expect_true(is.finite(energy_cont)) @@ -1179,8 +1186,8 @@ test_that("bal_energy handles continuous treatments", { # Should error if estimand is not NULL for continuous treatment expect_halfmoon_error( bal_energy( - covariates = covs, - group = continuous_treatment, + .covariates = covs, + .exposure = continuous_treatment, estimand = "ATE" ), "halfmoon_arg_error" @@ -1196,8 +1203,8 @@ test_that("bal_energy handles perfect balance", { group <- c(rep(0, n), rep(1, n)) energy_perfect <- bal_energy( - covariates = covs, - group = group, + .covariates = covs, + .exposure = group, estimand = "ATE" ) @@ -1216,8 +1223,8 @@ test_that("bal_energy handles binary variables", { # Should identify and handle binary variables correctly energy <- bal_energy( - covariates = covs, - group = group + .covariates = covs, + .exposure = group ) expect_true(is.finite(energy)) expect_true(energy >= 0) @@ -1233,8 +1240,8 @@ test_that("bal_energy handles missing values", { # Should error when na.rm = FALSE expect_halfmoon_error( bal_energy( - covariates = covs, - group = data$g_balanced, + .covariates = covs, + .exposure = data$g_balanced, na.rm = FALSE ), "halfmoon_na_error" @@ -1242,8 +1249,8 @@ test_that("bal_energy handles missing values", { # Should work when na.rm = TRUE energy_na.rm <- bal_energy( - covariates = covs, - group = data$g_balanced, + .covariates = covs, + .exposure = data$g_balanced, na.rm = TRUE ) expect_true(is.finite(energy_na.rm) || is.na(energy_na.rm)) @@ -1255,15 +1262,15 @@ test_that("bal_energy use_improved parameter works", { # Improved vs standard for ATE energy_improved <- bal_energy( - covariates = covs, - group = data$g_balanced, + .covariates = covs, + .exposure = data$g_balanced, estimand = "ATE", use_improved = TRUE ) energy_standard <- bal_energy( - covariates = covs, - group = data$g_balanced, + .covariates = covs, + .exposure = data$g_balanced, estimand = "ATE", use_improved = FALSE ) @@ -1281,15 +1288,15 @@ test_that("bal_energy error handling", { # Should now handle non-numeric covariates by converting to dummy variables expect_no_error(bal_energy( - covariates = data.frame(x = as.character(data$x_cont)), - group = data$g_balanced + .covariates = data.frame(x = as.character(data$x_cont)), + .exposure = data$g_balanced )) # Should error with mismatched dimensions expect_halfmoon_error( bal_energy( - covariates = data.frame(x = data$x_cont[1:50]), - group = data$g_balanced + .covariates = data.frame(x = data$x_cont[1:50]), + .exposure = data$g_balanced ), "halfmoon_length_error" ) @@ -1297,8 +1304,8 @@ test_that("bal_energy error handling", { # Should error with wrong number of groups (only 1) expect_halfmoon_error( bal_energy( - covariates = data.frame(x = data$x_cont), - group = rep(1, 100) + .covariates = data.frame(x = data$x_cont), + .exposure = rep(1, 100) ), "halfmoon_group_error" ) @@ -1306,9 +1313,9 @@ test_that("bal_energy error handling", { # Should error with negative weights expect_halfmoon_error( bal_energy( - covariates = data.frame(x = data$x_cont), - group = data$g_balanced, - weights = c(-1, rep(1, 99)) + .covariates = data.frame(x = data$x_cont), + .exposure = data$g_balanced, + .weights = c(-1, rep(1, 99)) ), "halfmoon_range_error" ) @@ -1322,17 +1329,17 @@ test_that("bal_energy handles NHEFS data", { # Basic energy distance energy <- bal_energy( - covariates = covs, - group = data$qsmk + .covariates = covs, + .exposure = data$qsmk ) expect_true(is.finite(energy)) expect_true(energy >= 0) # With ATE weights energy_ate <- bal_energy( - covariates = covs, - group = data$qsmk, - weights = data$w_ate, + .covariates = covs, + .exposure = data$qsmk, + .weights = data$w_ate, estimand = "ATE" ) expect_true(is.finite(energy_ate)) @@ -1340,9 +1347,9 @@ test_that("bal_energy handles NHEFS data", { # With ATT weights energy_att <- bal_energy( - covariates = covs, - group = data$qsmk, - weights = data$w_att, + .covariates = covs, + .exposure = data$qsmk, + .weights = data$w_att, estimand = "ATT" ) expect_true(is.finite(energy_att)) @@ -1369,9 +1376,9 @@ test_that("bal_energy comparison with cobalt package", { # Our implementation - using default estimand (NULL) our_energy <- bal_energy( - covariates = covariates, - group = treatment, - weights = weights + .covariates = covariates, + .exposure = treatment, + .weights = weights ) # Cobalt implementation @@ -1401,8 +1408,8 @@ test_that("bal_energy multi-category comparison with cobalt", { # Our implementation our_energy <- bal_energy( - covariates = covariates, - group = treatment + .covariates = covariates, + .exposure = treatment ) # Cobalt implementation @@ -1431,8 +1438,8 @@ test_that("bal_energy continuous treatment comparison with cobalt", { # Our implementation (distance correlation) our_dcor <- bal_energy( - covariates = covariates, - group = treatment, + .covariates = covariates, + .exposure = treatment, estimand = NULL, standardized = TRUE ) @@ -1467,8 +1474,8 @@ test_that("bal_energy handles categorical covariates", { # Our implementation with categorical variables our_result <- bal_energy( - covariates = covariates, - group = treatment + .covariates = covariates, + .exposure = treatment ) # Cobalt with same data @@ -1485,9 +1492,9 @@ test_that("bal_energy handles categorical covariates", { weights <- runif(n, 0.5, 1.5) our_weighted <- bal_energy( - covariates = covariates, - group = treatment, - weights = weights + .covariates = covariates, + .exposure = treatment, + .weights = weights ) cobalt_weighted <- cobalt::bal.compute( @@ -1513,21 +1520,21 @@ test_that("balance functions work seamlessly with psw objects from propensity pa result_smd <- bal_smd( nhefs_weights$age, nhefs_weights$alcoholfreq_cat, - weights = nhefs_weights$w_cat_ate + .weights = nhefs_weights$w_cat_ate ) expect_true(all(is.finite(result_smd))) result_vr <- bal_vr( nhefs_weights$wt71, nhefs_weights$alcoholfreq_cat, - weights = nhefs_weights$w_cat_att_none + .weights = nhefs_weights$w_cat_att_none ) expect_true(all(is.finite(result_vr) & result_vr > 0)) result_ks <- bal_ks( nhefs_weights$age, nhefs_weights$alcoholfreq_cat, - weights = nhefs_weights$w_cat_ato + .weights = nhefs_weights$w_cat_ato ) expect_true(all(is.finite(result_ks) & result_ks >= 0 & result_ks <= 1)) @@ -1536,7 +1543,7 @@ test_that("balance functions work seamlessly with psw objects from propensity pa nhefs_weights, c(age, wt71), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = "smd", include_observed = FALSE ) diff --git a/tests/testthat/test-compute_balance_categorical.R b/tests/testthat/test-compute_balance_categorical.R index a34b173..c443210 100644 --- a/tests/testthat/test-compute_balance_categorical.R +++ b/tests/testthat/test-compute_balance_categorical.R @@ -14,7 +14,7 @@ test_that("categorical balance functions work with nhefs_weights data", { result_ref <- bal_smd( nhefs_weights$age, nhefs_weights$alcoholfreq_cat, - reference_group = "2_3_per_week" + .reference_level = "2_3_per_week" ) expect_true(all(grepl("_vs_2_3_per_week$", names(result_ref)))) expect_false(identical(result_smd, result_ref)) @@ -25,7 +25,7 @@ test_that("categorical balance functions work with nhefs_weights data", { result_weighted <- bal_smd( nhefs_with_weights$wt71, nhefs_with_weights$alcoholfreq_cat, - weights = nhefs_with_weights$w_cat_ate + .weights = nhefs_with_weights$w_cat_ate ) expect_length(result_weighted, 4) # 5 levels - 1 reference = 4 (unknown excluded) expect_true(all(!is.na(result_weighted))) @@ -63,7 +63,7 @@ test_that("check_balance integrates categorical exposure from nhefs_weights", { nhefs_weights, c(age, wt71), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = c("smd", "vr") ) @@ -79,7 +79,7 @@ test_that("check_balance integrates categorical exposure from nhefs_weights", { nhefs_complete, age, alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = "smd", include_observed = FALSE ) @@ -168,7 +168,7 @@ test_that("bal_smd works with categorical exposures", { expect_true(all(grepl("_vs_", names(result)))) # Test with explicit reference group - result_ref <- bal_smd(data$age, data$exposure, reference_group = "low") + result_ref <- bal_smd(data$age, data$exposure, .reference_level = "low") expect_true(all(grepl("_vs_low$", names(result_ref)))) expect_length(result_ref, 2) # medium_vs_low and high_vs_low @@ -176,7 +176,7 @@ test_that("bal_smd works with categorical exposures", { result_weighted <- bal_smd( data$age, data$exposure, - weights = data$weights_att + .weights = data$weights_att ) expect_length(result_weighted, 2) expect_true(all(!is.na(result_weighted))) @@ -248,7 +248,7 @@ test_that("check_balance integrates categorical exposures correctly", { data, age, exposure, - .wts = weights_att, + .weights = weights_att, .metrics = "smd" ) @@ -300,11 +300,11 @@ test_that("categorical balance handles factor exposures", { ) # Use explicit reference group to ensure consistency - result_char <- bal_smd(data$age, data$exposure, reference_group = "low") + result_char <- bal_smd(data$age, data$exposure, .reference_level = "low") result_factor <- bal_smd( data$age, data$exposure_factor, - reference_group = "low" + .reference_level = "low" ) # Results should be identical when using same reference @@ -321,9 +321,9 @@ test_that("reference group specification works correctly", { # Test different ways of specifying reference group result_default <- bal_smd(data$age, data$exposure) - result_low <- bal_smd(data$age, data$exposure, reference_group = "low") - result_medium <- bal_smd(data$age, data$exposure, reference_group = "medium") - result_high <- bal_smd(data$age, data$exposure, reference_group = "high") + result_low <- bal_smd(data$age, data$exposure, .reference_level = "low") + result_medium <- bal_smd(data$age, data$exposure, .reference_level = "medium") + result_high <- bal_smd(data$age, data$exposure, .reference_level = "high") # Each should have 2 comparisons expect_length(result_default, 2) @@ -338,7 +338,7 @@ test_that("reference group specification works correctly", { # Test numeric reference group (by position) levels_sorted <- sort(unique(data$exposure)) - result_numeric <- bal_smd(data$age, data$exposure, reference_group = 1) + result_numeric <- bal_smd(data$age, data$exposure, .reference_level = 1) expect_true(all(grepl( paste0("_vs_", levels_sorted[1], "$"), names(result_numeric) @@ -395,9 +395,9 @@ test_that("bal_smd categorical matches cobalt for 3-level exposure with binary c # Halfmoon - using binary covariate for exact match hm_result <- bal_smd( - covariate = data$employed, - group = data$exposure, - reference_group = "low" + .covariate = data$employed, + .exposure = data$exposure, + .reference_level = "low" ) # Cobalt - separate calculations matching halfmoon's internal logic @@ -449,9 +449,9 @@ test_that("bal_smd categorical with continuous covariate shows expected variance # Halfmoon - returns named vector with both comparisons hm_result <- bal_smd( - covariate = data$age, - group = data$exposure, - reference_group = "low" + .covariate = data$age, + .exposure = data$exposure, + .reference_level = "low" ) # Cobalt - separate calculations @@ -481,10 +481,10 @@ test_that("bal_smd categorical matches cobalt with weights and binary covariate" # Halfmoon with weights - using binary covariate for exact match hm_result <- bal_smd( - covariate = data$employed, - group = data$exposure, - weights = data$weights_att, - reference_group = "high" + .covariate = data$employed, + .exposure = data$exposure, + .weights = data$weights_att, + .reference_level = "high" ) # Cobalt - separate calculations @@ -535,9 +535,9 @@ test_that("bal_vr categorical matches cobalt for 3-level exposure", { # Halfmoon - returns named vector hm_result <- bal_vr( - covariate = data$age, - group = data$exposure, - reference_group = "low" + .covariate = data$age, + .exposure = data$exposure, + .reference_level = "low" ) # Cobalt - separate calculations @@ -578,9 +578,9 @@ test_that("bal_vr categorical matches cobalt with binary covariate", { # Halfmoon with binary covariate hm_result <- bal_vr( - covariate = data$employed, - group = data$exposure, - reference_group = "medium" + .covariate = data$employed, + .exposure = data$exposure, + .reference_level = "medium" ) # Cobalt - separate calculations with bin.vars = TRUE @@ -627,9 +627,9 @@ test_that("bal_ks categorical matches cobalt for 3-level exposure", { # Halfmoon - returns named vector hm_result <- bal_ks( - covariate = data$income, - group = data$exposure, - reference_group = "low" + .covariate = data$income, + .exposure = data$exposure, + .reference_level = "low" ) # Cobalt - separate calculations @@ -670,10 +670,10 @@ test_that("bal_ks categorical matches cobalt with weights and binary covariate", # Halfmoon with weights and binary covariate hm_result <- bal_ks( - covariate = data$employed, - group = data$exposure, - weights = data$weights_att, - reference_group = "high" + .covariate = data$employed, + .exposure = data$exposure, + .weights = data$weights_att, + .reference_level = "high" ) # Cobalt - separate calculations @@ -729,8 +729,8 @@ test_that("bal_energy categorical matches cobalt single overall statistic", { # Halfmoon - single overall statistic hm_result <- bal_energy( - covariates = covariates, - group = data$exposure + .covariates = covariates, + .exposure = data$exposure ) # Cobalt - also single overall statistic @@ -762,9 +762,9 @@ test_that("bal_energy categorical with weights matches cobalt", { # Halfmoon with weights hm_result <- bal_energy( - covariates = covariates, - group = data$exposure, - weights = data$weights_att + .covariates = covariates, + .exposure = data$exposure, + .weights = data$weights_att ) # Cobalt with weights @@ -791,9 +791,9 @@ test_that("categorical balance with NA values matches cobalt behavior", { # Test SMD with na.rm = TRUE hm_smd <- bal_smd( - covariate = employed_na, - group = data$exposure, - reference_group = "low", + .covariate = employed_na, + .exposure = data$exposure, + .reference_level = "low", na.rm = TRUE ) @@ -836,9 +836,9 @@ test_that("categorical balance with 4-level exposure matches cobalt pattern", { # Halfmoon - should return 3 comparisons vs reference hm_result <- bal_smd( - covariate = covariate_binary, - group = exposure_4, - reference_group = "A" + .covariate = covariate_binary, + .exposure = exposure_4, + .reference_level = "A" ) # Should have 3 comparisons: B_vs_A, C_vs_A, D_vs_A diff --git a/tests/testthat/test-compute_qq.R b/tests/testthat/test-compute_qq.R index 9d00626..ec58365 100644 --- a/tests/testthat/test-compute_qq.R +++ b/tests/testthat/test-compute_qq.R @@ -5,20 +5,20 @@ test_that("check_qq computes basic quantiles", { expect_equal(nrow(result), 99) # 99 quantiles for observed only expect_equal( colnames(result), - c("method", "quantile", "treated_quantiles", "untreated_quantiles") + c("method", "quantile", "exposed_quantiles", "unexposed_quantiles") ) expect_equal(unique(result$method), factor("observed")) }) test_that("check_qq works with weights", { - result <- check_qq(nhefs_weights, age, qsmk, .wts = w_ate) + result <- check_qq(nhefs_weights, age, qsmk, .weights = w_ate) expect_equal(nrow(result), 198) # 99 quantiles * 2 methods expect_equal(levels(result$method), c("observed", "w_ate")) }) test_that("check_qq works with multiple weights", { - result <- check_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) + result <- check_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) expect_equal(nrow(result), 297) # 99 quantiles * 3 methods expect_equal(levels(result$method), c("observed", "w_ate", "w_att")) @@ -29,7 +29,7 @@ test_that("check_qq works without observed", { nhefs_weights, age, qsmk, - .wts = w_ate, + .weights = w_ate, include_observed = FALSE ) @@ -80,14 +80,14 @@ test_that("check_qq handles NA values correctly", { # Should work with na.rm = TRUE result <- check_qq(df, age, qsmk, na.rm = TRUE) - expect_false(any(is.na(result$treated_quantiles))) - expect_false(any(is.na(result$untreated_quantiles))) + expect_false(any(is.na(result$exposed_quantiles))) + expect_false(any(is.na(result$unexposed_quantiles))) # Should have NAs with na.rm = FALSE expect_halfmoon_error(check_qq(df, age, qsmk), "halfmoon_na_error") }) -test_that("check_qq handles NULL treatment_level correctly", { +test_that("check_qq handles NULL .reference_level correctly", { # Test with factor test_factor <- data.frame( x = 1:10, @@ -96,8 +96,8 @@ test_that("check_qq handles NULL treatment_level correctly", { result_factor <- check_qq(test_factor, x, group, quantiles = 0.5) # Should use "Treatment" (last level) as reference - expect_equal(as.numeric(result_factor$treated_quantiles), 8) # median of 6:10 - expect_equal(as.numeric(result_factor$untreated_quantiles), 3) # median of 1:5 + expect_equal(as.numeric(result_factor$exposed_quantiles), 8) # median of 6:10 + expect_equal(as.numeric(result_factor$unexposed_quantiles), 3) # median of 1:5 # Test with numeric test_numeric <- data.frame( @@ -107,8 +107,8 @@ test_that("check_qq handles NULL treatment_level correctly", { result_numeric <- check_qq(test_numeric, x, group, quantiles = 0.5) # Should use 1 (max value) as reference - expect_equal(as.numeric(result_numeric$treated_quantiles), 8) # median of 6:10 - expect_equal(as.numeric(result_numeric$untreated_quantiles), 3) # median of 1:5 + expect_equal(as.numeric(result_numeric$exposed_quantiles), 8) # median of 6:10 + expect_equal(as.numeric(result_numeric$unexposed_quantiles), 3) # median of 1:5 }) test_that("check_qq returns expected quantile values", { @@ -124,20 +124,20 @@ test_that("check_qq returns expected quantile values", { # Check that we get 3 quantiles expect_equal(nrow(result), 3) - # With default NULL treatment_level, B (last level) is reference group - # So treated_quantiles are from B (higher values) and untreated_quantiles from A (lower values) - expect_true(all(result$treated_quantiles > result$untreated_quantiles)) + # With default NULL .reference_level, B (last level) is reference group + # So exposed_quantiles are from B (higher values) and unexposed_quantiles from A (lower values) + expect_true(all(result$exposed_quantiles > result$unexposed_quantiles)) - # Test with explicit treatment_level = "A" + # Test with explicit .reference_level = "A" result_explicit <- check_qq( test_data, x, group, quantiles = c(0.25, 0.5, 0.75), - treatment_level = "A" + .reference_level = "A" ) - # Now A is reference, so treated_quantiles < untreated_quantiles + # Now A is reference, so exposed_quantiles < unexposed_quantiles expect_true(all( - result_explicit$treated_quantiles < result_explicit$untreated_quantiles + result_explicit$exposed_quantiles < result_explicit$unexposed_quantiles )) }) diff --git a/tests/testthat/test-error-messages.R b/tests/testthat/test-error-messages.R index f616d1a..9fb095b 100644 --- a/tests/testthat/test-error-messages.R +++ b/tests/testthat/test-error-messages.R @@ -7,7 +7,7 @@ test_that("error messages show user-facing function names", { nhefs_weights, age, alcoholfreq_cat, - reference_group = "invalid" + .reference_level = "invalid" ) ) @@ -19,7 +19,7 @@ test_that("error messages show user-facing function names", { nhefs_weights, age, alcoholfreq_cat, - reference_group = 10 + .reference_level = 10 ) ) @@ -49,7 +49,7 @@ test_that("error messages show user-facing function names", { nhefs_weights, age, qsmk, - treatment_level = "invalid" + .reference_level = "invalid" ) ) @@ -78,7 +78,7 @@ test_that("error messages show user-facing function names", { cnd_class = TRUE, bal_prognostic_score( nhefs_weights, - treatment = qsmk, + .exposure = qsmk, formula = wt82_71 ~ age + qsmk + wt71 ) ) @@ -115,7 +115,7 @@ test_that("errors have correct custom classes", { nhefs_weights, age, alcoholfreq_cat, - reference_group = "invalid" + .reference_level = "invalid" ), class = "halfmoon_reference_error" ) @@ -126,7 +126,7 @@ test_that("errors have correct custom classes", { nhefs_weights, age, alcoholfreq_cat, - reference_group = 10 + .reference_level = 10 ), class = "halfmoon_range_error" ) @@ -151,7 +151,7 @@ test_that("errors have correct custom classes", { expect_halfmoon_error( bal_prognostic_score( nhefs_weights, - treatment = qsmk, + .exposure = qsmk, formula = wt82_71 ~ age + qsmk + wt71 ), class = "halfmoon_formula_error" diff --git a/tests/testthat/test-geom_calibration.R b/tests/testthat/test-geom_calibration.R index 0c8f7c0..69d6114 100644 --- a/tests/testthat/test-geom_calibration.R +++ b/tests/testthat/test-geom_calibration.R @@ -497,7 +497,7 @@ test_that("check_model_calibration handles all zeros and all ones", { pred, obs, method = "breaks", - treatment_level = 1 + .focal_level = 1 )) # This should give us meaningful calibration metrics expect_true(all( @@ -580,7 +580,7 @@ test_that("check_model_calibration handles factor treatment variables", { pred, obs, method = "breaks", - treatment_level = "1" + .focal_level = "1" )) expect_s3_class(result, "tbl_df") diff --git a/tests/testthat/test-geom_roc.R b/tests/testthat/test-geom_roc.R index 7d6e042..48a9fba 100644 --- a/tests/testthat/test-geom_roc.R +++ b/tests/testthat/test-geom_roc.R @@ -2,7 +2,7 @@ library(ggplot2) test_that("geom_roc and stat_roc work", { # Basic usage with factor outcome (qsmk is already a factor) - p <- ggplot(nhefs_weights, aes(estimate = .fitted, truth = qsmk)) + + p <- ggplot(nhefs_weights, aes(estimate = .fitted, exposure = qsmk)) + geom_roc() expect_s3_class(p, "gg") expect_no_error(ggplot_build(p)) @@ -11,7 +11,7 @@ test_that("geom_roc and stat_roc work", { qsmk_numeric <- as.numeric(nhefs_weights$qsmk) - 1 # Convert to 0/1 p_numeric <- ggplot( nhefs_weights, - aes(estimate = .fitted, truth = qsmk_numeric) + aes(estimate = .fitted, exposure = qsmk_numeric) ) + geom_roc() expect_s3_class(p_numeric, "gg") @@ -20,7 +20,7 @@ test_that("geom_roc and stat_roc work", { # With weights p_weighted <- ggplot( nhefs_weights, - aes(estimate = .fitted, truth = qsmk, weight = w_ate) + aes(estimate = .fitted, exposure = qsmk, weight = w_ate) ) + geom_roc() expect_s3_class(p_weighted, "gg") @@ -29,24 +29,27 @@ test_that("geom_roc and stat_roc work", { # Test stat_roc directly p_stat <- ggplot( nhefs_weights, - aes(estimate = .fitted, truth = qsmk) + aes(estimate = .fitted, exposure = qsmk) ) + stat_roc() expect_s3_class(p_stat, "gg") expect_no_error(ggplot_build(p_stat)) - # Test with treatment_level parameter - p_treatment <- ggplot(nhefs_weights, aes(estimate = .fitted, truth = qsmk)) + - geom_roc(treatment_level = "1") + # Test with .focal_level parameter + p_treatment <- ggplot( + nhefs_weights, + aes(estimate = .fitted, exposure = qsmk) + ) + + geom_roc(.focal_level = "1") expect_s3_class(p_treatment, "gg") expect_no_error(ggplot_build(p_treatment)) - # Test stat_roc with treatment_level + # Test stat_roc with .focal_level p_stat_treatment <- ggplot( nhefs_weights, - aes(estimate = .fitted, truth = qsmk) + aes(estimate = .fitted, exposure = qsmk) ) + - stat_roc(treatment_level = "0") + stat_roc(.focal_level = "0") expect_s3_class(p_stat_treatment, "gg") expect_no_error(ggplot_build(p_stat_treatment)) }) @@ -59,7 +62,7 @@ test_that("geom_roc visual regression", { "geom-roc-basic", ggplot( nhefs_weights, - aes(estimate = .fitted, truth = qsmk) + aes(estimate = .fitted, exposure = qsmk) ) + geom_roc() ) @@ -69,7 +72,7 @@ test_that("geom_roc visual regression", { "geom-roc-weighted", ggplot( nhefs_weights, - aes(estimate = .fitted, truth = as.numeric(qsmk), weight = w_ate) + aes(estimate = .fitted, exposure = as.numeric(qsmk), weight = w_ate) ) + geom_roc(linewidth = 1.5, color = "blue") ) @@ -93,7 +96,7 @@ test_that("geom_roc visual regression", { long_data, aes( estimate = .fitted, - truth = qsmk, + exposure = qsmk, weight = weight, color = weight_type ) @@ -102,25 +105,25 @@ test_that("geom_roc visual regression", { labs(color = "Weight Type") ) - # Test with treatment_level parameter + # Test with .focal_level parameter expect_doppelganger( "geom-roc-treatment-level-1", ggplot( nhefs_weights, - aes(estimate = .fitted, truth = qsmk) + aes(estimate = .fitted, exposure = qsmk) ) + - geom_roc(treatment_level = "1", color = "red") + - labs(title = "ROC with treatment_level = '1'") + geom_roc(.focal_level = "1", color = "red") + + labs(title = "ROC with .focal_level = '1'") ) expect_doppelganger( "geom-roc-treatment-level-0", ggplot( nhefs_weights, - aes(estimate = .fitted, truth = qsmk) + aes(estimate = .fitted, exposure = qsmk) ) + - geom_roc(treatment_level = "0", color = "blue") + - labs(title = "ROC with treatment_level = '0'") + geom_roc(.focal_level = "0", color = "blue") + + labs(title = "ROC with .focal_level = '0'") ) }) @@ -128,7 +131,7 @@ test_that("geom_roc works with both numeric and factor outcomes - visual", { skip_on_ci() # Test with factor outcome (qsmk is already a factor) - p_factor <- ggplot(nhefs_weights, aes(estimate = .fitted, truth = qsmk)) + + p_factor <- ggplot(nhefs_weights, aes(estimate = .fitted, exposure = qsmk)) + geom_roc() + labs(title = "ROC with factor outcome") @@ -136,7 +139,7 @@ test_that("geom_roc works with both numeric and factor outcomes - visual", { qsmk_numeric <- as.numeric(nhefs_weights$qsmk) - 1 # Convert to 0/1 p_numeric <- ggplot( nhefs_weights, - aes(estimate = .fitted, truth = qsmk_numeric) + aes(estimate = .fitted, exposure = qsmk_numeric) ) + geom_roc() + labs(title = "ROC with numeric outcome") diff --git a/tests/testthat/test-numeric-psw-equivalence.R b/tests/testthat/test-numeric-psw-equivalence.R index c736e9f..22e2fa4 100644 --- a/tests/testthat/test-numeric-psw-equivalence.R +++ b/tests/testthat/test-numeric-psw-equivalence.R @@ -9,24 +9,24 @@ test_that("backward compatibility: all functions work with numeric weights", { numeric_weights <- runif(n, 0.5, 2.0) # Test all balance functions with numeric weights - expect_no_error(smd_result <- bal_smd(x, g, weights = numeric_weights)) + expect_no_error(smd_result <- bal_smd(x, g, .weights = numeric_weights)) expect_true(is.finite(smd_result)) - expect_no_error(vr_result <- bal_vr(x, g, weights = numeric_weights)) + expect_no_error(vr_result <- bal_vr(x, g, .weights = numeric_weights)) expect_true(is.finite(vr_result) && vr_result > 0) - expect_no_error(ks_result <- bal_ks(x, g, weights = numeric_weights)) + expect_no_error(ks_result <- bal_ks(x, g, .weights = numeric_weights)) expect_true(is.finite(ks_result) && ks_result >= 0 && ks_result <= 1) # Test correlation with numeric weights y <- 2 * x + rnorm(n, sd = 0.5) - expect_no_error(corr_result <- bal_corr(x, y, weights = numeric_weights)) + expect_no_error(corr_result <- bal_corr(x, y, .weights = numeric_weights)) expect_true(is.finite(corr_result) && corr_result >= -1 && corr_result <= 1) # Test energy balance with numeric weights covariates <- data.frame(x1 = x, x2 = rnorm(n)) expect_no_error( - energy_result <- bal_energy(covariates, g, weights = numeric_weights) + energy_result <- bal_energy(covariates, g, .weights = numeric_weights) ) expect_true(is.finite(energy_result) && energy_result >= 0) @@ -42,7 +42,7 @@ test_that("backward compatibility: all functions work with numeric weights", { test_data, c(x, y), g, - .wts = w, + .weights = w, .metrics = "smd" ) ) @@ -68,30 +68,30 @@ test_that("numeric and psw weights produce identical results", { psw_ato <- propensity::psw(numeric_weights, estimand = "ato") # Test bal_smd equivalence - smd_numeric <- bal_smd(x, g, weights = numeric_weights) - smd_psw_ate <- bal_smd(x, g, weights = psw_ate) - smd_psw_att <- bal_smd(x, g, weights = psw_att) - smd_psw_ato <- bal_smd(x, g, weights = psw_ato) + smd_numeric <- bal_smd(x, g, .weights = numeric_weights) + smd_psw_ate <- bal_smd(x, g, .weights = psw_ate) + smd_psw_att <- bal_smd(x, g, .weights = psw_att) + smd_psw_ato <- bal_smd(x, g, .weights = psw_ato) expect_identical(smd_numeric, smd_psw_ate) expect_identical(smd_numeric, smd_psw_att) expect_identical(smd_numeric, smd_psw_ato) # Test bal_vr equivalence - vr_numeric <- bal_vr(x, g, weights = numeric_weights) - vr_psw_ate <- bal_vr(x, g, weights = psw_ate) - vr_psw_att <- bal_vr(x, g, weights = psw_att) - vr_psw_ato <- bal_vr(x, g, weights = psw_ato) + vr_numeric <- bal_vr(x, g, .weights = numeric_weights) + vr_psw_ate <- bal_vr(x, g, .weights = psw_ate) + vr_psw_att <- bal_vr(x, g, .weights = psw_att) + vr_psw_ato <- bal_vr(x, g, .weights = psw_ato) expect_identical(vr_numeric, vr_psw_ate) expect_identical(vr_numeric, vr_psw_att) expect_identical(vr_numeric, vr_psw_ato) # Test bal_ks equivalence - ks_numeric <- bal_ks(x, g, weights = numeric_weights) - ks_psw_ate <- bal_ks(x, g, weights = psw_ate) - ks_psw_att <- bal_ks(x, g, weights = psw_att) - ks_psw_ato <- bal_ks(x, g, weights = psw_ato) + ks_numeric <- bal_ks(x, g, .weights = numeric_weights) + ks_psw_ate <- bal_ks(x, g, .weights = psw_ate) + ks_psw_att <- bal_ks(x, g, .weights = psw_att) + ks_psw_ato <- bal_ks(x, g, .weights = psw_ato) expect_identical(ks_numeric, ks_psw_ate) expect_identical(ks_numeric, ks_psw_att) @@ -114,8 +114,8 @@ test_that("numeric and psw weights produce identical results for correlation", { psw_weights <- propensity::psw(numeric_weights, estimand = "ate") # Test bal_corr equivalence - corr_numeric <- bal_corr(x, y, weights = numeric_weights) - corr_psw <- bal_corr(x, y, weights = psw_weights) + corr_numeric <- bal_corr(x, y, .weights = numeric_weights) + corr_psw <- bal_corr(x, y, .weights = psw_weights) expect_identical(corr_numeric, corr_psw) }) @@ -139,8 +139,8 @@ test_that("numeric and psw weights produce identical results for energy balance" psw_weights <- propensity::psw(numeric_weights, estimand = "ate") # Test bal_energy equivalence - energy_numeric <- bal_energy(covariates, g, weights = numeric_weights) - energy_psw <- bal_energy(covariates, g, weights = psw_weights) + energy_numeric <- bal_energy(covariates, g, .weights = numeric_weights) + energy_psw <- bal_energy(covariates, g, .weights = psw_weights) expect_identical(energy_numeric, energy_psw) }) @@ -171,7 +171,7 @@ test_that("check_balance works equivalently with numeric and psw weights", { test_data, c(age, wt71), qsmk, - .wts = w_ate_numeric, + .weights = w_ate_numeric, .metrics = "smd", include_observed = FALSE ) @@ -180,7 +180,7 @@ test_that("check_balance works equivalently with numeric and psw weights", { test_data, c(age, wt71), qsmk, - .wts = w_ate_psw, + .weights = w_ate_psw, .metrics = "smd", include_observed = FALSE ) @@ -206,7 +206,7 @@ test_that("mixed numeric and psw weights work in same function call", { test_data, c(age, wt71), qsmk, - .wts = c(w_ate_numeric, w_att), # Mix numeric and psw + .weights = c(w_ate_numeric, w_att), # Mix numeric and psw .metrics = "smd", include_observed = FALSE ) @@ -232,8 +232,8 @@ test_that("edge cases work identically for numeric and psw weights", { extreme_psw <- propensity::psw(extreme_numeric, estimand = "ate") # Both should handle extreme weights the same way - smd_numeric <- bal_smd(x, g, weights = extreme_numeric) - smd_psw <- bal_smd(x, g, weights = extreme_psw) + smd_numeric <- bal_smd(x, g, .weights = extreme_numeric) + smd_psw <- bal_smd(x, g, .weights = extreme_psw) expect_identical(smd_numeric, smd_psw) # Test with uniform weights (should be close to unweighted) @@ -241,8 +241,8 @@ test_that("edge cases work identically for numeric and psw weights", { uniform_psw <- propensity::psw(uniform_numeric, estimand = "ate") smd_unweighted <- bal_smd(x, g) - smd_uniform_numeric <- bal_smd(x, g, weights = uniform_numeric) - smd_uniform_psw <- bal_smd(x, g, weights = uniform_psw) + smd_uniform_numeric <- bal_smd(x, g, .weights = uniform_numeric) + smd_uniform_psw <- bal_smd(x, g, .weights = uniform_psw) expect_identical(smd_uniform_numeric, smd_uniform_psw) expect_equal(smd_unweighted, smd_uniform_numeric, tolerance = 1e-10) @@ -263,15 +263,15 @@ test_that("NA handling is identical for numeric and psw weights", { psw_weights <- propensity::psw(numeric_weights, estimand = "ate") # Test na.rm = FALSE (should return NA) - smd_numeric_na <- bal_smd(x, g, weights = numeric_weights, na.rm = FALSE) - smd_psw_na <- bal_smd(x, g, weights = psw_weights, na.rm = FALSE) + smd_numeric_na <- bal_smd(x, g, .weights = numeric_weights, na.rm = FALSE) + smd_psw_na <- bal_smd(x, g, .weights = psw_weights, na.rm = FALSE) expect_identical(smd_numeric_na, smd_psw_na) expect_true(is.na(smd_numeric_na)) # Test na.rm = TRUE - smd_numeric_narm <- bal_smd(x, g, weights = numeric_weights, na.rm = TRUE) - smd_psw_narm <- bal_smd(x, g, weights = psw_weights, na.rm = TRUE) + smd_numeric_narm <- bal_smd(x, g, .weights = numeric_weights, na.rm = TRUE) + smd_psw_narm <- bal_smd(x, g, .weights = psw_weights, na.rm = TRUE) expect_identical(smd_numeric_narm, smd_psw_narm) expect_true(is.finite(smd_numeric_narm)) diff --git a/tests/testthat/test-plot_balance.R b/tests/testthat/test-plot_balance.R index 813672d..7390394 100644 --- a/tests/testthat/test-plot_balance.R +++ b/tests/testthat/test-plot_balance.R @@ -3,7 +3,7 @@ test_that("plot_balance creates valid ggplot object", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = "smd" ) @@ -16,7 +16,7 @@ test_that("plot_balance handles multiple metrics with faceting", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = c("smd", "vr", "ks") ) @@ -32,7 +32,7 @@ test_that("plot_balance handles energy metric with NA variable", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = "energy" ) @@ -51,7 +51,7 @@ test_that("plot_balance applies absolute value to SMD when abs_smd = TRUE", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = "smd" ) @@ -76,7 +76,7 @@ test_that("plot_balance adds caption when abs_smd = TRUE", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = "smd" ) @@ -92,7 +92,7 @@ test_that("plot_balance handles different facet scales", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = c("smd", "vr") ) @@ -114,7 +114,7 @@ test_that("plot_balance adjusts x-axis for variance ratio", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = "vr" ) @@ -145,7 +145,7 @@ test_that("plot_balance passes geom_love parameters correctly", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = "smd" ) @@ -168,7 +168,7 @@ test_that("plot_balance handles multiple weighting methods", { nhefs_weights, c(age, education), qsmk, - .wts = c(w_ate, w_att), + .weights = c(w_ate, w_att), .metrics = "smd" ) @@ -186,7 +186,7 @@ test_that("plot_balance handles categorical exposures with facet_grid", { nhefs_weights, c(age, wt71), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = c("smd", "vr") ) @@ -209,7 +209,7 @@ test_that("plot_balance handles categorical exposures with single metric", { nhefs_weights, c(age, wt71), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = "smd" ) @@ -226,7 +226,7 @@ test_that("plot_balance correctly identifies categorical vs binary exposures", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = c("smd", "vr") ) @@ -256,7 +256,7 @@ test_that("plot_balance visual tests", { nhefs_weights, c(age, education, race), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = "smd" ) @@ -270,7 +270,7 @@ test_that("plot_balance visual tests", { nhefs_weights, c(age, education, race), qsmk, - .wts = c(w_ate, w_att), + .weights = c(w_ate, w_att), .metrics = c("smd", "vr", "ks") ) @@ -284,7 +284,7 @@ test_that("plot_balance visual tests", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = c("smd", "energy") ) @@ -310,7 +310,7 @@ test_that("plot_balance visual tests", { nhefs_weights, c(age, education), qsmk, - .wts = w_ate, + .weights = w_ate, .metrics = "vr" ) @@ -337,7 +337,7 @@ test_that("plot_balance visual tests", { nhefs_weights, c(age, wt71, sex), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = c("smd", "vr", "ks") ) @@ -351,7 +351,7 @@ test_that("plot_balance visual tests", { nhefs_weights, c(age, wt71, sex), alcoholfreq_cat, - .wts = c(w_cat_ate, w_cat_att_2_3wk), + .weights = c(w_cat_ate, w_cat_att_2_3wk), .metrics = "smd" ) @@ -381,8 +381,8 @@ test_that("plot_balance visual tests - more categorical scenarios", { nhefs_weights, c(age, wt71, education), alcoholfreq_cat, - reference_group = "daily", - .wts = w_cat_ate, + .reference_level = "daily", + .weights = w_cat_ate, .metrics = c("smd", "vr") ) @@ -396,7 +396,7 @@ test_that("plot_balance visual tests - more categorical scenarios", { nhefs_weights, c(age, wt71), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = c("smd", "energy") ) @@ -414,7 +414,7 @@ test_that("plot_balance visual tests - more categorical scenarios", { nhefs_weights, c(age, wt71, sex), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = c("smd", "vr", "ks") ) @@ -428,7 +428,7 @@ test_that("plot_balance visual tests - more categorical scenarios", { nhefs_weights, c(age, wt71, sex), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = c("smd", "vr", "ks") ) @@ -442,7 +442,7 @@ test_that("plot_balance visual tests - more categorical scenarios", { nhefs_weights, c(age, wt71), alcoholfreq_cat, - .wts = c(w_cat_att_none, w_cat_att_2_3wk, w_cat_att_daily), + .weights = c(w_cat_att_none, w_cat_att_2_3wk, w_cat_att_daily), .metrics = "smd" ) @@ -456,7 +456,7 @@ test_that("plot_balance visual tests - more categorical scenarios", { nhefs_weights, c(age, wt71, smokeintensity), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = "ks" ) @@ -470,7 +470,7 @@ test_that("plot_balance visual tests - more categorical scenarios", { nhefs_weights, c(age, wt71), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = "smd" ) @@ -498,7 +498,7 @@ test_that("plot_balance visual tests - more categorical scenarios", { active ), alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, .metrics = c("smd", "vr") ) @@ -512,7 +512,7 @@ test_that("plot_balance visual tests - more categorical scenarios", { nhefs_weights, c(age, wt71), alcoholfreq_cat, - .wts = c(w_cat_ate, w_cat_ato, w_cat_atm), + .weights = c(w_cat_ate, w_cat_ato, w_cat_atm), .metrics = c("smd", "vr") ) diff --git a/tests/testthat/test-plot_ess.R b/tests/testthat/test-plot_ess.R index dc19473..af98ee2 100644 --- a/tests/testthat/test-plot_ess.R +++ b/tests/testthat/test-plot_ess.R @@ -1,12 +1,12 @@ test_that("plot_ess creates a ggplot object", { - p <- plot_ess(nhefs_weights, .wts = w_ate) + p <- plot_ess(nhefs_weights, .weights = w_ate) expect_s3_class(p, "ggplot") expect_s3_class(p, "gg") }) test_that("plot_ess works with raw data", { - p <- plot_ess(nhefs_weights, .wts = c(w_ate, w_att)) + p <- plot_ess(nhefs_weights, .weights = c(w_ate, w_att)) expect_s3_class(p, "ggplot") # Check that data was computed @@ -14,7 +14,7 @@ test_that("plot_ess works with raw data", { }) test_that("plot_ess works with pre-computed ESS data", { - ess_data <- check_ess(nhefs_weights, .wts = c(w_ate, w_att)) + ess_data <- check_ess(nhefs_weights, .weights = c(w_ate, w_att)) p <- plot_ess(ess_data) expect_s3_class(p, "ggplot") @@ -22,7 +22,7 @@ test_that("plot_ess works with pre-computed ESS data", { }) test_that("plot_ess works without groups", { - p <- plot_ess(nhefs_weights, .wts = c(w_ate, w_att)) + p <- plot_ess(nhefs_weights, .weights = c(w_ate, w_att)) # Should have single fill color (no group aesthetic) expect_true(!"fill" %in% names(p$mapping)) @@ -32,7 +32,7 @@ test_that("plot_ess works without groups", { }) test_that("plot_ess works with groups", { - p <- plot_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk) + p <- plot_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk) # Should have fill aesthetic for groups expect_true("fill" %in% names(p$mapping)) @@ -46,7 +46,7 @@ test_that("plot_ess works with groups", { }) test_that("plot_ess includes reference line", { - p <- plot_ess(nhefs_weights, .wts = w_ate) + p <- plot_ess(nhefs_weights, .weights = w_ate) # Check for horizontal line at 100 hline_layer <- sapply(p$layers, function(l) inherits(l$geom, "GeomHline")) @@ -58,8 +58,12 @@ test_that("plot_ess includes reference line", { }) test_that("plot_ess labels work correctly", { - p_with_labels <- plot_ess(nhefs_weights, .wts = w_ate, show_labels = TRUE) - p_without_labels <- plot_ess(nhefs_weights, .wts = w_ate, show_labels = FALSE) + p_with_labels <- plot_ess(nhefs_weights, .weights = w_ate, show_labels = TRUE) + p_without_labels <- plot_ess( + nhefs_weights, + .weights = w_ate, + show_labels = FALSE + ) # Check for text layer text_layer_with <- sapply( @@ -76,7 +80,7 @@ test_that("plot_ess labels work correctly", { }) test_that("plot_ess y-axis uses percent scale", { - p <- plot_ess(nhefs_weights, .wts = w_ate) + p <- plot_ess(nhefs_weights, .weights = w_ate) # Check that y-axis has percent labels y_scale <- p$scales$get_scales("y") @@ -84,7 +88,7 @@ test_that("plot_ess y-axis uses percent scale", { }) test_that("plot_ess handles continuous groups", { - p <- plot_ess(nhefs_weights, .wts = w_ate, .group = age, n_tiles = 4) + p <- plot_ess(nhefs_weights, .weights = w_ate, .group = age, n_tiles = 4) expect_s3_class(p, "ggplot") expect_true("fill" %in% names(p$mapping)) @@ -93,7 +97,7 @@ test_that("plot_ess handles continuous groups", { test_that("plot_ess customization works", { p <- plot_ess( nhefs_weights, - .wts = w_ate, + .weights = w_ate, fill_color = "red", alpha = 0.5, reference_line_color = "blue", @@ -120,7 +124,7 @@ test_that("plot_ess customization works", { }) test_that("plot_ess has correct labels", { - p <- plot_ess(nhefs_weights, .wts = w_ate) + p <- plot_ess(nhefs_weights, .weights = w_ate) expect_equal(p$labels$x, "method") expect_equal(p$labels$y, "effective sample size (%)") @@ -132,7 +136,7 @@ test_that("plot_ess y-limits are appropriate", { wts = c(10, 0.1, 0.1, 0.1) # Very unequal weights ) - p <- plot_ess(test_df, .wts = wts, include_observed = FALSE) + p <- plot_ess(test_df, .weights = wts, include_observed = FALSE) # Y-axis should start at 0 and go above the max value y_scale <- p$scales$get_scales("y") @@ -144,24 +148,24 @@ test_that("plot_ess snapshot tests", { # Basic plot expect_doppelganger( "plot_ess_basic", - plot_ess(nhefs_weights, .wts = c(w_ate, w_att)) + plot_ess(nhefs_weights, .weights = c(w_ate, w_att)) ) # Plot with groups expect_doppelganger( "plot_ess_groups", - plot_ess(nhefs_weights, .wts = c(w_ate, w_att), .group = qsmk) + plot_ess(nhefs_weights, .weights = c(w_ate, w_att), .group = qsmk) ) # Plot without labels expect_doppelganger( "plot_ess_no_labels", - plot_ess(nhefs_weights, .wts = c(w_ate, w_att), show_labels = FALSE) + plot_ess(nhefs_weights, .weights = c(w_ate, w_att), show_labels = FALSE) ) # Plot with continuous groups expect_doppelganger( "plot_ess_continuous", - plot_ess(nhefs_weights, .wts = w_ate, .group = age, n_tiles = 3) + plot_ess(nhefs_weights, .weights = w_ate, .group = age, n_tiles = 3) ) }) diff --git a/tests/testthat/test-plot_mirror_distributions.R b/tests/testthat/test-plot_mirror_distributions.R index 3507fe5..3d82170 100644 --- a/tests/testthat/test-plot_mirror_distributions.R +++ b/tests/testthat/test-plot_mirror_distributions.R @@ -32,7 +32,7 @@ test_that("plot_mirror_distributions works with weights", { nhefs_weights, age, qsmk, - .wts = w_ate, + .weights = w_ate, bins = 20 ) @@ -44,7 +44,7 @@ test_that("plot_mirror_distributions works with weights", { nhefs_weights, age, qsmk, - .wts = w_ate, + .weights = w_ate, type = "density" ) @@ -57,7 +57,7 @@ test_that("plot_mirror_distributions works with multiple weights", { nhefs_weights, age, qsmk, - .wts = c(w_ate, w_att), + .weights = c(w_ate, w_att), bins = 20 ) @@ -71,7 +71,7 @@ test_that("plot_mirror_distributions works without unweighted", { nhefs_weights, age, qsmk, - .wts = w_ate, + .weights = w_ate, include_unweighted = FALSE, bins = 20 ) @@ -234,7 +234,7 @@ test_that("plot_mirror_distributions works with faceting", { nhefs_weights, age, qsmk, - .wts = c(w_ate, w_att) + .weights = c(w_ate, w_att) ) built <- ggplot_build(p_facet) @@ -271,7 +271,7 @@ test_that("plot_mirror_distributions works with categorical exposures", { nhefs_weights, age, alcoholfreq_cat, - reference_group = "daily", + .reference_level = "daily", type = "density" ) @@ -284,8 +284,8 @@ test_that("plot_mirror_distributions works with categorical exposures and weight nhefs_weights, wt71, alcoholfreq_cat, - .wts = w_cat_ate, - reference_group = "none", + .weights = w_cat_ate, + .reference_level = "none", bins = 20 ) @@ -297,8 +297,8 @@ test_that("plot_mirror_distributions works with categorical exposures and weight nhefs_weights, age, alcoholfreq_cat, - .wts = c(w_cat_ate, w_cat_att_2_3wk), - reference_group = "none", + .weights = c(w_cat_ate, w_cat_att_2_3wk), + .reference_level = "none", type = "density" ) @@ -309,7 +309,7 @@ test_that("plot_mirror_distributions works with categorical exposures and weight nhefs_weights, age, alcoholfreq_cat, - .wts = w_cat_ate, + .weights = w_cat_ate, include_unweighted = FALSE, type = "density" ) @@ -324,7 +324,7 @@ test_that("plot_mirror_distributions validates categorical reference group", { nhefs_weights, age, alcoholfreq_cat, - reference_group = "invalid" + .reference_level = "invalid" ), "halfmoon_reference_error" ) @@ -335,7 +335,7 @@ test_that("plot_mirror_distributions validates categorical reference group", { nhefs_weights, age, alcoholfreq_cat, - reference_group = 10 + .reference_level = 10 ), "halfmoon_range_error" ) diff --git a/tests/testthat/test-plot_qq.R b/tests/testthat/test-plot_qq.R index 91cd351..7523dd7 100644 --- a/tests/testthat/test-plot_qq.R +++ b/tests/testthat/test-plot_qq.R @@ -9,7 +9,7 @@ test_that("plot_qq creates basic QQ plot", { }) test_that("plot_qq works with weights", { - p <- plot_qq(nhefs_weights, age, qsmk, .wts = w_ate) + p <- plot_qq(nhefs_weights, age, qsmk, .weights = w_ate) expect_s3_class(p, "ggplot") # Should have 3 layers: points + abline + scale_color_discrete @@ -21,7 +21,7 @@ test_that("plot_qq works with weights", { }) test_that("plot_qq works with multiple weights", { - p <- plot_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) + p <- plot_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) expect_s3_class(p, "ggplot") @@ -31,7 +31,13 @@ test_that("plot_qq works with multiple weights", { }) test_that("plot_qq works without observed", { - p <- plot_qq(nhefs_weights, age, qsmk, .wts = w_ate, include_observed = FALSE) + p <- plot_qq( + nhefs_weights, + age, + qsmk, + .weights = w_ate, + include_observed = FALSE + ) expect_s3_class(p, "ggplot") @@ -88,7 +94,7 @@ test_that("weighted_quantile works correctly", { weights <- rep(1, 10) quantiles <- c(0.25, 0.5, 0.75) - result <- weighted_quantile(values, quantiles, .wts = weights) + result <- weighted_quantile(values, quantiles, .weights = weights) # With equal weights, should be close to regular quantiles # but not exactly equal due to interpolation method expected <- stats::quantile(values, quantiles) @@ -96,7 +102,7 @@ test_that("weighted_quantile works correctly", { # Test with non-uniform weights weights <- c(rep(1, 5), rep(2, 5)) - result <- weighted_quantile(values, quantiles, .wts = weights) + result <- weighted_quantile(values, quantiles, .weights = weights) # Should be weighted towards higher values expect_true(all(result > c(2.5, 5, 7.5))) @@ -125,24 +131,30 @@ test_that("plot_qq visual regression tests", { # With single weight expect_doppelganger( "qq plot with weight", - plot_qq(nhefs_weights, age, qsmk, .wts = w_ate) + plot_qq(nhefs_weights, age, qsmk, .weights = w_ate) ) # With multiple weights expect_doppelganger( "qq plot multiple weights", - plot_qq(nhefs_weights, age, qsmk, .wts = c(w_ate, w_att)) + plot_qq(nhefs_weights, age, qsmk, .weights = c(w_ate, w_att)) ) # Without observed expect_doppelganger( "qq plot no observed", - plot_qq(nhefs_weights, age, qsmk, .wts = w_ate, include_observed = FALSE) + plot_qq( + nhefs_weights, + age, + qsmk, + .weights = w_ate, + include_observed = FALSE + ) ) # With propensity score expect_doppelganger( "qq plot propensity score", - plot_qq(nhefs_weights, .fitted, qsmk, .wts = w_ate) + plot_qq(nhefs_weights, .fitted, qsmk, .weights = w_ate) ) }) diff --git a/tests/testthat/test-plot_roc.R b/tests/testthat/test-plot_roc.R index c4da25a..5afa0e5 100644 --- a/tests/testthat/test-plot_roc.R +++ b/tests/testthat/test-plot_roc.R @@ -127,7 +127,7 @@ test_that("StatRoc handles edge cases", { ) # The error happens during build, not creation - p_bad <- ggplot(bad_data, aes(estimate = x, truth = y)) + stat_roc() + p_bad <- ggplot(bad_data, aes(estimate = x, exposure = y)) + stat_roc() expect_error( ggplot_build(p_bad), class = "halfmoon_group_error" diff --git a/tests/testthat/test-plot_stratified_residuals.R b/tests/testthat/test-plot_stratified_residuals.R index 537f3d8..0b830a0 100644 --- a/tests/testthat/test-plot_stratified_residuals.R +++ b/tests/testthat/test-plot_stratified_residuals.R @@ -11,21 +11,21 @@ test_that("plot_stratified_residuals.lm works with model input", { # Basic plot should work p <- plot_stratified_residuals( model, - treatment = treatment + .exposure = treatment ) expect_s3_class(p, "gg") # Different plot types p_facet <- plot_stratified_residuals( model, - treatment = treatment, + .exposure = treatment, plot_type = "facet" ) expect_s3_class(p_facet, "gg") p_both <- plot_stratified_residuals( model, - treatment = treatment, + .exposure = treatment, plot_type = "both" ) expect_s3_class(p_both, "gg") @@ -34,7 +34,7 @@ test_that("plot_stratified_residuals.lm works with model input", { ps_model <- glm(treatment ~ x, family = binomial) p_ps <- plot_stratified_residuals( model, - treatment = treatment, + .exposure = treatment, ps_model = ps_model ) expect_s3_class(p_ps, "gg") @@ -62,7 +62,7 @@ test_that("plot_stratified_residuals.data.frame works", { # Test with fitted values p <- plot_stratified_residuals( plot_data, - treatment = trt, + .exposure = trt, residuals = resids, x_var = fitted_vals ) @@ -71,7 +71,7 @@ test_that("plot_stratified_residuals.data.frame works", { # Test with propensity scores p_ps <- plot_stratified_residuals( plot_data, - treatment = trt, + .exposure = trt, residuals = resids, x_var = ps ) @@ -81,7 +81,7 @@ test_that("plot_stratified_residuals.data.frame works", { # Test with string column names p_string <- plot_stratified_residuals( plot_data, - treatment = "trt", + .exposure = "trt", residuals = "resids", x_var = "ps" ) @@ -102,7 +102,7 @@ test_that("plot_stratified_residuals validates inputs correctly", { expect_halfmoon_error( plot_stratified_residuals( model, - treatment = rep(0:1, 16), + .exposure = rep(0:1, 16), ps_model = "not a model" ), "halfmoon_type_error" @@ -124,7 +124,7 @@ test_that("plot_stratified_residuals validates inputs correctly", { expect_halfmoon_error( plot_stratified_residuals( df, - treatment = trt, + .exposure = trt, residuals = resids ), "halfmoon_arg_error" @@ -134,7 +134,7 @@ test_that("plot_stratified_residuals validates inputs correctly", { expect_halfmoon_error( plot_stratified_residuals( df, - treatment = trt, + .exposure = trt, residuals = resids, x_var = not_a_column ), @@ -147,7 +147,7 @@ test_that("plot_stratified_residuals validates inputs correctly", { expect_halfmoon_error( plot_stratified_residuals( df_wrong, - treatment = trt, + .exposure = trt, residuals = resids, x_var = x ), @@ -170,7 +170,7 @@ test_that("plot_stratified_residuals handles NA values correctly", { # Should work with na.rm = TRUE p <- plot_stratified_residuals( model, - treatment = treatment, + .exposure = treatment, na.rm = TRUE ) expect_s3_class(p, "gg") @@ -188,7 +188,7 @@ test_that("plot_stratified_residuals customization options work", { # Test smooth = FALSE p_no_smooth <- plot_stratified_residuals( model, - treatment = treatment, + .exposure = treatment, smooth = FALSE ) expect_s3_class(p_no_smooth, "gg") @@ -196,7 +196,7 @@ test_that("plot_stratified_residuals customization options work", { # Test custom alpha p_alpha <- plot_stratified_residuals( model, - treatment = treatment, + .exposure = treatment, alpha = 0.5 ) expect_s3_class(p_alpha, "gg") @@ -205,7 +205,7 @@ test_that("plot_stratified_residuals customization options work", { ps_model <- glm(treatment ~ x, family = binomial) p_ps <- plot_stratified_residuals( model, - treatment = treatment, + .exposure = treatment, ps_model = ps_model ) expect_s3_class(p_ps, "gg") @@ -236,7 +236,7 @@ test_that("plot_stratified_residuals visual regression tests", { "sr lm color wrong", plot_stratified_residuals( model_wrong, - treatment = treatment, + .exposure = treatment, plot_type = "color" ) ) @@ -245,7 +245,7 @@ test_that("plot_stratified_residuals visual regression tests", { "sr lm facet wrong", plot_stratified_residuals( model_wrong, - treatment = treatment, + .exposure = treatment, plot_type = "facet" ) ) @@ -254,7 +254,7 @@ test_that("plot_stratified_residuals visual regression tests", { "sr lm both wrong", plot_stratified_residuals( model_wrong, - treatment = treatment, + .exposure = treatment, plot_type = "both" ) ) @@ -263,7 +263,7 @@ test_that("plot_stratified_residuals visual regression tests", { "sr lm correct", plot_stratified_residuals( model_correct, - treatment = treatment, + .exposure = treatment, plot_type = "both" ) ) @@ -275,7 +275,7 @@ test_that("plot_stratified_residuals visual regression tests", { "sr lm ps wrong", plot_stratified_residuals( model_wrong, - treatment = treatment, + .exposure = treatment, ps_model = ps_model, plot_type = "color" ) @@ -293,7 +293,7 @@ test_that("plot_stratified_residuals visual regression tests", { "sr df fitted wrong", plot_stratified_residuals( plot_df, - treatment = trt, + .exposure = trt, residuals = resids, x_var = fitted_vals, plot_type = "color" @@ -304,7 +304,7 @@ test_that("plot_stratified_residuals visual regression tests", { "sr df ps facet wrong", plot_stratified_residuals( plot_df, - treatment = trt, + .exposure = trt, residuals = resids, x_var = ps, plot_type = "facet"