Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions R/bal_ess.R
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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)
}
38 changes: 19 additions & 19 deletions R/bal_model_auc.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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()
)
Expand All @@ -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
Expand All @@ -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()
)
Expand All @@ -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))
}
Expand All @@ -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()
)

Expand Down
38 changes: 19 additions & 19 deletions R/bal_model_roc_curve.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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()
)
Expand All @@ -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
Expand All @@ -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()
)
Expand All @@ -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))
}
Expand All @@ -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()
)
}
Loading
Loading