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
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ S3method(is_unit_truncated,default)
S3method(is_unit_truncated,ps_trunc)
S3method(is_unit_truncated,psw)
S3method(print,ipw)
S3method(summary,psw)
S3method(vec_arith,ps_trim)
S3method(vec_arith,ps_trunc)
S3method(vec_arith,psw)
Expand Down
5 changes: 5 additions & 0 deletions R/psw.R
Original file line number Diff line number Diff line change
Expand Up @@ -292,3 +292,8 @@ vec_cast.psw.integer <- function(x, to, estimand = NULL, ...)
vec_cast.integer.psw <- function(x, to, ...) {
vec_cast(vec_data(x), integer(), x_arg = "psw")
}

#' @export
summary.psw <- function(object, ...) {
summary(as.numeric(object), ...)
}
167 changes: 133 additions & 34 deletions R/weights.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,37 +22,73 @@
#' weights have been stabilized, trimmed, or truncated.
#'
#' @details
#' ## Theoretical Background
#'
#' Propensity score weighting is a method for estimating causal effects by
#' creating a pseudo-population where the exposure is independent of measured
#' confounders. The propensity score, \eqn{e(X)}, is the probability of receiving
#' treatment given observed covariates \eqn{X}. By weighting observations inversely
#' proportional to their propensity scores, we can balance the distribution of
#' covariates between treatment groups. Other weights allow for different target populations.
#'
#' ## Mathematical Formulas
#'
#' ### Binary Exposures
#'
#' For binary treatments (\eqn{A = 0} or \eqn{1}), the weights are:
#'
#' - **ATE**: \eqn{w = \frac{A}{e(X)} + \frac{1-A}{1-e(X)}}
#' - **ATT**: \eqn{w = A + \frac{(1-A) \cdot e(X)}{1-e(X)}}
#' - **ATU**: \eqn{w = \frac{A \cdot (1-e(X))}{e(X)} + (1-A)}
#' - **ATM**: \eqn{w = \frac{\min(e(X), 1-e(X))}{A \cdot e(X) + (1-A) \cdot (1-e(X))}}
#' - **ATO**: \eqn{w = A \cdot (1-e(X)) + (1-A) \cdot e(X)}
#' - **Entropy**: \eqn{w = \frac{h(e(X))}{A \cdot e(X) + (1-A) \cdot (1-e(X))}}, where \eqn{h(e) = -[e \cdot \log(e) + (1-e) \cdot \log(1-e)]}
#'
#' ### Continuous Exposures
#'
#' For continuous treatments, weights use the density ratio:
#' \eqn{w = \frac{f_A(A)}{f_{A|X}(A|X)}}, where \eqn{f_A} is the marginal density of \eqn{A}
#' and \eqn{f_{A|X}} is the conditional density given \eqn{X}.
#'
#' ## Exposure Types
#'
#' The functions support different types of exposures:
#' The functions support different types of exposures:
#'
#' - **`binary`**: For dichotomous treatments (e.g. 0/1).
#' - **`continuous`**: For numeric exposures. Here, weights are calculated via the normal density using
#' `dnorm()`.
#' - **`categorical`**: Currently not supported (an error will be raised).
#' - **`auto`**: Automatically detects the exposure type based on `.exposure`.
#'
#' ## Stabilization
#' ## Stabilization
#'
#' For ATE weights, stabilization can improve the performance of the estimator
#' by reducing variance. When `stabilize` is `TRUE` and no
#' `stabilization_score` is provided, the weights are multiplied by the mean
#' of `.exposure`. Alternatively, if a `stabilization_score` is provided, it
#' is used as the multiplier. Stabilized weights have the form:
#' \eqn{w_s = f_A(A) \times w}, where \eqn{f_A(A)} is the marginal probability or density.
#'
#' For ATE weights, stabilization can improve the performance of the estimator
#' by reducing variance. When `stabilize` is `TRUE` and no
#' `stabilization_score` is provided, the weights are multiplied by the mean
#' of `.exposure`. Alternatively, if a `stabilization_score` is provided, it
#' is used as the multiplier.
#' ## Weight Properties and Diagnostics
#'
#' ## Trimmed and Truncated Weights
#' Extreme weights can indicate:
#' - Positivity violations (near 0 or 1 propensity scores)
#' - Poor model specification
#' - Lack of overlap between treatment groups
#'
#' See the halfmoon package for tools to diagnose and visualize weights.
#'
#' You can address extreme weights in several ways. The first is to modify the target population:
#' use trimming, truncation, or alternative estimands (ATM, ATO, entropy).
#' Another technique that can help is stabilization, which reduces variance of the weights.
#'
#' In addition to the standard weight functions, versions exist for trimmed
#' and truncated propensity score weights created by [ps_trim()],
#' [ps_trunc()], and [ps_refit()]. These variants calculate the weights using
#' modified propensity scores (trimmed or truncated) and update the estimand
#' attribute accordingly.
#' ## Trimmed and Truncated Weights
#'
#' The main functions (`wt_ate`, `wt_att`, `wt_atu`, `wt_atm`, and `wt_ato`)
#' dispatch on the class of `.propensity`. For binary exposures, the weights
#' are computed using inverse probability formulas. For continuous exposures
#' (supported only for ATE), weights are computed as the inverse of the
#' density function evaluated at the observed exposure.
#' In addition to the standard weight functions, versions exist for trimmed
#' and truncated propensity score weights created by [ps_trim()],
#' [ps_trunc()], and [ps_refit()]. These variants calculate the weights using
#' modified propensity scores (trimmed or truncated) and update the estimand
#' attribute accordingly.
#'
#' @param .propensity Either a numeric vector of predicted probabilities or a
#' `data.frame` where each column corresponds to a level of the exposure.
Expand Down Expand Up @@ -83,31 +119,94 @@
#' - **truncated**: A logical flag indicating if the weights are based on truncated propensity scores.
#'
#' @examples
#' ## ATE Weights with a Binary Exposure
#' ## Basic Usage with Binary Exposures
#'
#' # Simulate a simple dataset
#' set.seed(123)
#' n <- 100
#' propensity_scores <- runif(n, 0.1, 0.9)
#' treatment <- rbinom(n, 1, propensity_scores)
#'
#' # Calculate different weight types
#' weights_ate <- wt_ate(propensity_scores, treatment)
#' weights_att <- wt_att(propensity_scores, treatment)
#' weights_atu <- wt_atu(propensity_scores, treatment)
#' weights_atm <- wt_atm(propensity_scores, treatment)
#' weights_ato <- wt_ato(propensity_scores, treatment)
#' weights_entropy <- wt_entropy(propensity_scores, treatment)
#'
#' # Compare weight distributions
#' summary(weights_ate)
#' summary(weights_ato) # Often more stable than ATE
#'
#' ## Stabilized Weights
#'
#' # Stabilization reduces variance
#' weights_ate_stab <- wt_ate(propensity_scores, treatment, stabilize = TRUE)
#'
#' # Compare coefficient of variation
#' sd(weights_ate) / mean(weights_ate) # Unstabilized
#' sd(weights_ate_stab) / mean(weights_ate_stab) # Stabilized (lower is better)
#'
#' ## Handling Extreme Propensity Scores
#'
#' # Create data with positivity violations
#' ps_extreme <- c(0.01, 0.02, 0.98, 0.99, rep(0.5, 4))
#' trt_extreme <- c(0, 0, 1, 1, 0, 1, 0, 1)
#'
#' # Standard ATE weights can be extreme
#' wt_extreme <- wt_ate(ps_extreme, trt_extreme)
#' # Very large!
#' max(wt_extreme)
#'
#' # ATO weights are bounded
#' wt_extreme_atm <- wt_ato(ps_extreme, trt_extreme)
#' # Much more reasonable
#' max(wt_extreme_atm)
#' # but they target a different population
#' estimand(wt_extreme_atm) # "ato"
#'
#' @references
#'
#' For detailed guidance on causal inference in R, see [*Causal Inference in R*](https://www.r-causal.org/)
#' by Malcolm Barrett, Lucy D'Agostino McGowan, and Travis Gerke.
#'
#' ## Foundational Papers
#'
#' Rosenbaum, P. R., & Rubin, D. B. (1983). The central role of the propensity
#' score in observational studies for causal effects. *Biometrika*, 70(1), 41-55.
#'
#' ## Estimand-Specific Methods
#'
#' Li, L., & Greene, T. (2013). A weighting analogue to pair matching in
#' propensity score analysis. *The International Journal of Biostatistics*, 9(2),
#' 215-234. (ATM weights)
#'
#' # Simulate a binary treatment and corresponding propensity scores
#' propensity_scores <- c(0.2, 0.7, 0.5, 0.8)
#' treatment <- c(0, 1, 0, 1)
#' Li, F., Morgan, K. L., & Zaslavsky, A. M. (2018). Balancing covariates via
#' propensity score weighting. *Journal of the American Statistical Association*,
#' 113(521), 390-400. (ATO weights)
#'
#' # Compute ATE weights (unstabilized)
#' weights_ate <- wt_ate(propensity_scores, .exposure = treatment)
#' weights_ate
#' Zhou, Y., Matsouaka, R. A., & Thomas, L. (2020). Propensity score weighting
#' under limited overlap and model misspecification. *Statistical Methods in
#' Medical Research*, 29(12), 3721-3756. (Entropy weights)
#'
#' # Compute ATE weights with stabilization using the mean of the exposure
#' weights_ate_stab <- wt_ate(propensity_scores, .exposure = treatment, stabilize = TRUE)
#' weights_ate_stab
#' ## Continuous Exposures
#'
#' ## ATT Weights for a Binary Exposure
#' Hirano, K., & Imbens, G. W. (2004). The propensity score with continuous
#' treatments. *Applied Bayesian Modeling and Causal Inference from
#' Incomplete-Data Perspectives*, 226164, 73-84.
#'
#' propensity_scores <- c(0.3, 0.6, 0.4, 0.7)
#' treatment <- c(1, 1, 0, 0)
#' ## Practical Guidance
#'
#' # Compute ATT weights
#' weights_att <- wt_att(propensity_scores, .exposure = treatment)
#' weights_att
#' Austin, P. C., & Stuart, E. A. (2015). Moving towards best practice when
#' using inverse probability of treatment weighting (IPTW) using the propensity
#' score to estimate causal treatment effects in observational studies.
#' *Statistics in Medicine*, 34(28), 3661-3679.
#'
#' @seealso
#' - [psw()] for details on the structure of the returned weight objects.
#' - [ps_trim()], [ps_trunc()], and [ps_refit()] for handling extreme weights.
#' - [ps_calibrate()] for calibrating weights.
#'
#' @export
wt_ate <- function(
Expand Down
Loading
Loading