diff --git a/.Rbuildignore b/.Rbuildignore index 9ef2582..c675717 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -14,3 +14,5 @@ ^\.vscode$ ^cran-comments\.md$ ^\.beads$ +^doc$ +^Meta$ diff --git a/.gitignore b/.gitignore index 4a64c85..8cbbf06 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,5 @@ docs scratch/ .claude/ CLAUDE.md +/doc/ +/Meta/ diff --git a/DESCRIPTION b/DESCRIPTION index d956b82..8b12350 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -8,8 +8,8 @@ Description: A comprehensive toolkit for propensity score analysis in causal inference. Supports calculating propensity score weights for multiple causal estimands across binary, continuous, and categorical exposures. Provides methods for handling extreme propensity scores - through trimming, truncation, and calibration. Includes inverse - probability weighted estimators that correctly accounts for propensity + through trimming, truncation, and calibration. Includes inverse + probability weighted estimators that correctly account for propensity score estimation uncertainty. License: MIT + file LICENSE URL: https://r-causal.github.io/propensity/, @@ -27,17 +27,20 @@ Imports: Suggests: dplyr, ggplot2, + knitr, mgcv, nnet, parsnip, probably, PSweight, + rmarkdown, spelling, testthat (>= 3.0.0), tibble, tidyr, WeightIt, withr +VignetteBuilder: knitr Config/testthat/edition: 3 Encoding: UTF-8 Language: en-US diff --git a/R/ipw.R b/R/ipw.R index 0aaffad..d468604 100644 --- a/R/ipw.R +++ b/R/ipw.R @@ -1,93 +1,128 @@ -#' Inverse Probability Weights for Causal Inference +#' Inverse Probability Weighted Estimation #' +#' @description #' `ipw()` is a bring-your-own-model (BYOM) inverse probability weighted -#' estimator. `ipw()` accepts a propensity score model and a weighted outcome -#' model that you have already fit. The purpose of `ipw()` is to capture the -#' uncertainty inherent to this two-step process and calculate the correct -#' standard errors for each estimate. Currently, `ipw()` supports binary -#' exposures and either binary or continuous outcomes. For binary outcomes, -#' `ipw()` calculates the marginal risk difference, log risk ratio, and log odds -#' ratio. For continuous outcomes, `ipw()` only calculates the marginal -#' difference in means. +#' estimator for causal inference. You supply a fitted propensity score model +#' and a fitted weighted outcome model; `ipw()` computes causal effect estimates +#' with standard errors that correctly account for the two-step estimation +#' process. +#' +#' `ipw()` currently supports binary exposures with binary or continuous +#' outcomes. For binary outcomes, it returns the risk difference, log risk +#' ratio, and log odds ratio. For continuous outcomes, it returns the difference +#' in means. #' #' @param ps_mod A fitted propensity score model of class [stats::glm()], -#' typically a logistic regression with the exposure as the dependent -#' variable. -#' @param outcome_mod A fitted, weighted outcome model of class [stats::glm()] -#' or [stats::lm()], with the outcome as the dependent variable. -#' @param .data A data frame containing the exposure, outcome, and covariates. If -#' `NULL`, `ipw()` will try to extract the data from `ps_mod` and -#' `outcome_mod`. -#' @param estimand A character string specifying the causal estimand: `ate`, -#' `att`, `ato`, or `atm`. If `NULL`, the function attempts to infer it from -#' existing weights in `outcome_mod`, assuming they were calculated with +#' typically a logistic regression with the exposure as the left-hand side of +#' the formula. +#' @param outcome_mod A fitted weighted outcome model of class [stats::glm()] +#' or [stats::lm()], with the outcome as the dependent variable and +#' propensity score weights supplied via the `weights` argument. The weights +#' should be created with a propensity weight function such as [wt_ate()]. +#' @param .data A data frame containing the exposure, outcome, and covariates. +#' If `NULL` (the default), `ipw()` extracts data from the model objects. +#' Supply `.data` explicitly if the outcome model formula contains +#' transformations that prevent extraction of the exposure variable from +#' [stats::model.frame()]. +#' @param estimand A character string specifying the causal estimand: `"ate"`, +#' `"att"`, `"ato"`, or `"atm"`. If `NULL`, the estimand is inferred from the +#' weights in `outcome_mod`. Auto-detection requires weights created with #' [wt_ate()], [wt_att()], [wt_atm()], or [wt_ato()]. -#' @param ps_link A character string specifying the link function for the -#' propensity score model: `logit`, `probit`, or `cloglog`. Defaults to -#' whatever link was used by `ps_mod`. -#' @param conf_level Numeric. Confidence level for intervals (default `0.95`). +#' @param ps_link A character string specifying the link function used in the +#' propensity score model: `"logit"`, `"probit"`, or `"cloglog"`. Defaults to +#' the link used by `ps_mod`. +#' @param conf_level Confidence level for intervals. Default is `0.95`. +#' +#' @details +#' # Workflow +#' +#' `ipw()` is designed around a three-step workflow: +#' +#' 1. Fit a propensity score model (e.g., logistic regression of exposure on +#' confounders). +#' 2. Calculate propensity score weights for your estimand (e.g., [wt_ate()]) +#' and fit a weighted outcome model. +#' 3. Pass both models to `ipw()` to obtain causal effect estimates with +#' correct standard errors. +#' +#' You are responsible for specifying and fitting both models. `ipw()` handles +#' the variance estimation. #' -#' @details The function constructs inverse probability weights based on the -#' chosen `estimand`, then uses these weights (or extracts them from -#' `outcome_mod`) to compute effect measures: -#' - `rd`: Risk difference +#' # Effect measures +#' +#' For binary outcomes ([stats::glm()] with `family = binomial()`), `ipw()` +#' returns three effect measures: +#' - `rd`: Risk difference (marginal risk in exposed minus unexposed) #' - `log(rr)`: Log risk ratio #' - `log(or)`: Log odds ratio #' -#' For a linear outcome model (using [stats::lm()] or [stats::glm()] with -#' `family = gaussian()`), only the difference in means (`diff`) is returned. +#' For continuous outcomes ([stats::lm()] or [stats::glm()] with +#' `family = gaussian()`), only the difference in means (`diff`) is returned. +#' +#' Use [as.data.frame()] with `exponentiate = TRUE` to obtain risk ratios and +#' odds ratios on their natural scale. #' -#' **Variance Estimation** +#' # Variance estimation #' -#' The variance is estimated via linearization, which provide variance -#' estimates for IPW that correctly account for the uncertainty in estimation -#' of the propensity scores. For more details on various types of propensity -#' score weights and their corresponding variance estimators, see: +#' Standard errors are computed via linearization, which correctly accounts for +#' the uncertainty introduced by estimating propensity scores. This avoids the +#' known problem of underestimated standard errors that arises from treating +#' estimated weights as fixed. See Kostouraki et al. (2024) for details. #' -#' - *Kostouraki A, Hajage D, Rachet B, et al. On variance estimation of the inverse -#' probability-of-treatment weighting estimator: A tutorial for different -#' types of propensity score weights. Statistics in Medicine. 2024; 43(13): -#' 2672-2694. doi: [10.1002/sim.10078](https://doi.org/10.1002/sim.10078)* +#' @references +#' Kostouraki A, Hajage D, Rachet B, et al. On variance estimation of the +#' inverse probability-of-treatment weighting estimator: A tutorial for +#' different types of propensity score weights. *Statistics in Medicine*. +#' 2024;43(13):2672--2694. \doi{10.1002/sim.10078} #' -#' @return An S3 object of class `ipw` containing: -#' - `estimand`: One of `"ate"`, `"att"`, `"ato"`, or `"atm"`. -#' - `ps_mod`: The fitted propensity score model. -#' - `outcome_mod`: The fitted outcome model. -#' - `estimates`: A data frame of point estimates, standard errors, z-statistics, -#' confidence intervals, and p-values. +#' @return An S3 object of class `ipw` with the following components: +#' \describe{ +#' \item{`estimand`}{The causal estimand: one of `"ate"`, `"att"`, `"ato"`, +#' or `"atm"`.} +#' \item{`ps_mod`}{The fitted propensity score model.} +#' \item{`outcome_mod`}{The fitted outcome model.} +#' \item{`estimates`}{A data frame with one row per effect measure and the +#' following columns: `effect` (the measure name), `estimate` (point +#' estimate), `std.err` (standard error), `z` (z-statistic), +#' `ci.lower` and `ci.upper` (confidence interval bounds), +#' `conf.level`, and `p.value`.} +#' } #' #' @examples +#' # Simulate data with a confounder, binary exposure, and binary outcome #' set.seed(123) -#' n <- 100 -#' # confounder +#' n <- 200 #' x1 <- rnorm(n) -#' # exposure -#' z <- rbinom(n, 1, plogis(0.2 * x1)) -#' # binary outcome -#' y <- rbinom(n, 1, plogis(1 + 2*z + 0.5*x1)) -#' +#' z <- rbinom(n, 1, plogis(0.5 * x1)) +#' y <- rbinom(n, 1, plogis(-0.5 + 0.8 * z + 0.3 * x1)) #' dat <- data.frame(x1, z, y) #' -#' # fit a propensity score model (exposure ~ x1) +#' # Step 1: Fit a propensity score model #' ps_mod <- glm(z ~ x1, data = dat, family = binomial()) #' -#' # calculate weights for ATE -#' ps <- predict(ps_mod, type = "response") -#' wts <- wt_ate(ps, z) -#' -#' # fit an outcome model (binary y ~ z) using IPW +#' # Step 2: Calculate ATE weights and fit a weighted outcome model +#' wts <- wt_ate(ps_mod) #' outcome_mod <- glm(y ~ z, data = dat, family = binomial(), weights = wts) #' -#' # run IPW -#' ipw_res <- ipw(ps_mod, outcome_mod) +#' # Step 3: Estimate causal effects with correct standard errors +#' result <- ipw(ps_mod, outcome_mod) +#' result +#' +#' # Exponentiate log-RR and log-OR to get RR and OR +#' as.data.frame(result, exponentiate = TRUE) #' -#' ipw_res +#' # Continuous outcome example +#' y_cont <- 2 + 0.8 * z + 0.3 * x1 + rnorm(n) +#' dat$y_cont <- y_cont +#' outcome_cont <- lm(y_cont ~ z, data = dat, weights = wts) +#' ipw(ps_mod, outcome_cont) #' -#' # Convert to a data frame with exponentiated RR/OR -#' ipw_res_df <- as.data.frame(ipw_res, exponentiate = TRUE) -#' ipw_res_df +#' @seealso +#' [wt_ate()], [wt_att()], [wt_atm()], [wt_ato()] for calculating propensity +#' score weights. #' -#' @seealso [stats::glm()], [stats::lm()] +#' [ps_trim()], [ps_trunc()] for handling extreme propensity scores before +#' weighting. #' #' @export #' @importFrom stats dnorm family formula model.frame model.matrix model.weights @@ -208,9 +243,16 @@ print.ipw <- function(x, ...) { } -#' @param x an `ipw` object -#' @param exponentiate Logical. Should the log-RR and log-OR be exponentiated? -#' @param row.names,optional,... Passed to `as.data.frame()`. +#' @param x An `ipw` object. +#' @param exponentiate If `TRUE`, exponentiate the log risk ratio and log odds +#' ratio to produce risk ratios and odds ratios on their natural scale. The +#' confidence interval bounds are also exponentiated. Standard errors, z +#' statistics, and p-values remain on the log scale. Default is `FALSE`. +#' @param row.names,optional,... Passed to [base::as.data.frame()]. +#' @returns `as.data.frame()` returns the `estimates` component as a data +#' frame. When `exponentiate = TRUE`, the `log(rr)` and `log(or)` rows are +#' transformed: point estimates and confidence limits are exponentiated and +#' the effect labels become `"rr"` and `"or"`. #' @export #' @rdname ipw as.data.frame.ipw <- function( diff --git a/R/propensity-package.R b/R/propensity-package.R index b0bff19..e3ba443 100644 --- a/R/propensity-package.R +++ b/R/propensity-package.R @@ -1,4 +1,46 @@ -#' @keywords internal +#' @title propensity: A Toolkit for Calculating and Working with Propensity Scores +#' +#' @description +#' propensity provides tools for propensity score analysis in causal inference. +#' Calculate propensity score weights for a variety of causal estimands, handle +#' extreme propensity scores through trimming, truncation, and calibration, and +#' estimate causal effects with inverse probability weighting. The package +#' supports binary, categorical, and continuous exposures. +#' +#' @section Weight functions: +#' Calculate propensity score weights for different causal estimands: +#' * [wt_ate()]: Average treatment effect (ATE) weights +#' * [wt_att()]: Average treatment effect on the treated (ATT) weights +#' * [wt_atu()]: Average treatment effect on the untreated (ATU) weights +#' (`wt_atc()` is an alias) +#' * [wt_atm()]: Average treatment effect for the evenly matchable (ATM) weights +#' * [wt_ato()]: Average treatment effect for the overlap population (ATO) weights +#' * [wt_entropy()]: Entropy balancing weights +#' * [wt_cens()]: Censoring weights +#' +#' @section Propensity score modifications: +#' Handle extreme propensity scores before calculating weights: +#' * [ps_trim()]: Trim observations with extreme propensity scores +#' * [ps_trunc()]: Truncate (winsorize) extreme propensity scores +#' * [ps_calibrate()]: Calibrate propensity scores to improve balance +#' * [ps_refit()]: Re-estimate the propensity score model after trimming +#' +#' @section Estimation: +#' * [ipw()]: Inverse probability weighted estimator with variance estimation +#' that accounts for propensity score estimation uncertainty +#' +#' @section PSW class: +#' The [psw()] class represents propensity score weights with metadata about +#' the estimand and modifications applied: +#' * [psw()], [as_psw()], [is_psw()]: Create and test propensity score weights +#' * [estimand()]: Query the causal estimand +#' * [is_stabilized()]: Check if weights are stabilized +#' +#' @seealso +#' * `vignette("propensity")` for a getting started guide +#' * The [package website](https://r-causal.github.io/propensity/) for +#' full documentation +#' "_PACKAGE" ## usethis namespace: start diff --git a/R/ps_calibration.R b/R/ps_calibration.R index b4ed668..47ba76c 100644 --- a/R/ps_calibration.R +++ b/R/ps_calibration.R @@ -76,52 +76,87 @@ pava_weighted <- function(x, y, w = rep(1, length(x))) { #' Calibrate propensity scores #' -#' This function calibrates propensity scores to improve their accuracy using -#' either Platt scaling (logistic regression) or isotonic regression. It -#' preserves the attributes of causal weight objects when applicable. +#' @description +#' `ps_calibrate()` adjusts estimated propensity scores so they better reflect +#' true treatment probabilities. This can improve the accuracy of inverse +#' probability weights derived from a misspecified propensity score model. #' -#' @param ps Numeric vector of propensity scores between 0 and 1 -#' @param .exposure A binary vector of treatment assignments -#' @param method Calibration method: +#' @param ps A numeric vector of propensity scores between 0 and 1. Must not +#' already be calibrated. +#' @param .exposure A binary vector of observed treatment assignments, the same +#' length as `ps`. +#' @param method Calibration method. One of: #' \describe{ -#' \item{`"logistic"`}{(Default) Logistic calibration (also known as Platt scaling). -#' Assumes a sigmoid relationship between observed and true probabilities. -#' Best when: propensity scores follow a logistic pattern but are -#' systematically biased. Provides smooth, parametric calibration. -#' Faster and more stable with small samples.} -#' \item{`"isoreg"`}{Isotonic regression calibration. Uses a non-parametric -#' monotonic transformation. Best when: the relationship between observed -#' and true probabilities is non-linear or when you want to preserve -#' the rank order without assuming a specific functional form. -#' More flexible but requires larger samples for stable estimates.} +#' \item{`"logistic"`}{(Default) Logistic calibration, also called Platt +#' scaling. Fits a logistic regression of `.exposure` on `ps`, yielding +#' a smooth, parametric correction. Works well with small samples and +#' when the bias in `ps` is approximately monotone.} +#' \item{`"isoreg"`}{Isotonic regression. Fits a non-parametric, +#' monotone step function. More flexible than logistic calibration +#' because it makes no distributional assumption, but needs larger +#' samples for stable estimates.} #' } -#' @param smooth Logical. For `method = "logistic"`, whether to use a smoothed -#' logistic spline model (`smooth = TRUE`, default) or simple logistic -#' regression (`smooth = FALSE`). When `TRUE`, uses `mgcv::gam()` with -#' spline smoothing. When `FALSE`, uses `stats::glm()`. Ignored for -#' `method = "isoreg"`. -#' @param .focal_level The value representing the focal group (typically treatment). -#' If not provided, `ps_calibrate()` will attempt to automatically determine the coding. -#' @param .reference_level The value representing the reference group (typically control). -#' If not provided, `ps_calibrate()` will attempt to automatically determine the coding. +#' @param smooth Logical. When `method = "logistic"`, controls the form of the +#' calibration model. If `TRUE` (default), fits a GAM with a spline on +#' `ps` via [mgcv::gam()]; if `FALSE`, fits a simple logistic regression +#' via [stats::glm()]. Ignored when `method = "isoreg"`. +#' @param .focal_level The value of `.exposure` representing the focal group +#' (typically the treated group). If `NULL` (default), coding is determined +#' automatically. +#' @param .reference_level The value of `.exposure` representing the reference +#' group (typically the control group). If `NULL` (default), coding is +#' determined automatically. #' @param .treated `r lifecycle::badge("deprecated")` Use `.focal_level` instead. #' @param .untreated `r lifecycle::badge("deprecated")` Use `.reference_level` instead. #' -#' @return A calibrated propensity score object (`ps_calib`) +#' @details +#' Calibration is useful when the propensity score model is correctly +#' specified in terms of variable selection but produces probabilities that +#' are systematically too high or too low. Unlike [ps_trim()] and +#' [ps_trunc()], which handle extreme scores by removing or bounding them, +#' calibration reshapes the entire distribution of scores. +#' +#' **Choosing a method:** +#' - Use `"logistic"` (the default) as a first choice. It is stable and +#' fast, and the `smooth = TRUE` option adds flexibility via a spline. +#' - Use `"isoreg"` when you suspect a non-smooth or irregular relationship +#' between estimated and true probabilities and have a sufficiently large +#' sample. +#' +#' The calibrated scores are returned as a `ps_calib` object, which can be +#' passed directly to weight functions such as [wt_ate()]. +#' +#' @return A `ps_calib` vector the same length as `ps`. The attribute +#' `ps_calib_meta` stores calibration metadata (method and whether +#' smoothing was applied). Use [is_ps_calibrated()] to test whether an +#' object has been calibrated. +#' +#' @seealso [is_ps_calibrated()] to test for calibrated scores; +#' [ps_trim()] and [ps_trunc()] for alternative approaches to extreme +#' propensity scores; [wt_ate()] and other weight functions that accept +#' `ps_calib` objects. #' #' @examples -#' # Generate example data -#' ps <- runif(100) -#' exposure <- rbinom(100, 1, ps) +#' # Simulate data +#' set.seed(42) +#' ps <- runif(200) +#' exposure <- rbinom(200, 1, ps) +#' +#' # Logistic calibration without smoothing (simple Platt scaling) +#' cal <- ps_calibrate(ps, exposure, smooth = FALSE) +#' cal +#' +#' # Use calibrated scores to calculate weights +#' wt_ate(cal, exposure) #' -#' # Logistic calibration with smoothing (default) -#' calibrated_smooth <- ps_calibrate(ps, exposure) +#' # Isotonic regression calibration +#' cal_iso <- ps_calibrate(ps, exposure, method = "isoreg") #' -#' # Logistic calibration without smoothing (simple logistic regression) -#' calibrated_simple <- ps_calibrate(ps, exposure, smooth = FALSE) +#' if (rlang::is_installed("mgcv")) { +#' # Logistic calibration with spline smoothing (default) +#' cal_smooth <- ps_calibrate(ps, exposure) +#' } #' -#' # Isotonic regression -#' calibrated_iso <- ps_calibrate(ps, exposure, method = "isoreg") #' @importFrom stats glm fitted binomial #' @export ps_calibrate <- function( @@ -344,14 +379,25 @@ ps_calib_meta <- function(x) { attr(x, "ps_calib_meta") } -#' Check if object is calibrated +#' Check if propensity scores are calibrated #' -#' @description -#' `is_ps_calibrated()` is an S3 generic that returns `TRUE` if its argument represents -#' calibrated propensity scores. +#' `is_ps_calibrated()` tests whether `x` is a calibrated propensity score +#' object (class `ps_calib`) or a `psw` object derived from calibrated scores. +#' +#' @param x An object to test. +#' @return A single `TRUE` or `FALSE`. +#' +#' @seealso [ps_calibrate()] to calibrate propensity scores. +#' +#' @examples +#' ps <- runif(100) +#' exposure <- rbinom(100, 1, ps) +#' +#' is_ps_calibrated(ps) +#' +#' calibrated <- ps_calibrate(ps, exposure) +#' is_ps_calibrated(calibrated) #' -#' @param x An R object. -#' @return A logical scalar (`TRUE` or `FALSE`). #' @export is_ps_calibrated <- function(x) { UseMethod("is_ps_calibrated") diff --git a/R/ps_trim.R b/R/ps_trim.R index 140bfcb..3fc3109 100644 --- a/R/ps_trim.R +++ b/R/ps_trim.R @@ -1,66 +1,128 @@ #' Trim Propensity Scores #' -#' `ps_trim()` applies trimming methods to a propensity-score vector or matrix, -#' returning a new vector/matrix of the *same length/dimensions*, with trimmed -#' entries replaced by `NA.` You can inspect further metadata in `ps_trim_meta(x)`. -#' After running `ps_trim()`, you should refit the model with `ps_refit()`. -#' -#' @param ps The propensity score, either a numeric vector between 0 and 1 for -#' binary exposures, or a matrix/data.frame where each column represents -#' propensity scores for each level of a categorical exposure. -#' @param .exposure For methods like `"pref"` or `"cr"`, a vector for a binary -#' exposure. For categorical exposures with method `"optimal"`, must be a -#' factor or character vector. -#' @param method One of `c("ps", "adaptive", "pctl", "pref", "cr", "optimal")`. +#' @description +#' Trim observations with extreme propensity scores by replacing them with `NA`, +#' effectively removing those units from downstream analyses. The returned object +#' has the same length (or dimensions) as the input, with trimmed entries set to +#' `NA`. After trimming, refit the propensity score model on the retained +#' observations with [ps_refit()]. +#' +#' @param ps A numeric vector of propensity scores in (0, 1) for binary +#' exposures, or a matrix / data frame where each column gives the propensity +#' score for one level of a categorical exposure. +#' @param method Trimming method. One of: +#' +#' * **`"ps"`** (default): Fixed threshold. Observations with propensity +#' scores outside `[lower, upper]` are trimmed. For categorical exposures, +#' observations where *any* column falls below `lower` (the symmetric +#' threshold delta) are trimmed. +#' * **`"adaptive"`**: Data-driven threshold that minimizes the asymptotic +#' variance of the IPW estimator (Crump et al., 2009). The `lower` and +#' `upper` arguments are ignored. +#' * **`"pctl"`**: Quantile-based. Observations outside the `[lower, upper]` +#' quantiles of the propensity score distribution are trimmed. Defaults: +#' `lower = 0.05`, `upper = 0.95`. +#' * **`"pref"`**: Preference score trimming. Transforms propensity scores +#' to the preference scale (Walker et al., 2013) and trims outside +#' `[lower, upper]`. Requires `.exposure`. Binary exposures only. Defaults: +#' `lower = 0.3`, `upper = 0.7`. +#' * **`"cr"`**: Common range (clinical equipoise). Trims to the overlap +#' region of the propensity score distributions across exposure groups. +#' Requires `.exposure`. Binary exposures only. The `lower` and `upper` +#' arguments are ignored. +#' * **`"optimal"`**: Multi-category optimal trimming (Yang et al., 2016). +#' Categorical exposures only. Requires `.exposure`. +#' #' For categorical exposures, only `"ps"` and `"optimal"` are supported. -#' @param lower,upper Numeric cutoffs or quantiles. If `NULL`, defaults vary by -#' method. For categorical exposures with method `"ps"`, `lower` represents the -#' symmetric trimming threshold (delta). +#' @param lower,upper Numeric thresholds whose interpretation depends on +#' `method`: +#' +#' * `"ps"`: absolute propensity score bounds (defaults: 0.1, 0.9). For +#' categorical exposures, only `lower` is used as the symmetric threshold. +#' * `"pctl"`: quantile probabilities (defaults: 0.05, 0.95). +#' * `"pref"`: preference score bounds (defaults: 0.3, 0.7). +#' * `"adaptive"`, `"cr"`, `"optimal"`: ignored (thresholds are data-driven). +#' @param .exposure An exposure variable. Required for `"pref"`, `"cr"` (binary +#' vector), and `"optimal"` (factor or character). Not required for other +#' methods. #' @inheritParams wt_ate -#' @param ... Additional arguments passed to methods -#' -#' @details The returned object is a **`ps_trim`** vector/matrix of the same -#' length/dimensions as `ps`, but with trimmed entries replaced by `NA`. An -#' attribute `ps_trim_meta` contains: -#' -#' - `method`: Which trimming method was used -#' - `keep_idx`: Indices retained -#' - `trimmed_idx`: Indices replaced by `NA` -#' - Possibly other fields such as final cutoffs, etc. -#' -#' For categorical exposures: -#' - **Symmetric trimming** (`method = "ps"`): Removes observations where any -#' propensity score falls below the threshold delta (specified via `lower`). -#' - **Optimal trimming** (`method = "optimal"`): Uses the Yang et al. (2016) -#' approach for multi-category treatments. -#' -#' **Arithmetic behavior**: Arithmetic operations on `ps_trim` objects return -#' numeric vectors, not `ps_trim` objects. This is intentional - once you -#' transform propensity scores (e.g., `1/ps` for weights), the result is no -#' longer a propensity score. -#' -#' **NA handling**: Trimmed values are set to `NA`. Operations that don't handle -#' `NA` values will propagate them (e.g., `sum()` returns `NA` unless -#' `na.rm = TRUE`). -#' -#' **Metadata tracking**: The `trimmed_idx` and `keep_idx` are updated when -#' subsetting or reordering: -#' - Subsetting with `[` updates indices to new positions -#' - `sort()` reorders data and updates indices accordingly -#' - `unique()` may change lengths but preserves the class -#' - `na.omit()` removes trimmed values and updates indices -#' -#' **Combining behavior**: When combining `ps_trim` objects with `c()`, metadata -#' must match (same trimming parameters). Mismatched metadata triggers a warning -#' and returns a numeric vector. -#' -#' @return A `ps_trim` object (numeric vector or matrix). The attribute -#' `ps_trim_meta` stores metadata. -#' -#' @seealso [ps_trunc()] for bounding/winsorizing instead of discarding, -#' [is_refit()], [is_ps_trimmed()] -#' @examples +#' @param ... Additional arguments passed to methods. +#' +#' @details +#' ## How trimming works +#' +#' Trimming identifies observations with extreme (near 0 or 1) propensity +#' scores and sets them to `NA`. These observations are excluded from +#' subsequent weight calculations and effect estimation. The goal is to +#' remove units that lack sufficient overlap between exposure groups, which +#' would otherwise receive extreme weights and destabilize estimates. +#' +#' ## Choosing a method +#' +#' * Use `"ps"` when you have a specific threshold in mind or want a simple +#' default. +#' * Use `"adaptive"` for a principled, data-driven cutoff that targets +#' variance reduction. +#' * Use `"pctl"` to trim a fixed percentage of extreme values from each tail. +#' * Use `"pref"` when you want to restrict to the region of clinical +#' equipoise based on the preference score. +#' * Use `"cr"` to restrict to the common support region where both exposure +#' groups have observed propensity scores. +#' * Use `"optimal"` for multi-category (3+) exposures; this is the only +#' data-driven method available for categorical treatments. +#' +#' ## Typical workflow +#' +#' 1. Fit a propensity score model +#' 2. Apply `ps_trim()` to flag extreme values +#' 3. Call [ps_refit()] to re-estimate propensity scores on the retained sample +#' 4. Compute weights with [wt_ate()] or another weight function +#' +#' ## Object behavior +#' +#' Arithmetic operations on `ps_trim` objects return plain numeric vectors, +#' since transformed propensity scores (e.g., `1/ps`) are no longer propensity +#' scores. Trimmed values propagate as `NA` in calculations; use `na.rm = TRUE` +#' where appropriate. +#' +#' When combining `ps_trim` objects with [c()], trimming parameters must match. +#' Mismatched parameters trigger a warning and return a numeric vector. +#' +#' Use [ps_trim_meta()] to inspect the trimming metadata, including the method, +#' cutoffs, and which observations were retained or trimmed. +#' +#' @return A **`ps_trim`** object (a numeric vector with class `"ps_trim"`, or a +#' matrix with class `"ps_trim_matrix"`). Trimmed observations are `NA`. +#' Metadata is stored in the `"ps_trim_meta"` attribute and can be accessed +#' with [ps_trim_meta()]. Key fields include: #' +#' * `method`: the trimming method used +#' * `keep_idx`: integer indices of retained observations +#' * `trimmed_idx`: integer indices of trimmed (NA) observations +#' * Method-specific fields such as `cutoff` (adaptive), `q_lower`/`q_upper` +#' (pctl), `cr_lower`/`cr_upper` (cr), `delta` (categorical ps), +#' or `lambda` (optimal) +#' +#' @references +#' Crump, R. K., Hotz, V. J., Imbens, G. W., & Mitnik, O. A. (2009). Dealing +#' with limited overlap in estimation of average treatment effects. +#' *Biometrika*, 96(1), 187--199. +#' +#' Walker, A. M., Patrick, A. R., Lauer, M. S., et al. (2013). A tool for +#' assessing the feasibility of comparative effectiveness research. +#' *Comparative Effectiveness Research*, 3, 11--20. +#' +#' Yang, S., Imbens, G. W., Cui, Z., Faries, D. E., & Kadziola, Z. (2016). +#' Propensity score matching and subclassification in observational studies +#' with multi-level treatments. *Biometrics*, 72(4), 1055--1065. +#' +#' @seealso [ps_trunc()] for bounding (winsorizing) instead of discarding, +#' [ps_refit()] to re-estimate propensity scores after trimming, +#' [ps_calibrate()] for calibration-based adjustment, +#' [ps_trim_meta()] to inspect trimming metadata, +#' [is_ps_trimmed()] and [is_unit_trimmed()] for logical queries. +#' +#' @examples #' set.seed(2) #' n <- 300 #' x <- rnorm(n) @@ -68,22 +130,23 @@ #' fit <- glm(z ~ x, family = binomial) #' ps <- predict(fit, type = "response") #' -#' ps_trim(ps, method = "adaptive") +#' # Fixed threshold trimming (default) +#' trimmed <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) +#' trimmed #' -#' # Coercion behavior with ps_trim objects -#' ps_trim1 <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) -#' ps_trim2 <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) +#' # How many observations were trimmed? +#' sum(is_unit_trimmed(trimmed)) #' -#' # Compatible objects combine silently -#' c(ps_trim1[1:50], ps_trim2[51:100]) # Returns ps_trim object +#' # Data-driven adaptive trimming +#' ps_trim(ps, method = "adaptive") #' -#' # Different trim parameters trigger warning -#' ps_trim3 <- ps_trim(ps, method = "ps", lower = 0.2, upper = 0.8) -#' c(ps_trim1[1:50], ps_trim3[51:100]) # Warning: returns numeric +#' # Quantile-based trimming at 5th and 95th percentiles +#' ps_trim(ps, method = "pctl") #' -#' # Cross-class combinations warn and return numeric -#' psw_obj <- psw(ps[1:50], estimand = "ate") -#' c(ps_trim1[1:50], psw_obj) # Warning: returns numeric +#' # Refit after trimming, then compute weights +#' trimmed <- ps_trim(ps, method = "adaptive") +#' refitted <- ps_refit(trimmed, fit) +#' wt_ate(refitted, .exposure = z) #' #' @export ps_trim <- function( @@ -484,16 +547,27 @@ new_trimmed_ps <- function(x, ps_trim_meta = list()) { } } -#' Check if object is trimmed +#' Test whether propensity scores have been trimmed #' -#' @description `is_ps_trimmed()` is an S3 generic that returns `TRUE` if its -#' argument represents a `ps_trim` object or `psw` object created from trimmed -#' propensity scores. `is_ps_trimmed()` is a question about whether or not the -#' propensity scores *have* been trimmed, as opposed to [is_unit_trimmed()], -#' which is a question about which *units* have been trimmed. +#' @description `is_ps_trimmed()` returns `TRUE` if `x` is a `ps_trim` object +#' or a `psw` object created from trimmed propensity scores, and `FALSE` +#' otherwise. This tests whether the *object* carries trimming information, not +#' which individual units were trimmed; see [is_unit_trimmed()] for that. #' -#' @param x An object. +#' @param x An object to test. #' @return A logical scalar (`TRUE` or `FALSE`). +#' +#' @seealso [ps_trim()] for trimming propensity scores, [is_unit_trimmed()] to +#' identify which units were trimmed, [ps_trim_meta()] to retrieve full +#' trimming metadata. +#' +#' @examples +#' ps <- c(0.05, 0.3, 0.6, 0.95) +#' trimmed <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) +#' +#' is_ps_trimmed(trimmed) +#' is_ps_trimmed(ps) +#' #' @export is_ps_trimmed <- function(x) { UseMethod("is_ps_trimmed") @@ -514,16 +588,31 @@ is_ps_trimmed.ps_trim_matrix <- function(x) { TRUE } -#' Check if units have been trimmed +#' Identify which units were trimmed #' -#' @description `is_unit_trimmed()` is an that vector of `TRUE` or `FALSE` -#' values, representing if the unit was trimmed. `is_unit_trimmed()` is a -#' question about which *units* have been trimmed, as opposed to -#' [is_ps_trimmed()], which is a question about whether or not the propensity -#' scores *have* been trimmed. +#' @description `is_unit_trimmed()` returns a logical vector indicating which +#' observations were removed by trimming. This is a per-unit query, as opposed +#' to [is_ps_trimmed()], which tests whether the object has been trimmed at +#' all. +#' +#' @param x A `ps_trim` object created by [ps_trim()]. +#' @return A logical vector the same length as `x`, where `TRUE` marks a +#' trimmed unit. +#' +#' @seealso [ps_trim()] for trimming propensity scores, [is_ps_trimmed()] to +#' test whether an object has been trimmed, [ps_trim_meta()] to retrieve full +#' trimming metadata. +#' +#' @examples +#' ps <- c(0.05, 0.3, 0.6, 0.95) +#' trimmed <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) +#' +#' is_unit_trimmed(trimmed) +#' +#' # Use to subset data to retained observations +#' kept <- !is_unit_trimmed(trimmed) +#' ps[kept] #' -#' @param x An object. -#' @return A logical scalar (`TRUE` or `FALSE`). #' @export is_unit_trimmed <- function(x) { UseMethod("is_unit_trimmed") @@ -1100,38 +1189,51 @@ diff.ps_trim <- function(x, lag = 1L, differences = 1L, ...) { diff(vec_data(x), lag = lag, differences = differences, ...) } -#' Refit the Propensity Score Model on Retained Observations +#' Refit a Propensity Score Model on Retained Observations #' -#' Takes a `ps_trim` object and the original model -#' used to calculate the propensity score, then: -#' 1. Retrieves data from the model (or from `.df` argument if provided) -#' 2. Subsets rows to the non‐trimmed indices -#' 3. Refits the model -#' 4. Predicts new propensity scores for all rows (trimmed rows -> `NA`) -#' 5. Returns a new `ps_trim` object with `refit = TRUE`. +#' @description +#' Re-estimates a propensity score model using only the observations retained +#' after trimming. This is the recommended intermediate step between +#' [ps_trim()] and weight calculation (e.g. [wt_ate()]): #' -#' @param trimmed_ps A `ps_trim` object (same length as data, NAs for trimmed). -#' @param model The fitted model used to get the original PS (e.g. a glm). -#' @param .data Optional. A data frame. If `NULL`, we try to retrieve from `model`. -#' @param ... Additional arguments passed to `update()`. +#' **`ps_trim()` -> `ps_refit()` -> `wt_*()`** #' -#' @return -#' A new `ps_trim` object with updated propensity scores and -#' `ps_trim_meta(x)$refit` set to `TRUE`. +#' Trimming changes the target population by removing observations with extreme +#' propensity scores. Refitting the model on the retained subset produces +#' propensity scores that better reflect this population, improving both model +#' fit and downstream weight estimation. Weight functions warn if a trimmed +#' propensity score has not been refit. #' -#' @seealso [ps_trim()], [is_refit()], [is_ps_trimmed()] +#' @param trimmed_ps A `ps_trim` object returned by [ps_trim()]. +#' @param model The original fitted model used to estimate the propensity +#' scores (e.g. a [glm][stats::glm] or [multinom][nnet::multinom] object). +#' The model is refit via [update()][stats::update] on the retained subset. +#' @param .data A data frame. If `NULL` (the default), the data are extracted +#' from `model` via [model.frame()][stats::model.frame]. +#' @param ... Additional arguments passed to [update()][stats::update]. +#' +#' @return A `ps_trim` object with re-estimated propensity scores for retained +#' observations and `NA` for trimmed observations. Use [is_refit()] to +#' confirm refitting was applied. +#' +#' @seealso [ps_trim()] for the trimming step, [is_refit()] to check refit +#' status, [wt_ate()] and other weight functions for the next step in the +#' pipeline. #' #' @examples #' set.seed(2) -#' n <- 30 +#' n <- 200 #' x <- rnorm(n) #' z <- rbinom(n, 1, plogis(0.4 * x)) -#' fit <- glm(z ~ x, family = binomial) -#' ps <- predict(fit, type = "response") #' -#' # trim and refit -#' refit <- ps_trim(ps, lower = .2, upper = .8) |> -#' ps_refit(fit) +#' # fit a propensity score model +#' ps_model <- glm(z ~ x, family = binomial) +#' ps <- predict(ps_model, type = "response") +#' +#' # trim -> refit -> weight pipeline +#' trimmed <- ps_trim(ps, lower = 0.1, upper = 0.9) +#' refit <- ps_refit(trimmed, ps_model) +#' wts <- wt_ate(refit, .exposure = z) #' #' is_refit(refit) #' @@ -1214,15 +1316,32 @@ ps_refit <- function(trimmed_ps, model, .data = NULL, ...) { ) } -#' Check if an object has been refit +#' Check if propensity scores have been refit #' -#' @description -#' **`is_refit()`** is an S3 generic that returns `TRUE` if its argument -#' represents a [ps_trim] object (or a weighting object) that has had the -#' propensity model refit on the retained subset. +#' `is_refit()` tests whether `x` is a `ps_trim` object whose propensity +#' model has been refit on the retained (non-trimmed) observations via +#' [ps_refit()]. +#' +#' @param x An object to test (typically a [ps_trim] vector). +#' @return A single `TRUE` or `FALSE`. +#' +#' @seealso [ps_refit()] to refit a propensity model after trimming, +#' [ps_trim()] to trim propensity scores. +#' +#' @examples +#' set.seed(2) +#' n <- 30 +#' x <- rnorm(n) +#' z <- rbinom(n, 1, plogis(0.4 * x)) +#' fit <- glm(z ~ x, family = binomial) +#' ps <- predict(fit, type = "response") +#' +#' trimmed <- ps_trim(ps, lower = 0.2, upper = 0.8) +#' is_refit(trimmed) +#' +#' refit <- ps_refit(trimmed, fit) +#' is_refit(refit) #' -#' @param x An R object (e.g. a [ps_trim] or [psw]). -#' @return A logical scalar (`TRUE` or `FALSE`). #' @export is_refit <- function(x) { UseMethod("is_refit") @@ -1239,10 +1358,32 @@ is_refit.ps_trim <- function(x) { isTRUE(meta$refit) } -#' @title Extract `ps_trim` metadata -#' @description Returns the internal metadata list for a `ps_trim` object. -#' @param x A **`ps_trim`** object. -#' @return A named list of metadata. +#' Extract trimming metadata from a `ps_trim` object +#' +#' @description `ps_trim_meta()` returns the metadata list attached to a +#' `ps_trim` object by [ps_trim()]. +#' +#' @param x A `ps_trim` object. +#' @return A named list with elements: +#' \describe{ +#' \item{`method`}{Character string indicating the trimming method used.} +#' \item{`keep_idx`}{Integer vector of retained observation indices.} +#' \item{`trimmed_idx`}{Integer vector of trimmed observation indices.} +#' \item{`lower`, `upper`}{Numeric cutoffs, when applicable.} +#' \item{`refit`}{Logical, `TRUE` if the model was refit via [ps_refit()].} +#' } +#' Additional method-specific elements (e.g. `cutoff`, `delta`, `lambda`) may +#' also be present. +#' +#' @seealso [ps_trim()] for trimming propensity scores, [is_ps_trimmed()] and +#' [is_unit_trimmed()] for predicate queries. +#' +#' @examples +#' ps <- c(0.05, 0.3, 0.6, 0.95) +#' trimmed <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) +#' +#' ps_trim_meta(trimmed) +#' #' @export ps_trim_meta <- function(x) { attr(x, "ps_trim_meta") diff --git a/R/ps_trunc.R b/R/ps_trunc.R index bff2f0d..521a6e6 100644 --- a/R/ps_trunc.R +++ b/R/ps_trunc.R @@ -1,90 +1,88 @@ #' Truncate (Winsorize) Propensity Scores #' -#' **`ps_trunc()`** sets out‐of‐range propensity scores to fixed bounding values -#' (a form of *winsorizing*). This is an alternative to [ps_trim()], which removes -#' (sets `NA`) instead of bounding and is then refit with [ps_refit()] -#' -#' @param ps The propensity score, either a numeric vector between 0 and 1 for -#' binary exposures, or a matrix/data.frame where each column represents -#' propensity scores for each level of a categorical exposure. -#' @param .exposure For method "cr", a binary exposure vector. For categorical -#' exposures, must be a factor or character vector. -#' @param method One of `"ps"`, `"pctl"`, or `"cr"`. -#' * `"ps"`: directly cut on `[lower, upper]` of `ps`. For categorical, uses -#' symmetric truncation with `lower` as the threshold. -#' * `"pctl"`: use quantiles of `ps` as bounding values. For categorical, -#' calculates quantiles across all propensity score values. -#' * `"cr"`: the common range of `ps` given `.exposure`, bounding -#' `[min(ps[treated]), max(ps[untreated])]` (binary only) -#' @param lower,upper Numeric or quantile bounds. If `NULL`, defaults vary by method. -#' For categorical exposures with method `"ps"`, `lower` represents the -#' truncation threshold (delta). +#' `ps_trunc()` bounds extreme propensity scores to fixed limits, replacing +#' out-of-range values with the boundary value (a form of *winsorizing*). The +#' result is a vector or matrix of the same length and dimensions as `ps`, with +#' no observations removed. This contrasts with [ps_trim()], which sets extreme +#' values to `NA` (effectively removing those observations from analysis). +#' +#' @param ps A numeric vector of propensity scores between 0 and 1 (binary +#' exposures), or a matrix/data.frame where each column contains propensity +#' scores for one level of a categorical exposure. +#' @param .exposure An exposure vector. Required for method `"cr"` (binary +#' exposure vector) and for categorical exposures (factor or character vector) +#' with any method. +#' @param method One of `"ps"`, `"pctl"`, or `"cr"`: +#' * `"ps"` (default): Truncate directly on propensity score values. Values +#' outside `[lower, upper]` are set to the nearest bound. For categorical +#' exposures, applies symmetric truncation using `lower` as the threshold +#' (delta) and renormalizes rows to sum to 1. +#' * `"pctl"`: Truncate at quantiles of the propensity score distribution. +#' The `lower` and `upper` arguments specify quantile probabilities. For +#' categorical exposures, quantiles are computed across all columns. +#' * `"cr"`: Truncate to the common range of propensity scores across +#' exposure groups (binary exposures only). Bounds are +#' `[min(ps[focal]), max(ps[reference])]`. Requires `.exposure`. +#' @param lower,upper Bounds for truncation. Interpretation depends on `method`: +#' * `method = "ps"`: Propensity score values (defaults: 0.1 and 0.9). For +#' categorical exposures, `lower` is the truncation threshold delta +#' (default: 0.01); `upper` is ignored. +#' * `method = "pctl"`: Quantile probabilities (defaults: 0.05 and 0.95; +#' categorical defaults: 0.01 and 0.99). +#' * `method = "cr"`: Ignored; bounds are determined by the data. #' @inheritParams wt_ate -#' @param ... Additional arguments passed to methods +#' @param ... Additional arguments passed to methods. #' #' @details -#' For binary exposures with each \eqn{ps[i]}: -#' - If \eqn{ps[i] < lower\_bound}, we set \eqn{ps[i] = lower\_bound}. -#' - If \eqn{ps[i] > upper\_bound}, we set \eqn{ps[i] = upper\_bound}. +#' Unlike [ps_trim()], truncation preserves all observations. No `NA` values +#' are introduced; out-of-range scores are replaced with the boundary value. #' -#' For categorical exposures: -#' - Each value below the threshold is set to the threshold -#' - Rows are renormalized to sum to 1 +#' For **binary exposures**, each propensity score \eqn{e_i} is bounded: #' -#' This approach is often called *winsorizing*. +#' - If \eqn{e_i < l}, set \eqn{e_i = l} (the lower bound). #' -#' **Arithmetic behavior**: Like `ps_trim`, arithmetic operations on `ps_trunc` -#' objects return numeric vectors. The reasoning is the same - transformed -#' propensity scores (e.g., weights) are no longer propensity scores. +#' - If \eqn{e_i > u}, set \eqn{e_i = u} (the upper bound). #' -#' **No NA values**: Unlike `ps_trim`, truncation doesn't create `NA` values. -#' Out-of-range values are set to the boundaries, so all values remain finite -#' and valid for calculations. +#' For **categorical exposures**, values below the threshold are set to the +#' threshold and each row is renormalized to sum to 1. #' -#' **Metadata tracking**: The `truncated_idx` tracks which positions had their -#' values modified (winsorized to boundaries): -#' - Subsetting with `[` updates indices to new positions -#' - `sort()` reorders data and updates indices accordingly -#' - Operations preserve finite values (no `NA` handling needed) +#' **Arithmetic behavior**: Arithmetic operations on `ps_trunc` objects return +#' plain numeric vectors. Once propensity scores are transformed (e.g., into +#' weights), the result is no longer a propensity score. #' -#' **Boundary detection**: Values exactly at the boundaries (after truncation) -#' may indicate truncation, but aren't necessarily truncated - they could have -#' been at the boundary originally. +#' **Combining behavior**: Combining `ps_trunc` objects with `c()` requires +#' matching truncation parameters. Mismatched parameters produce a warning and +#' return a plain numeric vector. #' -#' **Combining behavior**: When combining `ps_trunc` objects with `c()`, -#' truncation parameters must match. Mismatched parameters trigger a warning -#' and return a numeric vector. +#' @return A `ps_trunc` object (a numeric vector for binary exposures, or a +#' matrix for categorical exposures). Use [ps_trunc_meta()] to inspect +#' metadata including `method`, `lower_bound`, `upper_bound`, and +#' `truncated_idx` (positions of modified values). #' -#' @return A **`ps_trunc`** object (numeric vector or matrix). It has an attribute -#' `ps_trunc_meta` storing fields like `method`, `lower_bound`, and -#' `upper_bound`. -#' @seealso [ps_trim()] and [ps_refit()] for removing extreme values vs. bounding +#' @seealso [ps_trim()] for removing (rather than bounding) extreme values, +#' [ps_refit()] for refitting the propensity model after trimming, +#' [is_ps_truncated()], [is_unit_truncated()], [ps_trunc_meta()] #' #' @examples #' set.seed(2) -#' n <- 30 +#' n <- 200 #' x <- rnorm(n) -#' z <- rbinom(n, 1, plogis(0.4 * x)) +#' z <- rbinom(n, 1, plogis(1.2 * x)) #' fit <- glm(z ~ x, family = binomial) #' ps <- predict(fit, type = "response") #' -#' # truncate just the 99th percentile -#' ps_trunc(ps, method = "pctl", lower = 0, upper = .99) -#' -#' # Coercion behavior with ps_trunc objects -#' ps_trunc1 <- ps_trunc(ps, method = "ps", lower = 0.1, upper = 0.9) -#' ps_trunc2 <- ps_trunc(ps, method = "ps", lower = 0.1, upper = 0.9) +#' # Truncate to [0.1, 0.9] +#' ps_t <- ps_trunc(ps, method = "ps", lower = 0.1, upper = 0.9) +#' ps_t #' -#' # Compatible objects combine silently -#' c(ps_trunc1[1:15], ps_trunc2[16:30]) # Returns ps_trunc object +#' # Truncate at the 1st and 99th percentiles +#' ps_trunc(ps, method = "pctl", lower = 0.01, upper = 0.99) #' -#' # Different truncation parameters trigger warning -#' ps_trunc3 <- ps_trunc(ps, method = "ps", lower = 0.2, upper = 0.8) -#' c(ps_trunc1[1:15], ps_trunc3[16:30]) # Warning: returns numeric +#' # Use truncated scores to calculate weights +#' wt_ate(ps_t, .exposure = z) #' -#' # Mixing with other propensity classes warns -#' ps_trim_obj <- ps_trim(ps[1:15], method = "ps", lower = 0.1) -#' c(ps_trunc1[1:15], ps_trim_obj) # Warning: returns numeric +#' # Inspect which observations were truncated +#' is_unit_truncated(ps_t) #' #' @export ps_trunc <- function( @@ -393,26 +391,48 @@ new_ps_trunc <- function(x, meta) { } } -#' @title Extract `ps_trunc` metadata -#' @description Returns the internal metadata list for a `ps_trunc` object. -#' @param x A **`ps_trunc`** object. -#' @return A named list of metadata. +#' Extract truncation metadata from a `ps_trunc` object +#' +#' @description Returns the metadata list attached to a [`ps_trunc`][ps_trunc()] +#' object. The list includes fields such as `method`, `lower_bound`, +#' `upper_bound`, and `truncated_idx`. +#' +#' @param x A `ps_trunc` object created by [ps_trunc()]. +#' @return A named list with truncation metadata, including: +#' * `method` -- the truncation method used (`"ps"`, `"pctl"`, or `"cr"`) +#' * `lower_bound`, `upper_bound` -- the applied bounds +#' * `truncated_idx` -- integer positions of values that were winsorized +#' +#' @seealso [ps_trunc()], [is_ps_truncated()], [is_unit_truncated()] +#' +#' @examples +#' ps <- c(0.02, 0.3, 0.5, 0.7, 0.98) +#' ps_t <- ps_trunc(ps, method = "ps", lower = 0.05, upper = 0.95) +#' ps_trunc_meta(ps_t) +#' #' @export ps_trunc_meta <- function(x) { attr(x, "ps_trunc_meta") } -#' Check if object is truncated +#' Test whether propensity scores have been truncated #' -#' @description `is_ps_truncated()` is an S3 generic that returns `TRUE` if its -#' argument represents a `ps_trunc` object or `psw` object created from -#' truncated propensity scores. `is_ps_truncated()` is a question about whether -#' the propensity scores *have* been truncated, as opposed to -#' [is_unit_truncated()], which is a question about which *units* have been -#' truncated. +#' @description `is_ps_truncated()` returns `TRUE` if `x` is a `ps_trunc` +#' object or a `psw` object derived from truncated propensity scores. +#' Use [is_unit_truncated()] to find out *which* observations were modified. #' #' @param x An object. -#' @return A logical scalar (`TRUE` or `FALSE`). +#' @return A single `TRUE` or `FALSE`. +#' +#' @seealso [ps_trunc()], [is_unit_truncated()], [ps_trunc_meta()] +#' +#' @examples +#' ps <- c(0.02, 0.3, 0.5, 0.7, 0.98) +#' is_ps_truncated(ps) +#' +#' ps_t <- ps_trunc(ps, method = "ps", lower = 0.05, upper = 0.95) +#' is_ps_truncated(ps_t) +#' #' @export is_ps_truncated <- function(x) { UseMethod("is_ps_truncated") @@ -433,16 +453,23 @@ is_ps_truncated.ps_trunc_matrix <- function(x) { TRUE } -#' Check if units have been truncated +#' Identify which units were truncated #' -#' @description `is_ps_truncated()` is an S3 generic that returns a vector of -#' `TRUE` or `FALSE`, representing if the element has been truncated. -#' [is_unit_truncated()] is a question about which *units* have been -#' truncated, as opposed to `is_ps_truncated()`, which is a question about -#' whether the propensity scores *have* been truncated. +#' @description `is_unit_truncated()` returns a logical vector indicating which +#' observations had their propensity scores modified by truncation. Use +#' [is_ps_truncated()] to test whether an object has been truncated at all. +#' +#' @param x A `ps_trunc` object created by [ps_trunc()]. +#' @return A logical vector the same length as `x` (or number of rows for +#' matrix input). `TRUE` marks observations whose values were winsorized. +#' +#' @seealso [ps_trunc()], [is_ps_truncated()], [ps_trunc_meta()] +#' +#' @examples +#' ps <- c(0.02, 0.3, 0.5, 0.7, 0.98) +#' ps_t <- ps_trunc(ps, method = "ps", lower = 0.05, upper = 0.95) +#' is_unit_truncated(ps_t) #' -#' @param x An object. -#' @return A logical vector. #' @export is_unit_truncated <- function(x) { UseMethod("is_unit_truncated") diff --git a/R/psw.R b/R/psw.R index d85c471..88c8619 100644 --- a/R/psw.R +++ b/R/psw.R @@ -1,79 +1,101 @@ -#' Create and Manipulate `psw` Objects +#' Propensity Score Weight Vectors #' -#' Functions to create and manipulate `psw` objects, which are specialized -#' vectors for propensity score weights with optional `estimand` attributes. -#' Most users should use [`wt_ate()`] and friends, but these functions can help -#' extend the functionality of `psw` objects. +#' @description +#' `psw` objects are numeric vectors that carry metadata about propensity score +#' weights, including the target estimand and whether the underlying propensity +#' scores were trimmed, truncated, or calibrated. +#' +#' Most users will encounter `psw` objects as return values from [wt_ate()] and +#' related weight functions. These constructor and helper functions are useful +#' for inspecting weight objects or for package developers extending propensity. +#' +#' @details +#' +#' ## Constructors +#' +#' * `psw()` is the **user-facing** constructor. It coerces `x` to double and +#' validates inputs before creating the object. +#' * `new_psw()` is the **low-level** constructor intended for developers. It +#' assumes `x` is already a double vector and performs minimal validation. +#' * `as_psw()` coerces an existing numeric vector to a `psw` object. +#' +#' ## Queries +#' +#' * `is_psw()` tests whether an object is a `psw` vector. +#' * `is_causal_wt()` tests whether an object inherits from the broader +#' `causal_wts` class (which includes `psw` objects). +#' * `estimand()` and `estimand<-` get and set the estimand attribute. +#' * `is_stabilized()` returns `TRUE` if the weights are stabilized. +#' +#' ## Arithmetic and combining +#' +#' Arithmetic operations on `psw` objects preserve the class and attributes, +#' so operations like normalization (`weights / sum(weights)`) retain metadata. +#' Combining `psw` objects with [c()] preserves the class only when all +#' metadata matches; mismatched metadata produces a warning and falls back to a +#' plain numeric vector. +#' +#' Subsetting with `[` preserves class and attributes. Summary functions +#' ([sum()], [mean()], etc.) return plain numeric values. #' #' @import vctrs #' @export #' -#' @param x A numeric vector (default: `double()`). -#' @param estimand A character string representing the estimand (e.g., "ate", -#' "att", "ato"). Default is `NULL`. -#' @param stabilized A logical `TRUE` -#' @param trimmed Logical, whether these weights came from a trimmed PS. -#' @param truncated Logical, whether these weights came from a truncated PS. -#' @param calibrated Logical, whether these weights came from a calibrated PS. -#' @param wt An object to check or convert. -#' @param value The value to add to the attribute. -#' @param ... Additional attributes to track in the weights. +#' @param x For `psw()` and `new_psw()`: a numeric vector of weights +#' (default: `double()`). For `is_psw()`, `is_causal_wt()`, and `as_psw()`: +#' an object to test or coerce. +#' @param estimand A character string identifying the target estimand (e.g., +#' `"ate"`, `"att"`, `"ato"`). Defaults to `NULL`. +#' @param stabilized Logical. Were the weights stabilized? Defaults to `FALSE`. +#' @param trimmed Logical. Were the weights derived from trimmed propensity +#' scores? Defaults to `FALSE`. +#' @param truncated Logical. Were the weights derived from truncated propensity +#' scores? Defaults to `FALSE`. +#' @param calibrated Logical. Were the weights derived from calibrated +#' propensity scores? Defaults to `FALSE`. +#' @param wt A `psw` or `causal_wts` object. +#' @param value A character string: the new estimand to assign. +#' @param ... Additional attributes stored on the object (developer use only). +#' #' @return -#' - `new_psw()`: A `psw` object. -#' - `psw()`: A `psw` object. -#' - `is_psw()`: `TRUE` if the object is a `psw`, otherwise `FALSE`. -#' - `as_psw()`: A `psw` object. -#' - `estimand()`: The `estimand` attribute of a `psw` object. -#' - `is_stabilized()`: The `stabilized` attribute of a `psw` object. +#' * `new_psw()`, `psw()`, `as_psw()`: A `psw` vector. +#' * `is_psw()`, `is_causal_wt()`, `is_stabilized()`: A single logical value. +#' * `estimand()`: A character string, or `NULL` if no estimand is set. +#' * `estimand<-`: The modified `psw` object (called for its side effect). #' -#' @details -#' The `psw` class is a vctrs-based S3 class that represents propensity score -#' weights. It extends numeric vectors with additional metadata tracking the -#' estimand type, stabilization status, and source transformations. +#' @seealso +#' [wt_ate()], [wt_att()], [wt_atu()], [wt_atm()], [wt_ato()] for +#' calculating propensity score weights (which return `psw` objects). #' -#' **Arithmetic behavior**: Unlike `ps_trim` and `ps_trunc` objects, arithmetic -#' operations on `psw` objects preserve the class and attributes. This allows -#' weight manipulations like normalization (`weights / sum(weights)`) while -#' maintaining metadata. +#' [ps_trim()], [ps_trunc()], and [ps_calibrate()] for modifying propensity +#' scores before weight calculation. #' -#' **Combining behavior**: When combining `psw` objects with `c()`, the class -#' is preserved only if all metadata matches. Mismatched metadata triggers a -#' warning and returns a numeric vector. +#' @examples +#' # Create psw objects directly +#' w <- psw(c(1.2, 0.8, 1.5), estimand = "ate") +#' w #' -#' **Base R compatibility**: Most base R operations work seamlessly: -#' - Subsetting with `[` preserves class and attributes -#' - Summary functions (`sum()`, `mean()`, etc.) return numeric values -#' - Comparison operators return logical vectors -#' - Works in data frames and with tidyverse functions +#' # Query metadata +#' is_psw(w) +#' estimand(w) +#' is_stabilized(w) #' -#' @examples -#' psw_weights <- new_psw(c(0.1, 0.2, 0.3), estimand = "ate") -#' is_psw(psw_weights) -#' estimand(psw_weights) +#' # Coerce a plain numeric vector +#' as_psw(c(1.0, 2.0), estimand = "att") #' -#' psw_helper <- psw(c(0.5, 0.7), estimand = "att") -#' as_psw(c(0.1, 0.2), estimand = "ato") +#' # Arithmetic preserves the psw class +#' w / sum(w) #' -#' # Coercion behavior - compatible objects combine silently -#' x <- psw(c(0.5, 0.7), estimand = "ate") -#' y <- psw(c(0.3, 0.8), estimand = "ate") -#' c(x, y) # Returns psw object +#' # Combining: compatible metadata is preserved +#' x <- psw(c(1.2, 0.8), estimand = "ate") +#' y <- psw(c(1.1, 0.9), estimand = "ate") +#' c(x, y) #' -#' # Incompatible metadata triggers warning and returns numeric -#' x <- psw(c(0.5, 0.7), estimand = "ate") -#' y <- psw(c(0.3, 0.8), estimand = "att") -#' c(x, y) # Warning: returns numeric +#' # Combining: incompatible metadata warns and returns numeric +#' x <- psw(c(1.2, 0.8), estimand = "ate") +#' y <- psw(c(1.1, 0.9), estimand = "att") +#' c(x, y) #' -#' # Works with tidyr::pivot_longer for plotting -#' if (requireNamespace("tidyr", quietly = TRUE)) { -#' df <- data.frame( -#' id = 1:4, -#' ate_wts = psw(c(0.5, 0.7, 0.3, 0.8), estimand = "ate"), -#' att_wts = psw(c(0.4, 0.6, 0.2, 0.9), estimand = "att") -#' ) -#' # This will warn but succeed, returning numeric in the pivoted column -#' tidyr::pivot_longer(df, cols = c(ate_wts, att_wts)) -#' } #' @import vctrs #' @name psw NULL diff --git a/R/weights.R b/R/weights.R index e6b8f83..5a03534 100644 --- a/R/weights.R +++ b/R/weights.R @@ -1,281 +1,239 @@ -#' Calculate Propensity Score Weights for Causal Inference +#' Calculate propensity score weights #' -#' @description This family of functions computes propensity score weights for -#' various causal estimands: +#' @description +#' Compute inverse probability weights for causal inference under different +#' estimands. Each function targets a different population: #' -#' - **ATE** (Average Treatment Effect) -#' - **ATT** (Average Treatment Effect on the Treated) -#' - **ATU** (Average Treatment Effect on the Untreated, sometimes called -#' the **ATC**, where the "C" stands for "control"). `wt_atc()` is provided -#' as an alias for `wt_atu()` -#' - **ATM** (Average Treatment Effect for the Evenly Matchable) -#' - **ATO** (Average Treatment Effect for the Overlap population) -#' - **Entropy** (Average Treatment Effect for the Entropy-weighted population) -#' - **Censoring weights** can be calculated using `wt_cens()`, which uses -#' the same formula as ATE weights but with estimand "uncensored". These -#' are useful for handling censoring in survival analysis +#' - `wt_ate()`: **Average Treatment Effect** -- the full population. +#' - `wt_att()`: **Average Treatment Effect on the Treated** -- the treated +#' (focal) group. +#' - `wt_atu()`: **Average Treatment Effect on the Untreated** -- the +#' untreated (reference) group. `wt_atc()` is an alias. +#' - `wt_atm()`: **Average Treatment Effect for the Evenly Matchable** -- +#' units with the most overlap. +#' - `wt_ato()`: **Average Treatment Effect for the Overlap Population** -- +#' weights proportional to overlap. +#' - `wt_entropy()`: **Entropy-weighted Average Treatment Effect** -- +#' an entropy-balanced population. +#' - `wt_cens()`: **Inverse probability of censoring weights** -- uses the +#' same formula as `wt_ate()` but labels the estimand `"uncensored"`. Use +#' these to adjust for censoring in survival analysis, not for treatment +#' weighting. #' -#' The propensity score can be provided as a numeric vector of predicted -#' probabilities, as a `data.frame` where each column represents the -#' predicted probability for a level of the exposure, or as a fitted -#' GLM object. They can also be propensity score objects created by -#' [ps_trim()], [ps_refit()], or [ps_trunc()] +#' `.propensity` accepts a numeric vector of predicted probabilities, a +#' `data.frame` of per-level probabilities, a fitted `glm` object, or a +#' modified propensity score created by [ps_trim()], [ps_trunc()], +#' [ps_refit()], or [ps_calibrate()]. #' -#' The returned weights are encapsulated in a `psw` object, which is a numeric -#' vector with additional attributes that record the estimand, and whether the -#' weights have been stabilized, trimmed, or truncated. +#' All functions return a [`psw`] object -- a numeric vector that tracks the +#' estimand, stabilization status, and any trimming or truncation applied. #' #' @details -#' ## Theoretical Background +#' ## Exposure types #' -#' 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. +#' All weight functions support binary exposures. `wt_ate()` and `wt_cens()` +#' also support continuous exposures. All except `wt_cens()` support +#' categorical exposures. #' -#' ## Mathematical Formulas +#' - **Binary**: `.exposure` is a two-level vector (e.g., 0/1, logical, or a +#' two-level factor). `.propensity` is a numeric vector of P(treatment | X). +#' - **Categorical**: `.exposure` is a factor or character vector with 3+ +#' levels. `.propensity` must be a matrix or data frame with one column per +#' level, where rows sum to 1. +#' - **Continuous**: `.exposure` is a numeric vector. `.propensity` is a +#' vector of conditional means (fitted values). Weights use a normal density +#' ratio; stabilization is strongly recommended. +#' - **Auto** (default): Detects the exposure type from `.exposure`. #' -#' ### 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}. +#' ## Stabilization #' -#' ### Categorical Exposures +#' Setting `stabilize = TRUE` multiplies the base weight by an estimate of +#' P(A) (binary) or f_A(A) (continuous), reducing variance. When no +#' `stabilization_score` is supplied, the marginal mean of `.exposure` is +#' used. Stabilization is supported for ATE and censoring weights +#' (`wt_ate()` and `wt_cens()`) and is strongly recommended for continuous +#' exposures. #' -#' For categorical treatments with \eqn{K} levels, weights use a tilting function approach: -#' \eqn{w_i = \frac{h(e_i)}{e_{i,Z_i}}}, where \eqn{e_{i,Z_i}} is the propensity score for unit \eqn{i}'s -#' observed treatment level, and \eqn{h(e_i)} is a tilting function that depends on the estimand: +#' ## Handling extreme weights #' -#' - **ATE**: \eqn{h(e) = 1} -#' - **ATT**: \eqn{h(e) = e_{focal}} (propensity score for the focal category) -#' - **ATU**: \eqn{h(e) = 1 - e_{focal}} (complement of focal category propensity) -#' - **ATM**: \eqn{h(e) = \min(e_1, ..., e_K)} -#' - **ATO**: \eqn{h(e) = 1 / \sum_k(1/e_k)} (reciprocal of harmonic mean denominator) -#' - **Entropy**: \eqn{h(e) = -\sum_k[e_k \cdot \log(e_k)]} (entropy of propensity scores) +#' Extreme weights signal positivity violations, poor model fit, or limited +#' overlap. You can address them by: #' -#' ## Exposure Types +#' - Choosing an overlap-focused estimand (`wt_ato()`, `wt_atm()`, +#' `wt_entropy()`), which down-weight units in regions of poor overlap. +#' - Trimming ([ps_trim()]) or truncating ([ps_trunc()]) propensity scores +#' before computing weights. +#' - Calibrating weights with [ps_calibrate()]. +#' - Stabilizing ATE weights (`stabilize = TRUE`). #' -#' The functions support different types of exposures: +#' See the [halfmoon](https://CRAN.R-project.org/package=halfmoon) package +#' for weight diagnostics and visualization. #' -#' - **`binary`**: For dichotomous treatments (e.g. 0/1). -#' - **`continuous`**: For numeric exposures. Here, weights are calculated via the normal density using -#' `dnorm()`. -#' - **`categorical`**: For exposures with more than 2 categories. Requires `.propensity` to be a -#' matrix or data frame with columns representing propensity scores for each category. -#' - **`auto`**: Automatically detects the exposure type based on `.exposure`. +#' ## Weight formulas #' -#' ## Stabilization +#' ### Binary exposures #' -#' 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 binary treatments (\eqn{A \in \{0, 1\}}), with propensity score +#' \eqn{e(X) = P(A=1 \mid X)}: #' -#' ## Weight Properties and Diagnostics +#' - **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 \log(e) + (1-e) \log(1-e)]} #' -#' Extreme weights can indicate: -#' - Positivity violations (near 0 or 1 propensity scores) -#' - Poor model specification -#' - Lack of overlap between treatment groups +#' ### Continuous exposures #' -#' See the halfmoon package for tools to diagnose and visualize weights. +#' Weights use the density ratio +#' \eqn{w = f_A(A) / f_{A|X}(A \mid X)}, where \eqn{f_A} is the marginal +#' density and \eqn{f_{A|X}} is the conditional density (both assumed +#' normal). Only `wt_ate()` and `wt_cens()` support continuous exposures. #' -#' 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. +#' ### Categorical exposures #' -#' ## Trimmed and Truncated Weights +#' For \eqn{K}-level treatments, weights take the tilting-function form +#' \eqn{w_i = h(\mathbf{e}_i) / e_{i,Z_i}}, where \eqn{e_{i,Z_i}} is the +#' propensity for unit \eqn{i}'s observed level and \eqn{h(\cdot)} depends +#' on the estimand: #' -#' 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. +#' - **ATE**: \eqn{h(\mathbf{e}) = 1} +#' - **ATT**: \eqn{h(\mathbf{e}) = e_{\text{focal}}} +#' - **ATU**: \eqn{h(\mathbf{e}) = 1 - e_{\text{focal}}} +#' - **ATM**: \eqn{h(\mathbf{e}) = \min(e_1, \ldots, e_K)} +#' - **ATO**: \eqn{h(\mathbf{e}) = \bigl(\sum_k 1/e_k\bigr)^{-1}} +#' - **Entropy**: \eqn{h(\mathbf{e}) = -\sum_k e_k \log(e_k)} #' -#' @param .propensity Either a numeric vector of predicted probabilities, a -#' `data.frame` where each column corresponds to a level of the exposure, -#' or a fitted GLM object. For data frames, the second column is used by -#' default for binary exposures unless specified otherwise with -#' `.propensity_col`. For GLM objects, fitted values are extracted -#' automatically. -#' @param .exposure The exposure variable. For binary exposures, a vector of 0s -#' and 1s; for continuous exposures, a numeric vector. When `.propensity` is -#' a GLM object, this argument is optional and will be extracted from the -#' model if not provided. -#' @param exposure_type Character string specifying the type of exposure. -#' Options are `"auto"`, `"binary"`, `"categorical"`, and `"continuous"`. -#' Defaults to `"auto"`, which detects the type automatically. -#' @param .sigma For continuous exposures, a numeric vector of standard errors -#' used with `dnorm()`. For example, this can be derived from the influence -#' measures of a model (e.g., `influence(model)$sigma`). +#' @param .propensity Propensity scores in one of several forms: +#' * A **numeric vector** of predicted probabilities (binary/continuous). +#' * A **data frame** or matrix with one column per exposure level +#' (categorical), or two columns for binary (see `.propensity_col`). +#' * A fitted **`glm`** object -- fitted values are extracted automatically. +#' * A modified propensity score created by [ps_trim()], [ps_trunc()], +#' [ps_refit()], or [ps_calibrate()]. +#' @param .exposure The exposure (treatment) variable. For binary exposures, a +#' numeric 0/1 vector, logical, or two-level factor. For categorical +#' exposures, a factor or character vector. For continuous exposures, a +#' numeric vector. Optional when `.propensity` is a `glm` object (extracted +#' from the model). +#' @param exposure_type Type of exposure: `"auto"` (default), `"binary"`, +#' `"categorical"`, or `"continuous"`. `"auto"` detects the type from +#' `.exposure`. +#' @param .sigma Numeric vector of observation-level standard deviations for +#' continuous exposures (e.g., `influence(model)$sigma`). Extracted +#' automatically when `.propensity` is a `glm` object. #' @param .treated `r lifecycle::badge("deprecated")` Use `.focal_level` instead. #' @param .untreated `r lifecycle::badge("deprecated")` Use `.reference_level` instead. -#' @param .focal_level For binary exposures, the value representing the focal group -#' (typically the treatment group). For categorical exposures with ATT or ATU estimands, -#' specifies the focal category. Must be one of the levels of the exposure variable. +#' @param .focal_level The value of `.exposure` representing the focal +#' (treated) group. For binary exposures, defaults to the higher value. #' Required for `wt_att()` and `wt_atu()` with categorical exposures. -#' @param .reference_level For binary exposures, the value representing the reference group -#' (typically the control group). If not provided, it is automatically detected. -#' @param ... Reserved for future expansion. Not currently used. -#' @param stabilize Logical indicating whether to stabilize the weights. For ATE -#' weights, stabilization multiplies the weight by either the mean of -#' `.exposure` or the supplied `stabilization_score`. Note: stabilization is only -#' supported for ATE and continuous exposures. -#' @param stabilization_score Optional numeric value for stabilizing the weights -#' (e.g., a predicted value from a regression model without predictors). Only -#' used when `stabilize` is `TRUE`. -#' @param .propensity_col With a binary exposure, when `.propensity` is a data frame, specifies which -#' column to use for propensity scores. Can be a column name (quoted or -#' unquoted) or a numeric index. Defaults to the second column if available, -#' otherwise the first. For categorical exposures, the entire data frame is -#' used as a matrix of propensity scores. +#' @param .reference_level The value of `.exposure` representing the reference +#' (control) group. Automatically detected if not supplied. +#' @param ... These dots are for future extensions and must be empty. +#' @param stabilize If `TRUE`, multiply weights by an estimate of the marginal +#' treatment probability (binary) or density (continuous). Only supported by +#' `wt_ate()` and `wt_cens()`. See **Stabilization** in Details. +#' @param stabilization_score Optional numeric value to use as the +#' stabilization multiplier instead of the default (the marginal mean of +#' `.exposure`). Ignored when `stabilize = FALSE`. +#' @param .propensity_col Column to use when `.propensity` is a data frame +#' with a binary exposure. Accepts a column name (quoted or unquoted) or +#' numeric index. Defaults to the second column. Ignored for categorical +#' exposures, where all columns are used. #' -#' @return A `psw` object (a numeric vector) with additional attributes: -#' - **estimand**: A description of the estimand (e.g., "ate", "att"). -#' - **stabilized**: A logical flag indicating if stabilization was applied. -#' - **trimmed**: A logical flag indicating if the weights are based on trimmed propensity scores. -#' - **truncated**: A logical flag indicating if the weights are based on truncated propensity scores. +#' @return A [`psw`] vector (a double vector with class `psw`) carrying +#' these attributes: +#' - `estimand`: character, e.g. `"ate"`, `"att"`, `"uncensored"`. +#' - `stabilized`: logical, whether stabilization was applied. +#' - `trimmed`: logical, whether the propensity scores were trimmed. +#' - `truncated`: logical, whether the propensity scores were truncated. +#' - `calibrated`: logical, whether the propensity scores were calibrated. #' #' @examples -#' ## Basic Usage with Binary Exposures -#' -#' # Simulate a simple dataset +#' # -- Binary exposure, numeric propensity scores ---------------------- #' set.seed(123) -#' n <- 100 -#' propensity_scores <- runif(n, 0.1, 0.9) -#' treatment <- rbinom(n, 1, propensity_scores) +#' ps <- runif(100, 0.1, 0.9) +#' trt <- rbinom(100, 1, ps) #' -#' # 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) +#' wt_ate(ps, trt) +#' wt_att(ps, trt) +#' wt_atu(ps, trt) +#' wt_atm(ps, trt) +#' wt_ato(ps, trt) +#' wt_entropy(ps, trt) #' -#' # With explicit focal and reference levels -#' weights_att_explicit <- wt_att(propensity_scores, treatment, -#' .focal_level = 1, .reference_level = 0) -#' weights_atm <- wt_atm(propensity_scores, treatment) -#' weights_ato <- wt_ato(propensity_scores, treatment) -#' weights_entropy <- wt_entropy(propensity_scores, treatment) +#' # Stabilized ATE weights (reduces variance) +#' wt_ate(ps, trt, stabilize = TRUE) #' -#' # Compare weight distributions -#' summary(weights_ate) -#' summary(weights_ato) # Often more stable than ATE +#' # Inspect the result +#' w <- wt_ate(ps, trt) +#' estimand(w) +#' summary(w) #' -#' ## Stabilized Weights -#' -#' # Stabilization reduces variance -#' weights_ate_stab <- wt_ate(propensity_scores, treatment, stabilize = TRUE) -#' -#' ## Handling Extreme Propensity Scores -#' -#' # Create data with positivity violations +#' # -- Overlap-focused estimands handle extreme PS better -------------- #' 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) +#' max(wt_ate(ps_extreme, trt_extreme)) +#' max(wt_ato(ps_extreme, trt_extreme)) #' -#' # ATO weights are bounded -#' wt_extreme_ato <- wt_ato(ps_extreme, trt_extreme) -#' # Much more reasonable -#' max(wt_extreme_ato) -#' # but they target a different population -#' estimand(wt_extreme_ato) # "ato" +#' # -- From a fitted GLM ----------------------------------------------- +#' x1 <- rnorm(100) +#' x2 <- rnorm(100) +#' trt2 <- rbinom(100, 1, plogis(0.5 * x1 + 0.3 * x2)) +#' ps_model <- glm(trt2 ~ x1 + x2, family = binomial) #' -#' ## Working with Data Frames +#' # Exposure is extracted from the model automatically +#' wt_ate(ps_model) #' -#' # Example with custom data frame +#' # -- Data frame input ------------------------------------------------ #' ps_df <- data.frame( #' control = c(0.9, 0.7, 0.3, 0.1), #' treated = c(0.1, 0.3, 0.7, 0.9) #' ) #' exposure <- c(0, 0, 1, 1) -#' -#' # Uses second column by default (treated probabilities) #' wt_ate(ps_df, exposure) -#' -#' # Explicitly specify column by name #' wt_ate(ps_df, exposure, .propensity_col = "treated") #' -#' # Or by position -#' wt_ate(ps_df, exposure, .propensity_col = 2) -#' -#' ## Working with GLM Objects -#' -#' # Fit a propensity score model -#' set.seed(123) -#' n <- 100 -#' x1 <- rnorm(n) -#' x2 <- rnorm(n) -#' treatment <- rbinom(n, 1, plogis(0.5 * x1 + 0.3 * x2)) -#' -#' ps_model <- glm(treatment ~ x1 + x2, family = binomial) -#' -#' # Use GLM directly for weight calculation -#' weights_from_glm <- wt_ate(ps_model, treatment) -#' -#' # Or omit the exposure argument (it will be extracted from the GLM) -#' weights_from_glm_auto <- wt_ate(ps_model) +#' # -- Censoring weights ----------------------------------------------- +#' cens_ps <- runif(50, 0.6, 0.95) +#' cens_ind <- rbinom(50, 1, cens_ps) +#' wt_cens(cens_ps, cens_ind) +#' estimand(wt_cens(cens_ps, cens_ind)) # "uncensored" #' #' @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 +#' Barrett, M., D'Agostino McGowan, L., & Gerke, T. *Causal Inference in R*. +#' \url{https://www.r-causal.org/} #' #' 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 +#' score in observational studies for causal effects. *Biometrika*, 70(1), +#' 41--55. #' #' 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) +#' propensity score analysis. *The International Journal of Biostatistics*, +#' 9(2), 215--234. (ATM weights) #' #' 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) +#' propensity score weighting. *Journal of the American Statistical +#' Association*, 113(521), 390--400. (ATO weights) #' #' 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) -#' -#' ## Continuous Exposures +#' Medical Research*, 29(12), 3721--3756. (Entropy weights) #' #' 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. -#' -#' ## Practical Guidance +#' treatments. In *Applied Bayesian Modeling and Causal Inference from +#' Incomplete-Data Perspectives* (pp. 73--84). #' #' 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. +#' using inverse probability of treatment weighting (IPTW). *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. +#' * [psw()] for the returned weight vector class. +#' * [ps_trim()], [ps_trunc()], [ps_refit()], and [ps_calibrate()] for +#' modifying propensity scores before weighting. +#' * [ipw()] for inverse-probability-weighted estimation of causal effects. #' #' @export wt_ate <- function( diff --git a/README.Rmd b/README.Rmd index c6742df..93a3ef8 100644 --- a/README.Rmd +++ b/README.Rmd @@ -11,7 +11,7 @@ knitr::opts_chunk$set( fig.path = "man/figures/README-", out.width = "100%" ) -set.seed(1234) +set.seed(123) ``` # propensity @@ -21,7 +21,7 @@ set.seed(1234) [![Codecov test coverage](https://codecov.io/gh/r-causal/propensity/graph/badge.svg)](https://app.codecov.io/gh/r-causal/propensity) -propensity provides a comprehensive toolkit for propensity score analysis in causal inference. The package supports multiple estimands, handles extreme weights, and provides statistically valid inference through inverse probability weighting. +propensity provides a toolkit for propensity score analysis in causal inference. It supports multiple causal estimands across binary, categorical, and continuous exposures, handles extreme propensity scores through trimming, truncation, and calibration, and estimates causal effects with valid standard errors via inverse probability weighting. ## Installation @@ -31,174 +31,191 @@ You can install propensity from [CRAN](https://cran.r-project.org/) with: install.packages("propensity") ``` -You can install the development version of propensity from [GitHub](https://github.com/) with: +You can install the development version of propensity from [GitHub](https://github.com/r-causal/propensity) with: ``` r -# install.packages("devtools") -devtools::install_github("r-causal/propensity") +# install.packages("pak") +pak::pak("r-causal/propensity") ``` ## Quick Start -Here's a complete workflow for causal effect estimation: +Estimate a causal effect in three steps: -```{r quick-start} +```{r quick-start, message = FALSE, warning = FALSE} library(propensity) -# Simulate data with confounding +# Simulate data with a confounder, binary exposure, and binary outcome n <- 200 x1 <- rnorm(n) -x2 <- rnorm(n) -treatment <- rbinom(n, 1, plogis(0.5 * x1 - 0.3 * x2)) -outcome <- rbinom(n, 1, plogis(1 + 0.8 * treatment + 0.5 * x1 - 0.3 * x2)) +z <- rbinom(n, 1, plogis(0.5 * x1)) +y <- rbinom(n, 1, plogis(-0.5 + 0.8 * z + 0.3 * x1)) +dat <- data.frame(x1, z, y) -# Fit propensity score model -ps_model <- glm(treatment ~ x1 + x2, family = binomial()) +# Step 1: Fit a propensity score model +ps_mod <- glm(z ~ x1, data = dat, family = binomial()) -# Calculate ATE weights -wts <- wt_ate(ps_model) +# Step 2: Calculate ATE weights and fit a weighted outcome model +wts <- wt_ate(ps_mod) +outcome_mod <- glm(y ~ z, data = dat, family = binomial(), weights = wts) -# Fit weighted outcome model -outcome_model <- glm(outcome ~ treatment, family = binomial(), weights = wts) - -# Get causal effect estimates with correct standard errors -ipw(ps_model, outcome_model) +# Step 3: Estimate causal effects with correct standard errors +ipw(ps_mod, outcome_mod) ``` -The `ipw()` function accounts for uncertainty in propensity score estimation, providing valid confidence intervals and p-values. +`ipw()` performs inverse probability weighted estimation. It accounts for uncertainty in the estimated propensity scores when computing standard errors, producing valid confidence intervals and p-values. ## Multiple Estimands -propensity supports six different causal estimands: +propensity supports six causal estimands for binary exposures: -```{r estimands} -ps <- predict(ps_model, type = "response") +```{r estimands, eval = FALSE} +ps <- fitted(ps_mod) -wt_ate(ps, treatment) # Average Treatment Effect -wt_att(ps, treatment) # Average Treatment Effect on the Treated -wt_atu(ps, treatment) # Average Treatment Effect on the Untreated -wt_ato(ps, treatment) # Average Treatment Effect in Overlap population -wt_atm(ps, treatment) # Average Treatment Effect in Matched population -wt_entropy(ps, treatment) # Entropy-weighted ATE +wt_ate(ps, z) # Average Treatment Effect +wt_att(ps, z) # Average Treatment Effect on the Treated +wt_atu(ps, z) # Average Treatment Effect on the Untreated +wt_ato(ps, z) # Average Treatment Effect, Overlap population +wt_atm(ps, z) # Average Treatment Effect, Matched population +wt_entropy(ps, z) # Entropy-weighted ATE ``` Choose your estimand based on your research question: -- **ATE**: Effect in the entire population -- **ATT**: Effect among those who received treatment -- **ATU/ATC**: Effect among those who didn't receive treatment -- **ATO**: Effect in the population with most overlap (more stable weights) -- **ATM**: Effect in a matched population -- **Entropy**: Balances efficiency and overlap -## Flexible Input Formats +| Estimand | Target population | Function | +|----------|-------------------|----------| +| **ATE** | Entire population | `wt_ate()` | +| **ATT** | Treated units | `wt_att()` | +| **ATU** | Untreated units | `wt_atu()` (alias: `wt_atc()`) | +| **ATO** | Overlap population -- units with the most equipoise between groups | `wt_ato()` | +| **ATM** | Matched population -- mimics 1:1 matching | `wt_atm()` | +| **Entropy** | Entropy-balanced compromise between ATE and overlap | `wt_entropy()` | + +ATO and ATM produce naturally bounded weights, making them good alternatives when ATE weights are highly variable. -propensity accepts propensity scores in multiple formats: +## Flexible Input + +Weight functions accept propensity scores in several forms: ```{r inputs, eval = FALSE} -# Numeric vector -wt_ate(ps, treatment) +# GLM object -- extracts fitted values and exposure automatically (recommended) +wt_ate(ps_mod) -# Data frame (uses second column by default for treatment probability) -ps_df <- data.frame(control = 1 - ps, treated = ps) -wt_ate(ps_df, treatment) +# Numeric vector of propensity scores +wt_ate(ps, z) -# GLM object directly (extracts fitted values automatically) -wt_ate(ps_model) +# Data frame of class probabilities (e.g., from multinomial models) +ps_df <- data.frame(control = 1 - ps, treated = ps) +wt_ate(ps_df, z) ``` ## Handling Extreme Weights -Extreme propensity scores (near 0 or 1) can lead to unstable weights. propensity offers several solutions: +Propensity scores near 0 or 1 produce extreme weights that inflate variance. propensity offers four complementary strategies: + +1. **Switch estimand** -- `wt_ato()` and `wt_atm()` produce bounded weights by design. +2. **Trim** -- remove observations with extreme scores (sets them to `NA`). +3. **Truncate** -- winsorize extreme scores to a fixed range. +4. **Calibrate** -- adjust scores so they better reflect true treatment probabilities. -```{r extreme-weights} -# Check for extreme weights -summary(wt_ate(ps, treatment)) +```{r extreme-weights, message = FALSE, warning = FALSE} +ps <- fitted(ps_mod) -# Solution 1: Use overlap-weighted estimand (bounded weights) -summary(wt_ato(ps, treatment)) +# Diagnose: inspect the weight distribution +summary(wt_ate(ps, z)) -# Solution 2: Trim extreme propensity scores +# 1. Switch estimand -- overlap weights are bounded by design +summary(wt_ato(ps, z)) + +# 2. Trim -- remove observations with extreme propensity scores ps_trimmed <- ps_trim(ps, method = "adaptive") -summary(wt_ate(ps_trimmed, treatment)) +summary(wt_ate(ps_trimmed, z)) -# Solution 3: Truncate propensity scores +# 3. Truncate -- bound extreme propensity scores to a range ps_truncated <- ps_trunc(ps, lower = 0.05, upper = 0.95) -summary(wt_ate(ps_truncated, treatment)) +summary(wt_ate(ps_truncated, z)) -# Solution 4: Calibrate propensity scores -ps_calibrated <- ps_calibrate(ps, treatment) -summary(wt_ate(ps_calibrated, treatment)) +# 4. Calibrate -- adjust scores to better reflect true probabilities +ps_calibrated <- ps_calibrate(ps, z) +summary(wt_ate(ps_calibrated, z)) ``` -After trimming, you can refit the propensity score model on the retained subset: +After trimming, refit the propensity score model on the retained subset so the scores reflect the trimmed population: ```{r refit, eval = FALSE} -ps_refitted <- ps_refit(ps_trimmed, ps_model) -wts_refitted <- wt_ate(ps_refitted, treatment) +ps_refitted <- ps_refit(ps_trimmed, ps_mod) +wts_refitted <- wt_ate(ps_refitted, z) ``` ## Advanced Features ### Weight Stabilization -Stabilized weights can reduce variance for ATE estimation: +Stabilized weights can reduce variance. Stabilization is supported for `wt_ate()` and `wt_cens()`: -```{r stabilization} -wt_ate(ps, treatment, stabilize = TRUE) +```{r stabilization, message = FALSE} +summary(wt_ate(ps, z, stabilize = TRUE)) ``` ### Continuous Exposures -For continuous treatments, propensity scores represent conditional densities: +For continuous treatments, weights use the ratio of the marginal to conditional density. Stabilization is strongly recommended: ```{r continuous, eval = FALSE} -# Fit linear model for continuous treatment -continuous_treatment <- rnorm(n, mean = 0.5 * x1 - 0.3 * x2) -ps_continuous <- lm(continuous_treatment ~ x1 + x2) - -# Density-based weights -wts_continuous <- wt_ate( - ps_continuous, - continuous_treatment, - exposure_type = "continuous", - # stabilization is highly recommended for continuous exposures - stabilize = TRUE -) +# Fit a model for the continuous exposure +continuous_exposure <- rnorm(n, mean = 0.5 * x1) +dat$a <- continuous_exposure +ps_continuous <- glm(a ~ x1, data = dat, family = gaussian()) + +# Density-ratio weights (stabilization strongly recommended) +wts_continuous <- wt_ate(ps_continuous, stabilize = TRUE) ``` ### Categorical Exposures -For multi-level treatments, provide a data frame or matrix of propensity scores: +For multi-level treatments, supply a matrix or data frame of class probabilities with one column per treatment level: ```{r categorical, eval = FALSE} -# Multinomial propensity scores (3 treatment levels) +# Multinomial propensity scores (one column per treatment level) ps_matrix <- matrix(c(0.3, 0.5, 0.2), ncol = 3, nrow = n, byrow = TRUE) -categorical_treatment <- factor(sample(1:3, n, replace = TRUE)) +categorical_exposure <- factor(sample(1:3, n, replace = TRUE)) -wt_ate(ps_matrix, categorical_treatment, exposure_type = "categorical") +wt_ate(ps_matrix, categorical_exposure, exposure_type = "categorical") -# For ATT, specify focal level -wt_att(ps_matrix, categorical_treatment, .focal_level = "2") +# For ATT with categorical exposures, specify the focal level +wt_att(ps_matrix, categorical_exposure, .focal_level = "2") ``` ### Censoring Weights -Combine treatment and censoring weights for survival or longitudinal analyses: +`wt_cens()` calculates inverse probability of censoring weights for survival or longitudinal analyses. These address informative censoring -- not treatment assignment: ```{r censoring, eval = FALSE} -# Propensity of being uncensored -censoring_ps <- predict( - glm(uncensored ~ x1 + x2, family = binomial()), - type = "response" -) +# Model the probability of being uncensored +cens_mod <- glm(uncensored ~ x1 + x2, data = dat, family = binomial()) + +# Censoring weights (uses the same formula as wt_ate()) +wts_cens <- wt_cens(cens_mod) + +# Combine with treatment weights for a doubly-weighted analysis +wts_combined <- wt_ate(ps_mod) * wts_cens +``` + +### Calibration Methods + +`ps_calibrate()` supports two calibration methods: -# Censoring weights -wts_cens <- wt_cens(censoring_ps, uncensored) +```{r calibration, eval = FALSE} +# Logistic calibration (default) -- fits a logistic regression of exposure on +# predicted propensity scores +ps_calibrate(ps, z, method = "logistic") -# Combine with treatment weights -wts_combined <- wt_ate(ps, treatment) * wts_cens +# Isotonic regression calibration -- fits a monotone step function; useful for +# non-smooth relationships with large samples +ps_calibrate(ps, z, method = "isoreg") ``` ## Learn More -- [Causal Inference in R](https://www.r-causal.org/) - Comprehensive guide to causal inference methods in R +- [propensity package documentation](https://r-causal.github.io/propensity/) -- Full reference and articles +- [Causal Inference in R](https://www.r-causal.org/) -- A comprehensive guide to causal inference methods in R diff --git a/README.md b/README.md index 3aae522..73f8f47 100644 --- a/README.md +++ b/README.md @@ -10,10 +10,11 @@ coverage](https://codecov.io/gh/r-causal/propensity/graph/badge.svg)](https://app.codecov.io/gh/r-causal/propensity) -propensity provides a comprehensive toolkit for propensity score -analysis in causal inference. The package supports multiple estimands, -handles extreme weights, and provides statistically valid inference -through inverse probability weighting. +propensity provides a toolkit for propensity score analysis in causal +inference. It supports multiple causal estimands across binary, +categorical, and continuous exposures, handles extreme propensity scores +through trimming, truncation, and calibration, and estimates causal +effects with valid standard errors via inverse probability weighting. ## Installation @@ -25,443 +26,235 @@ install.packages("propensity") ``` You can install the development version of propensity from -[GitHub](https://github.com/) with: +[GitHub](https://github.com/r-causal/propensity) with: ``` r -# install.packages("devtools") -devtools::install_github("r-causal/propensity") +# install.packages("pak") +pak::pak("r-causal/propensity") ``` ## Quick Start -Here’s a complete workflow for causal effect estimation: +Estimate a causal effect in three steps: ``` r library(propensity) -# Simulate data with confounding +# Simulate data with a confounder, binary exposure, and binary outcome n <- 200 x1 <- rnorm(n) -x2 <- rnorm(n) -treatment <- rbinom(n, 1, plogis(0.5 * x1 - 0.3 * x2)) -outcome <- rbinom(n, 1, plogis(1 + 0.8 * treatment + 0.5 * x1 - 0.3 * x2)) +z <- rbinom(n, 1, plogis(0.5 * x1)) +y <- rbinom(n, 1, plogis(-0.5 + 0.8 * z + 0.3 * x1)) +dat <- data.frame(x1, z, y) -# Fit propensity score model -ps_model <- glm(treatment ~ x1 + x2, family = binomial()) +# Step 1: Fit a propensity score model +ps_mod <- glm(z ~ x1, data = dat, family = binomial()) -# Calculate ATE weights -wts <- wt_ate(ps_model) -#> ℹ Using exposure variable "treatment" from GLM model -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 +# Step 2: Calculate ATE weights and fit a weighted outcome model +wts <- wt_ate(ps_mod) +outcome_mod <- glm(y ~ z, data = dat, family = binomial(), weights = wts) -# Fit weighted outcome model -outcome_model <- glm(outcome ~ treatment, family = binomial(), weights = wts) -#> Warning in eval(family$initialize): non-integer #successes in a binomial glm! - -# Get causal effect estimates with correct standard errors -ipw(ps_model, outcome_model) +# Step 3: Estimate causal effects with correct standard errors +ipw(ps_mod, outcome_mod) #> Inverse Probability Weight Estimator #> Estimand: ATE #> #> Propensity Score Model: -#> Call: glm(formula = treatment ~ x1 + x2, family = binomial()) +#> Call: glm(formula = z ~ x1, family = binomial(), data = dat) #> #> Outcome Model: -#> Call: glm(formula = outcome ~ treatment, family = binomial(), weights = wts) +#> Call: glm(formula = y ~ z, family = binomial(), data = dat, weights = wts) #> #> Estimates: -#> estimate std.err z ci.lower ci.upper conf.level p.value -#> rd 0.074863 0.051824 1.444570 -0.0267 0.17643 0.95 0.14858 -#> log(rr) 0.091501 0.057897 1.580417 -0.0220 0.20498 0.95 0.11401 -#> log(or) 0.510526 0.220945 2.310648 0.0775 0.94357 0.95 0.02085 * +#> estimate std.err z ci.lower ci.upper conf.level p.value +#> rd 0.14230 0.07038 2.02194 0.0044 0.28025 0.95 0.0431831 * +#> log(rr) 0.28031 0.10770 2.60262 0.0692 0.49141 0.95 0.0092513 ** +#> log(or) 0.57339 0.16200 3.53950 0.2559 0.89090 0.95 0.0004009 *** #> --- #> Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ``` -The `ipw()` function accounts for uncertainty in propensity score -estimation, providing valid confidence intervals and p-values. +`ipw()` performs inverse probability weighted estimation. It accounts +for uncertainty in the estimated propensity scores when computing +standard errors, producing valid confidence intervals and p-values. ## Multiple Estimands -propensity supports six different causal estimands: +propensity supports six causal estimands for binary exposures: ``` r -ps <- predict(ps_model, type = "response") - -wt_ate(ps, treatment) # Average Treatment Effect -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 -#> -#> [1] 1.470779 2.068930 1.546098 1.232231 1.820995 2.024578 1.344924 1.495716 -#> [9] 2.217640 2.193364 1.715910 1.801797 3.732186 3.503668 1.438201 1.868097 -#> [17] 1.922443 2.079571 1.834538 1.332966 1.788833 1.633368 1.301630 1.821102 -#> [25] 1.679110 2.399182 1.380026 1.473493 1.646620 1.626722 1.424301 2.003376 -#> [33] 1.829952 2.225673 1.407329 1.988122 1.605516 1.623829 2.053488 2.510054 -#> [41] 1.423668 1.524282 1.829257 1.691047 1.471506 2.674584 1.327642 3.093271 -#> [49] 2.330734 2.314127 1.350606 3.005055 2.984867 1.478913 1.563689 2.809816 -#> [57] 1.749273 2.337510 3.332681 2.991772 1.998441 1.194681 2.024361 1.547311 -#> [65] 1.953848 4.967949 1.689181 5.093562 1.527294 2.021179 2.305803 3.698911 -#> [73] 2.485525 1.989953 2.271353 1.706920 1.366111 1.479168 1.772592 2.223966 -#> [81] 2.658169 1.821960 1.758813 1.696490 1.384585 2.399317 1.443507 2.021727 -#> [89] 1.469493 1.561712 2.461594 2.180753 1.155001 1.388714 1.393119 1.573849 -#> [97] 1.926909 1.468325 2.593163 3.977904 2.848188 1.725918 2.269394 1.532868 -#> [105] 2.392849 1.597024 1.889476 1.570240 2.680789 1.761019 1.503138 1.645602 -#> [113] 1.763572 1.555643 1.694603 2.026177 1.624535 2.699905 3.101536 2.510389 -#> [121] 2.052995 1.734747 1.234539 1.280988 1.342521 1.605403 3.080384 1.793828 -#> [129] 1.469570 1.578528 1.596617 2.192363 1.773740 2.232075 1.489021 1.628306 -#> [137] 2.082229 1.185081 1.492569 1.837623 2.033960 1.496145 2.000751 2.623126 -#> [145] 2.408770 1.798632 1.255588 1.251283 1.542644 1.578020 3.776381 2.103042 -#> [153] 1.256482 2.269634 3.556495 1.559996 3.477468 1.977787 1.748482 1.361639 -#> [161] 1.460139 1.393987 2.104371 1.910747 1.561723 1.791428 1.197745 1.937296 -#> [169] 2.030522 2.190334 4.712759 3.362976 1.844335 3.292583 1.281848 2.475882 -#> [177] 2.414548 1.127966 1.995835 2.294861 2.579686 4.774356 1.401574 2.426269 -#> [185] 2.224822 1.553441 1.763196 2.352843 1.298357 1.918415 1.395278 1.801854 -#> [193] 1.931121 1.862172 1.361941 1.992374 2.257764 1.521538 2.218199 1.578212 -wt_att(ps, treatment) # Average Treatment Effect on the Treated -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 -#> -#> [1] 0.4707789 1.0000000 1.0000000 0.2322311 1.0000000 1.0245778 0.3449241 -#> [8] 0.4957157 1.0000000 1.1933637 0.7159101 0.8017975 1.0000000 2.5036682 -#> [15] 1.0000000 0.8680975 0.9224426 1.0000000 0.8345383 1.0000000 0.7888328 -#> [22] 0.6333681 0.3016302 0.8211016 0.6791099 1.0000000 0.3800259 0.4734925 -#> [29] 1.0000000 0.6267215 1.0000000 1.0000000 1.0000000 1.0000000 0.4073285 -#> [36] 1.0000000 1.0000000 0.6238288 1.0000000 1.0000000 1.0000000 0.5242825 -#> [43] 1.0000000 0.6910469 0.4715061 1.0000000 0.3276415 1.0000000 1.0000000 -#> [50] 1.0000000 0.3506062 1.0000000 1.0000000 0.4789134 1.0000000 1.8098161 -#> [57] 1.0000000 1.3375095 2.3326810 1.0000000 1.0000000 1.0000000 1.0243608 -#> [64] 1.0000000 0.9538478 3.9679493 0.6891813 4.0935618 1.0000000 1.0000000 -#> [71] 1.3058033 1.0000000 1.0000000 1.0000000 1.2713535 1.0000000 0.3661107 -#> [78] 0.4791676 1.0000000 1.0000000 1.6581689 0.8219595 0.7588134 0.6964897 -#> [85] 1.0000000 1.3993170 1.0000000 1.0217275 1.0000000 0.5617123 1.0000000 -#> [92] 1.1807528 1.0000000 1.0000000 0.3931187 0.5738490 1.0000000 1.0000000 -#> [99] 1.5931634 2.9779037 1.8481879 1.0000000 1.2693943 0.5328683 1.0000000 -#> [106] 1.0000000 0.8894758 0.5702399 1.6807891 0.7610191 0.5031375 0.6456016 -#> [113] 0.7635718 1.0000000 1.0000000 1.0000000 0.6245350 1.0000000 2.1015358 -#> [120] 1.5103891 1.0000000 0.7347466 1.0000000 1.0000000 1.0000000 1.0000000 -#> [127] 1.0000000 0.7938279 0.4695699 1.0000000 1.0000000 1.0000000 0.7737400 -#> [134] 1.2320755 0.4890211 1.0000000 1.0822290 0.1850811 1.0000000 1.0000000 -#> [141] 1.0000000 1.0000000 1.0007510 1.0000000 1.4087699 0.7986321 1.0000000 -#> [148] 1.0000000 1.0000000 1.0000000 2.7763806 1.0000000 1.0000000 1.0000000 -#> [155] 2.5564948 1.0000000 1.0000000 0.9777871 0.7484818 0.3616386 0.4601392 -#> [162] 0.3939866 1.0000000 1.0000000 1.0000000 0.7914278 1.0000000 0.9372959 -#> [169] 1.0000000 1.0000000 3.7127593 2.3629759 0.8443348 1.0000000 1.0000000 -#> [176] 1.0000000 1.0000000 1.0000000 1.0000000 1.2948611 1.0000000 3.7743558 -#> [183] 1.0000000 1.0000000 1.2248219 1.0000000 1.0000000 1.0000000 1.0000000 -#> [190] 0.9184152 0.3952778 1.0000000 1.0000000 0.8621715 1.0000000 1.0000000 -#> [197] 1.2577643 0.5215382 1.2181988 0.5782116 -wt_atu(ps, treatment) # Average Treatment Effect on the Untreated -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 -#> -#> [1] 1.0000000 1.0689304 0.5460976 1.0000000 0.8209947 1.0000000 1.0000000 -#> [8] 1.0000000 1.2176401 1.0000000 1.0000000 1.0000000 2.7321864 1.0000000 -#> [15] 0.4382010 1.0000000 1.0000000 1.0795713 1.0000000 0.3329662 1.0000000 -#> [22] 1.0000000 1.0000000 1.0000000 1.0000000 1.3991825 1.0000000 1.0000000 -#> [29] 0.6466199 1.0000000 0.4243007 1.0033757 0.8299522 1.2256735 1.0000000 -#> [36] 0.9881219 0.6055160 1.0000000 1.0534882 1.5100543 0.4236685 1.0000000 -#> [43] 0.8292569 1.0000000 1.0000000 1.6745844 1.0000000 2.0932708 1.3307338 -#> [50] 1.3141266 1.0000000 2.0050554 1.9848665 1.0000000 0.5636887 1.0000000 -#> [57] 0.7492731 1.0000000 1.0000000 1.9917719 0.9984414 0.1946807 1.0000000 -#> [64] 0.5473114 1.0000000 1.0000000 1.0000000 1.0000000 0.5272941 1.0211792 -#> [71] 1.0000000 2.6989113 1.4855253 0.9899526 1.0000000 0.7069204 1.0000000 -#> [78] 1.0000000 0.7725923 1.2239660 1.0000000 1.0000000 1.0000000 1.0000000 -#> [85] 0.3845848 1.0000000 0.4435067 1.0000000 0.4694926 1.0000000 1.4615940 -#> [92] 1.0000000 0.1550010 0.3887143 1.0000000 1.0000000 0.9269090 0.4683251 -#> [99] 1.0000000 1.0000000 1.0000000 0.7259181 1.0000000 1.0000000 1.3928486 -#> [106] 0.5970239 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 -#> [113] 1.0000000 0.5556430 0.6946028 1.0261769 1.0000000 1.6999054 1.0000000 -#> [120] 1.0000000 1.0529954 1.0000000 0.2345394 0.2809878 0.3425212 0.6054034 -#> [127] 2.0803840 1.0000000 1.0000000 0.5785281 0.5966166 1.1923627 1.0000000 -#> [134] 1.0000000 1.0000000 0.6283059 1.0000000 1.0000000 0.4925693 0.8376227 -#> [141] 1.0339600 0.4961454 1.0000000 1.6231258 1.0000000 1.0000000 0.2555875 -#> [148] 0.2512830 0.5426442 0.5780203 1.0000000 1.1030419 0.2564823 1.2696343 -#> [155] 1.0000000 0.5599957 2.4774683 1.0000000 1.0000000 1.0000000 1.0000000 -#> [162] 1.0000000 1.1043710 0.9107475 0.5617230 1.0000000 0.1977453 1.0000000 -#> [169] 1.0305221 1.1903341 1.0000000 1.0000000 1.0000000 2.2925834 0.2818475 -#> [176] 1.4758820 1.4145480 0.1279665 0.9958348 1.0000000 1.5796862 1.0000000 -#> [183] 0.4015740 1.4262688 1.0000000 0.5534408 0.7631955 1.3528431 0.2983569 -#> [190] 1.0000000 1.0000000 0.8018540 0.9311206 1.0000000 0.3619412 0.9923737 -#> [197] 1.0000000 1.0000000 1.0000000 1.0000000 -wt_ato(ps, treatment) # Average Treatment Effect in Overlap population -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 -#> -#> [1] 0.3200881 0.5166585 0.3532103 0.1884639 0.4508496 0.5060699 0.2564636 -#> [8] 0.3314237 0.5490702 0.5440793 0.4172189 0.4449987 0.7320605 0.7145848 -#> [15] 0.3046869 0.4646960 0.4798284 0.5191316 0.4549037 0.2497934 0.4409763 -#> [22] 0.3877681 0.2317326 0.4508818 0.4044464 0.5831914 0.2753759 0.3213403 -#> [29] 0.3926953 0.3852666 0.2979010 0.5008425 0.4535376 0.5506978 0.2894339 -#> [36] 0.4970127 0.3771473 0.3841715 0.5130238 0.6016022 0.2975893 0.3439536 -#> [43] 0.4533299 0.4086503 0.3204242 0.6261101 0.2467846 0.6767176 0.5709506 -#> [50] 0.5678715 0.2595917 0.6672274 0.6649766 0.3238279 0.3604865 0.6441048 -#> [57] 0.4283340 0.5721943 0.6999413 0.6657499 0.4996100 0.1629563 0.5060169 -#> [64] 0.3537177 0.4881894 0.7987097 0.4079972 0.8036737 0.3452472 0.5052393 -#> [71] 0.5663117 0.7296502 0.5976706 0.4974755 0.5597339 0.4141496 0.2679949 -#> [78] 0.3239441 0.4358545 0.5503528 0.6238012 0.4511404 0.4314348 0.4105476 -#> [85] 0.2777618 0.5832147 0.3072426 0.5053735 0.3194930 0.3596772 0.5937592 -#> [92] 0.5414427 0.1341999 0.2799095 0.2821861 0.3646150 0.4810341 0.3189519 -#> [99] 0.6143706 0.7486113 0.6488996 0.4205982 0.5593538 0.3476282 0.5820881 -#> [106] 0.3738353 0.4707527 0.3631546 0.6269755 0.4321470 0.3347249 0.3923195 -#> [113] 0.4329689 0.3571790 0.4098912 0.5064597 0.3844392 0.6296167 0.6775791 -#> [120] 0.6016554 0.5129068 0.4235469 0.1899813 0.2193524 0.2551328 0.3771036 -#> [127] 0.6753652 0.4425329 0.3195288 0.3664984 0.3736756 0.5438711 0.4362195 -#> [134] 0.5519865 0.3284179 0.3858648 0.5197454 0.1561759 0.3300143 0.4558187 -#> [141] 0.5083482 0.3316158 0.5001877 0.6187754 0.5848503 0.4440219 0.2035601 -#> [148] 0.2008203 0.3517624 0.3662946 0.7351962 0.5244983 0.2041273 0.5594004 -#> [155] 0.7188243 0.3589726 0.7124345 0.4943844 0.4280753 0.2655908 0.3151338 -#> [162] 0.2826330 0.5247986 0.4766446 0.3596816 0.4417860 0.1650980 0.4838166 -#> [169] 0.5075158 0.5434487 0.7878101 0.7026443 0.4577991 0.6962871 0.2198760 -#> [176] 0.5961035 0.5858438 0.1134488 0.4989565 0.5642438 0.6123560 0.7905477 -#> [183] 0.2865164 0.5878445 0.5505258 0.3562677 0.4328479 0.5749823 0.2297958 -#> [190] 0.4787364 0.2832969 0.4450161 0.4821660 0.4629925 0.2657539 0.4980861 -#> [197] 0.5570840 0.3427703 0.5491838 0.3663714 -wt_atm(ps, treatment) # Average Treatment Effect in Matched population -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 -#> -#> [1] 0.4707789 1.0000000 0.5460976 0.2322311 0.8209947 1.0000000 0.3449241 -#> [8] 0.4957157 1.0000000 1.0000000 0.7159101 0.8017975 1.0000000 1.0000000 -#> [15] 0.4382010 0.8680975 0.9224426 1.0000000 0.8345383 0.3329662 0.7888328 -#> [22] 0.6333681 0.3016302 0.8211016 0.6791099 1.0000000 0.3800259 0.4734925 -#> [29] 0.6466199 0.6267215 0.4243007 1.0000000 0.8299522 1.0000000 0.4073285 -#> [36] 0.9881219 0.6055160 0.6238288 1.0000000 1.0000000 0.4236685 0.5242825 -#> [43] 0.8292569 0.6910469 0.4715061 1.0000000 0.3276415 1.0000000 1.0000000 -#> [50] 1.0000000 0.3506062 1.0000000 1.0000000 0.4789134 0.5636887 1.0000000 -#> [57] 0.7492731 1.0000000 1.0000000 1.0000000 0.9984414 0.1946807 1.0000000 -#> [64] 0.5473114 0.9538478 1.0000000 0.6891813 1.0000000 0.5272941 1.0000000 -#> [71] 1.0000000 1.0000000 1.0000000 0.9899526 1.0000000 0.7069204 0.3661107 -#> [78] 0.4791676 0.7725923 1.0000000 1.0000000 0.8219595 0.7588134 0.6964897 -#> [85] 0.3845848 1.0000000 0.4435067 1.0000000 0.4694926 0.5617123 1.0000000 -#> [92] 1.0000000 0.1550010 0.3887143 0.3931187 0.5738490 0.9269090 0.4683251 -#> [99] 1.0000000 1.0000000 1.0000000 0.7259181 1.0000000 0.5328683 1.0000000 -#> [106] 0.5970239 0.8894758 0.5702399 1.0000000 0.7610191 0.5031375 0.6456016 -#> [113] 0.7635718 0.5556430 0.6946028 1.0000000 0.6245350 1.0000000 1.0000000 -#> [120] 1.0000000 1.0000000 0.7347466 0.2345394 0.2809878 0.3425212 0.6054034 -#> [127] 1.0000000 0.7938279 0.4695699 0.5785281 0.5966166 1.0000000 0.7737400 -#> [134] 1.0000000 0.4890211 0.6283059 1.0000000 0.1850811 0.4925693 0.8376227 -#> [141] 1.0000000 0.4961454 1.0000000 1.0000000 1.0000000 0.7986321 0.2555875 -#> [148] 0.2512830 0.5426442 0.5780203 1.0000000 1.0000000 0.2564823 1.0000000 -#> [155] 1.0000000 0.5599957 1.0000000 0.9777871 0.7484818 0.3616386 0.4601392 -#> [162] 0.3939866 1.0000000 0.9107475 0.5617230 0.7914278 0.1977453 0.9372959 -#> [169] 1.0000000 1.0000000 1.0000000 1.0000000 0.8443348 1.0000000 0.2818475 -#> [176] 1.0000000 1.0000000 0.1279665 0.9958348 1.0000000 1.0000000 1.0000000 -#> [183] 0.4015740 1.0000000 1.0000000 0.5534408 0.7631955 1.0000000 0.2983569 -#> [190] 0.9184152 0.3952778 0.8018540 0.9311206 0.8621715 0.3619412 0.9923737 -#> [197] 1.0000000 0.5215382 1.0000000 0.5782116 -wt_entropy(ps, treatment) # Entropy-weighted ATE -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 -#> -#> [1] 0.9220840 1.4329248 1.0040533 0.5963850 1.2534049 1.4031812 0.7656995 -#> [8] 0.9500521 1.5264541 1.5117895 1.1657523 1.2379873 2.1691415 2.0951770 -#> [15] 0.8841821 1.2902059 1.3309708 1.4399263 1.2641332 0.7492711 1.2274314 -#> [22] 1.0906640 0.7046524 1.2534901 1.1330186 1.6296231 0.8121906 0.9251700 -#> [29] 1.1031341 1.0843459 0.8675064 1.3886314 1.2605140 1.5312585 0.8467108 -#> [36] 1.3780256 1.0638957 1.0815827 1.4226729 1.6876517 0.8667405 0.9810635 -#> [43] 1.2599641 1.1437625 0.9229121 1.7678830 0.7418530 1.9466539 1.5919964 -#> [50] 1.5826441 0.7733968 1.9115902 1.9033872 0.9313031 1.0221795 1.8292459 -#> [57] 1.1944730 1.5957865 2.0359817 1.9062006 1.3852134 0.5310830 1.4030334 -#> [64] 1.0053157 1.3537590 2.4948344 1.1420915 2.5226740 0.9842719 1.4008637 -#> [71] 1.5779228 2.1587086 1.6751071 1.3793047 1.5581345 1.1578610 0.7940577 -#> [78] 0.9315898 1.2140399 1.5302393 1.7601665 1.2541732 1.2025273 1.1486206 -#> [85] 0.8180500 1.6296956 0.8904655 1.4012379 0.9206176 1.0201609 1.6627110 -#> [92] 1.5040831 0.4554091 0.8233241 0.8289142 1.0324881 1.3342450 0.9192844 -#> [99] 1.7289991 2.2429634 1.8459823 1.1744602 1.5569969 0.9901809 1.6262016 -#> [106] 1.0555775 1.3064505 1.0288395 1.7707839 1.2043797 0.9582116 1.1021817 -#> [113] 1.2065190 1.0139335 1.1469392 1.4042697 1.0822580 1.7796680 1.9498761 -#> [120] 1.6878219 1.4223439 1.1820755 0.6002279 0.6739112 0.7624234 1.0637858 -#> [127] 1.9416087 1.2315124 0.9207058 1.0371968 1.0551767 1.5111800 1.2149925 -#> [134] 1.5350702 0.9426286 1.0858559 1.4416671 0.5134648 0.9465707 1.2665596 -#> [141] 1.4095501 0.9505266 1.3868148 1.7434879 1.6347794 1.2354209 0.6344463 -#> [148] 0.6275654 1.0004522 1.0366869 2.1828304 1.4551922 0.6358694 1.5571363 -#> [155] 2.1127724 1.0184038 2.0863331 1.3707728 1.1938019 0.7881489 0.9098812 -#> [162] 0.8300116 1.4560495 1.3223439 1.0201717 1.2295537 0.5366230 1.3418163 -#> [169] 1.4072212 1.5099437 2.4357601 2.0467310 1.2718185 2.0215720 0.6752144 -#> [176] 1.6701309 1.6378739 0.3989231 1.3834029 1.5716810 1.7224115 2.4503434 -#> [183] 0.8395471 1.6441210 1.5307503 1.0116635 1.2062039 1.6043095 0.6998526 -#> [190] 1.3280088 0.8316416 1.2380331 1.3373221 1.2856536 0.7885499 1.3809936 -#> [197] 1.5502166 0.9781299 1.5267890 1.0368790 +ps <- fitted(ps_mod) + +wt_ate(ps, z) # Average Treatment Effect +wt_att(ps, z) # Average Treatment Effect on the Treated +wt_atu(ps, z) # Average Treatment Effect on the Untreated +wt_ato(ps, z) # Average Treatment Effect, Overlap population +wt_atm(ps, z) # Average Treatment Effect, Matched population +wt_entropy(ps, z) # Entropy-weighted ATE ``` -Choose your estimand based on your research question: - **ATE**: Effect -in the entire population - **ATT**: Effect among those who received -treatment - **ATU/ATC**: Effect among those who didn’t receive -treatment - **ATO**: Effect in the population with most overlap (more -stable weights) - **ATM**: Effect in a matched population - **Entropy**: -Balances efficiency and overlap +Choose your estimand based on your research question: + +| Estimand | Target population | Function | +|----|----|----| +| **ATE** | Entire population | `wt_ate()` | +| **ATT** | Treated units | `wt_att()` | +| **ATU** | Untreated units | `wt_atu()` (alias: `wt_atc()`) | +| **ATO** | Overlap population – units with the most equipoise between groups | `wt_ato()` | +| **ATM** | Matched population – mimics 1:1 matching | `wt_atm()` | +| **Entropy** | Entropy-balanced compromise between ATE and overlap | `wt_entropy()` | + +ATO and ATM produce naturally bounded weights, making them good +alternatives when ATE weights are highly variable. -## Flexible Input Formats +## Flexible Input -propensity accepts propensity scores in multiple formats: +Weight functions accept propensity scores in several forms: ``` r -# Numeric vector -wt_ate(ps, treatment) +# GLM object -- extracts fitted values and exposure automatically (recommended) +wt_ate(ps_mod) -# Data frame (uses second column by default for treatment probability) -ps_df <- data.frame(control = 1 - ps, treated = ps) -wt_ate(ps_df, treatment) +# Numeric vector of propensity scores +wt_ate(ps, z) -# GLM object directly (extracts fitted values automatically) -wt_ate(ps_model) +# Data frame of class probabilities (e.g., from multinomial models) +ps_df <- data.frame(control = 1 - ps, treated = ps) +wt_ate(ps_df, z) ``` ## Handling Extreme Weights -Extreme propensity scores (near 0 or 1) can lead to unstable weights. -propensity offers several solutions: +Propensity scores near 0 or 1 produce extreme weights that inflate +variance. propensity offers four complementary strategies: + +1. **Switch estimand** – `wt_ato()` and `wt_atm()` produce bounded + weights by design. +2. **Trim** – remove observations with extreme scores (sets them to + `NA`). +3. **Truncate** – winsorize extreme scores to a fixed range. +4. **Calibrate** – adjust scores so they better reflect true treatment + probabilities. ``` r -# Check for extreme weights -summary(wt_ate(ps, treatment)) -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 +ps <- fitted(ps_mod) + +# Diagnose: inspect the weight distribution +summary(wt_ate(ps, z)) #> Min. 1st Qu. Median Mean 3rd Qu. Max. -#> 1.128 1.527 1.811 1.999 2.238 5.094 +#> 1.380 1.806 1.956 2.000 2.154 2.902 -# Solution 1: Use overlap-weighted estimand (bounded weights) -summary(wt_ato(ps, treatment)) -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 +# 1. Switch estimand -- overlap weights are bounded by design +summary(wt_ato(ps, z)) #> Min. 1st Qu. Median Mean 3rd Qu. Max. -#> 0.1134 0.3449 0.4479 0.4519 0.5533 0.8037 +#> 0.2752 0.4463 0.4889 0.4912 0.5358 0.6554 -# Solution 2: Trim extreme propensity scores +# 2. Trim -- remove observations with extreme propensity scores ps_trimmed <- ps_trim(ps, method = "adaptive") -summary(wt_ate(ps_trimmed, treatment)) -#> Warning in wt_ate(ps_trimmed, treatment): It appears you trimmed your propensity score but did not refit the model. -#> ℹ Use `ps_refit()` for more accurate re-estimation. -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 -#> Min. 1st Qu. Median Mean 3rd Qu. Max. NA's -#> 1.155 1.530 1.821 2.003 2.245 5.094 1 - -# Solution 3: Truncate propensity scores +summary(wt_ate(ps_trimmed, z)) +#> Min. 1st Qu. Median Mean 3rd Qu. Max. +#> 1.380 1.806 1.956 2.000 2.154 2.902 + +# 3. Truncate -- bound extreme propensity scores to a range ps_truncated <- ps_trunc(ps, lower = 0.05, upper = 0.95) -summary(wt_ate(ps_truncated, treatment)) -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 +summary(wt_ate(ps_truncated, z)) #> Min. 1st Qu. Median Mean 3rd Qu. Max. -#> 1.128 1.527 1.811 1.999 2.238 5.094 - -# Solution 4: Calibrate propensity scores -ps_calibrated <- ps_calibrate(ps, treatment) -#> ℹ Setting focal level to 1 -summary(wt_ate(ps_calibrated, treatment)) -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 +#> 1.380 1.806 1.956 2.000 2.154 2.902 + +# 4. Calibrate -- adjust scores to better reflect true probabilities +ps_calibrated <- ps_calibrate(ps, z) +summary(wt_ate(ps_calibrated, z)) #> Min. 1st Qu. Median Mean 3rd Qu. Max. -#> 1.185 1.510 1.797 1.999 2.268 4.771 +#> 1.401 1.804 1.956 2.000 2.156 2.881 ``` -After trimming, you can refit the propensity score model on the retained -subset: +After trimming, refit the propensity score model on the retained subset +so the scores reflect the trimmed population: ``` r -ps_refitted <- ps_refit(ps_trimmed, ps_model) -wts_refitted <- wt_ate(ps_refitted, treatment) +ps_refitted <- ps_refit(ps_trimmed, ps_mod) +wts_refitted <- wt_ate(ps_refitted, z) ``` ## Advanced Features ### Weight Stabilization -Stabilized weights can reduce variance for ATE estimation: +Stabilized weights can reduce variance. Stabilization is supported for +`wt_ate()` and `wt_cens()`: ``` r -wt_ate(ps, treatment, stabilize = TRUE) -#> ℹ Treating `.exposure` as binary -#> ℹ Setting focal level to 1 -#> -#> [1] 0.7206816 1.0551545 0.7885098 0.6037932 0.9287073 0.9920431 0.6590128 -#> [8] 0.7329007 1.1309964 1.0747482 0.8407960 0.8828808 1.9034151 1.7167974 -#> [15] 0.7334825 0.9153678 0.9419969 1.0605813 0.8989238 0.6798128 0.8765281 -#> [22] 0.8003504 0.6377988 0.8923398 0.8227638 1.2235831 0.6762127 0.7220113 -#> [29] 0.8397762 0.7970935 0.7263933 1.0217216 0.9332756 1.1350935 0.6895910 -#> [36] 1.0139422 0.8188132 0.7956761 1.0472790 1.2801277 0.7260709 0.7468984 -#> [43] 0.9329210 0.8286130 0.7210380 1.3640381 0.6505443 1.5775681 1.1886742 -#> [50] 1.1802046 0.6617970 1.5325783 1.5222819 0.7246675 0.7974812 1.3768099 -#> [57] 0.8921293 1.1453797 1.6330137 1.5258036 1.0192051 0.6092872 0.9919368 -#> [64] 0.7891288 0.9573854 2.4342952 0.8276989 2.4958453 0.7789200 1.0308014 -#> [71] 1.1298436 1.8864448 1.2676179 1.0148758 1.1129632 0.8705294 0.6693942 -#> [78] 0.7247921 0.9040221 1.1342227 1.3025028 0.8927602 0.8618185 0.8312800 -#> [85] 0.7061382 1.1756653 0.7361884 0.9906465 0.7494412 0.7652391 1.2554129 -#> [92] 1.0685689 0.5890505 0.7082443 0.6826282 0.7711860 0.9827236 0.7488458 -#> [99] 1.2706501 1.9491728 1.3956120 0.8802182 1.1120032 0.7511055 1.2203528 -#> [106] 0.8144822 0.9258432 0.7694175 1.3135866 0.8628994 0.7365374 0.8063448 -#> [113] 0.8641502 0.7933779 0.8642474 1.0333502 0.7960221 1.3769518 1.5197525 -#> [120] 1.2300907 1.0470276 0.8500259 0.6296151 0.6533038 0.6846858 0.8187557 -#> [127] 1.5709959 0.8789757 0.7200893 0.8050493 0.8142745 1.1181050 0.8691326 -#> [134] 1.0937170 0.7296204 0.8304360 1.0202922 0.5806898 0.7612103 0.9371876 -#> [141] 1.0373196 0.7630342 0.9803680 1.3377941 1.1802973 0.8813297 0.6403496 -#> [148] 0.6381543 0.7867485 0.8047904 1.8504265 1.0725514 0.6408060 1.1575135 -#> [155] 1.7426825 0.7955978 1.7735088 0.9691157 0.8567561 0.6672029 0.7154682 -#> [162] 0.6830534 1.0732292 0.9744812 0.7964787 0.8777996 0.6108501 0.9492750 -#> [169] 1.0355662 1.1170704 2.3092521 1.6478582 0.9037241 1.6792175 0.6537422 -#> [176] 1.2626998 1.2314195 0.5752629 1.0178758 1.1244819 1.3156400 2.3394343 -#> [183] 0.7148027 1.2373971 1.0901627 0.7922548 0.8992297 1.1999500 0.6621620 -#> [190] 0.9400235 0.6836861 0.9189455 0.9848715 0.9124641 0.6945900 1.0161106 -#> [197] 1.1063045 0.7455537 1.0869174 0.7733237 +summary(wt_ate(ps, z, stabilize = TRUE)) +#> Min. 1st Qu. Median Mean 3rd Qu. Max. +#> 0.7036 0.9017 0.9817 0.9999 1.0732 1.4536 ``` ### Continuous Exposures -For continuous treatments, propensity scores represent conditional -densities: +For continuous treatments, weights use the ratio of the marginal to +conditional density. Stabilization is strongly recommended: ``` r -# Fit linear model for continuous treatment -continuous_treatment <- rnorm(n, mean = 0.5 * x1 - 0.3 * x2) -ps_continuous <- lm(continuous_treatment ~ x1 + x2) - -# Density-based weights -wts_continuous <- wt_ate( - ps_continuous, - continuous_treatment, - exposure_type = "continuous", - # stabilization is highly recommended for continuous exposures - stabilize = TRUE -) +# Fit a model for the continuous exposure +continuous_exposure <- rnorm(n, mean = 0.5 * x1) +dat$a <- continuous_exposure +ps_continuous <- glm(a ~ x1, data = dat, family = gaussian()) + +# Density-ratio weights (stabilization strongly recommended) +wts_continuous <- wt_ate(ps_continuous, stabilize = TRUE) ``` ### Categorical Exposures -For multi-level treatments, provide a data frame or matrix of propensity -scores: +For multi-level treatments, supply a matrix or data frame of class +probabilities with one column per treatment level: ``` r -# Multinomial propensity scores (3 treatment levels) +# Multinomial propensity scores (one column per treatment level) ps_matrix <- matrix(c(0.3, 0.5, 0.2), ncol = 3, nrow = n, byrow = TRUE) -categorical_treatment <- factor(sample(1:3, n, replace = TRUE)) +categorical_exposure <- factor(sample(1:3, n, replace = TRUE)) -wt_ate(ps_matrix, categorical_treatment, exposure_type = "categorical") +wt_ate(ps_matrix, categorical_exposure, exposure_type = "categorical") -# For ATT, specify focal level -wt_att(ps_matrix, categorical_treatment, .focal_level = "2") +# For ATT with categorical exposures, specify the focal level +wt_att(ps_matrix, categorical_exposure, .focal_level = "2") ``` ### Censoring Weights -Combine treatment and censoring weights for survival or longitudinal -analyses: +`wt_cens()` calculates inverse probability of censoring weights for +survival or longitudinal analyses. These address informative censoring – +not treatment assignment: ``` r -# Propensity of being uncensored -censoring_ps <- predict( - glm(uncensored ~ x1 + x2, family = binomial()), - type = "response" -) +# Model the probability of being uncensored +cens_mod <- glm(uncensored ~ x1 + x2, data = dat, family = binomial()) -# Censoring weights -wts_cens <- wt_cens(censoring_ps, uncensored) +# Censoring weights (uses the same formula as wt_ate()) +wts_cens <- wt_cens(cens_mod) + +# Combine with treatment weights for a doubly-weighted analysis +wts_combined <- wt_ate(ps_mod) * wts_cens +``` + +### Calibration Methods + +`ps_calibrate()` supports two calibration methods: + +``` r +# Logistic calibration (default) -- fits a logistic regression of exposure on +# predicted propensity scores +ps_calibrate(ps, z, method = "logistic") -# Combine with treatment weights -wts_combined <- wt_ate(ps, treatment) * wts_cens +# Isotonic regression calibration -- fits a monotone step function; useful for +# non-smooth relationships with large samples +ps_calibrate(ps, z, method = "isoreg") ``` ## Learn More -- [Causal Inference in R](https://www.r-causal.org/) - Comprehensive +- [propensity package + documentation](https://r-causal.github.io/propensity/) – Full + reference and articles +- [Causal Inference in R](https://www.r-causal.org/) – A comprehensive guide to causal inference methods in R diff --git a/inst/WORDLIST b/inst/WORDLIST index 933948c..acef482 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,46 +1,57 @@ -ATC ATO ATT ATU BYOM +Biometrics Biometrika Biostatistics CMD Codecov +Crump +Cui D'Agostino Estimand +Estimands +Faries Gerke Hajage Hirano +Hotz IPTW IPW Imbens Isotonic +Kadziola Kostouraki +Lauer Matchable Matsouaka +Mitnik ORCID +PSW Platt -Positivity Rachet Rosenbaum Winsorize Zaslavsky Zhou al -ato -att cr -doi estimand estimands et -glm +exponentiate halfmoon isotonic +matchable misspecification +misspecified +pctl +positivity +ps renormalized -tidyverse -vctrs +renormalizes +subclassification +winsorize winsorized winsorizing diff --git a/man/ipw.Rd b/man/ipw.Rd index e83158d..55d859b 100644 --- a/man/ipw.Rd +++ b/man/ipw.Rd @@ -3,7 +3,7 @@ \name{ipw} \alias{ipw} \alias{as.data.frame.ipw} -\title{Inverse Probability Weights for Causal Inference} +\title{Inverse Probability Weighted Estimation} \usage{ ipw( ps_mod, @@ -18,112 +18,149 @@ ipw( } \arguments{ \item{ps_mod}{A fitted propensity score model of class \code{\link[stats:glm]{stats::glm()}}, -typically a logistic regression with the exposure as the dependent -variable.} - -\item{outcome_mod}{A fitted, weighted outcome model of class \code{\link[stats:glm]{stats::glm()}} -or \code{\link[stats:lm]{stats::lm()}}, with the outcome as the dependent variable.} - -\item{.data}{A data frame containing the exposure, outcome, and covariates. If -\code{NULL}, \code{ipw()} will try to extract the data from \code{ps_mod} and -\code{outcome_mod}.} - -\item{estimand}{A character string specifying the causal estimand: \code{ate}, -\code{att}, \code{ato}, or \code{atm}. If \code{NULL}, the function attempts to infer it from -existing weights in \code{outcome_mod}, assuming they were calculated with +typically a logistic regression with the exposure as the left-hand side of +the formula.} + +\item{outcome_mod}{A fitted weighted outcome model of class \code{\link[stats:glm]{stats::glm()}} +or \code{\link[stats:lm]{stats::lm()}}, with the outcome as the dependent variable and +propensity score weights supplied via the \code{weights} argument. The weights +should be created with a propensity weight function such as \code{\link[=wt_ate]{wt_ate()}}.} + +\item{.data}{A data frame containing the exposure, outcome, and covariates. +If \code{NULL} (the default), \code{ipw()} extracts data from the model objects. +Supply \code{.data} explicitly if the outcome model formula contains +transformations that prevent extraction of the exposure variable from +\code{\link[stats:model.frame]{stats::model.frame()}}.} + +\item{estimand}{A character string specifying the causal estimand: \code{"ate"}, +\code{"att"}, \code{"ato"}, or \code{"atm"}. If \code{NULL}, the estimand is inferred from the +weights in \code{outcome_mod}. Auto-detection requires weights created with \code{\link[=wt_ate]{wt_ate()}}, \code{\link[=wt_att]{wt_att()}}, \code{\link[=wt_atm]{wt_atm()}}, or \code{\link[=wt_ato]{wt_ato()}}.} -\item{ps_link}{A character string specifying the link function for the -propensity score model: \code{logit}, \code{probit}, or \code{cloglog}. Defaults to -whatever link was used by \code{ps_mod}.} +\item{ps_link}{A character string specifying the link function used in the +propensity score model: \code{"logit"}, \code{"probit"}, or \code{"cloglog"}. Defaults to +the link used by \code{ps_mod}.} -\item{conf_level}{Numeric. Confidence level for intervals (default \code{0.95}).} +\item{conf_level}{Confidence level for intervals. Default is \code{0.95}.} -\item{x}{an \code{ipw} object} +\item{x}{An \code{ipw} object.} -\item{row.names, optional, ...}{Passed to \code{as.data.frame()}.} +\item{row.names, optional, ...}{Passed to \code{\link[base:as.data.frame]{base::as.data.frame()}}.} -\item{exponentiate}{Logical. Should the log-RR and log-OR be exponentiated?} +\item{exponentiate}{If \code{TRUE}, exponentiate the log risk ratio and log odds +ratio to produce risk ratios and odds ratios on their natural scale. The +confidence interval bounds are also exponentiated. Standard errors, z +statistics, and p-values remain on the log scale. Default is \code{FALSE}.} } \value{ -An S3 object of class \code{ipw} containing: -\itemize{ -\item \code{estimand}: One of \code{"ate"}, \code{"att"}, \code{"ato"}, or \code{"atm"}. -\item \code{ps_mod}: The fitted propensity score model. -\item \code{outcome_mod}: The fitted outcome model. -\item \code{estimates}: A data frame of point estimates, standard errors, z-statistics, -confidence intervals, and p-values. +An S3 object of class \code{ipw} with the following components: +\describe{ +\item{\code{estimand}}{The causal estimand: one of \code{"ate"}, \code{"att"}, \code{"ato"}, +or \code{"atm"}.} +\item{\code{ps_mod}}{The fitted propensity score model.} +\item{\code{outcome_mod}}{The fitted outcome model.} +\item{\code{estimates}}{A data frame with one row per effect measure and the +following columns: \code{effect} (the measure name), \code{estimate} (point +estimate), \code{std.err} (standard error), \code{z} (z-statistic), +\code{ci.lower} and \code{ci.upper} (confidence interval bounds), +\code{conf.level}, and \code{p.value}.} } + +\code{as.data.frame()} returns the \code{estimates} component as a data +frame. When \code{exponentiate = TRUE}, the \code{log(rr)} and \code{log(or)} rows are +transformed: point estimates and confidence limits are exponentiated and +the effect labels become \code{"rr"} and \code{"or"}. } \description{ \code{ipw()} is a bring-your-own-model (BYOM) inverse probability weighted -estimator. \code{ipw()} accepts a propensity score model and a weighted outcome -model that you have already fit. The purpose of \code{ipw()} is to capture the -uncertainty inherent to this two-step process and calculate the correct -standard errors for each estimate. Currently, \code{ipw()} supports binary -exposures and either binary or continuous outcomes. For binary outcomes, -\code{ipw()} calculates the marginal risk difference, log risk ratio, and log odds -ratio. For continuous outcomes, \code{ipw()} only calculates the marginal -difference in means. +estimator for causal inference. You supply a fitted propensity score model +and a fitted weighted outcome model; \code{ipw()} computes causal effect estimates +with standard errors that correctly account for the two-step estimation +process. + +\code{ipw()} currently supports binary exposures with binary or continuous +outcomes. For binary outcomes, it returns the risk difference, log risk +ratio, and log odds ratio. For continuous outcomes, it returns the difference +in means. } -\details{ -The function constructs inverse probability weights based on the -chosen \code{estimand}, then uses these weights (or extracts them from -\code{outcome_mod}) to compute effect measures: +\section{Workflow}{ +\code{ipw()} is designed around a three-step workflow: +\enumerate{ +\item Fit a propensity score model (e.g., logistic regression of exposure on +confounders). +\item Calculate propensity score weights for your estimand (e.g., \code{\link[=wt_ate]{wt_ate()}}) +and fit a weighted outcome model. +\item Pass both models to \code{ipw()} to obtain causal effect estimates with +correct standard errors. +} + +You are responsible for specifying and fitting both models. \code{ipw()} handles +the variance estimation. +} + +\section{Effect measures}{ +For binary outcomes (\code{\link[stats:glm]{stats::glm()}} with \code{family = binomial()}), \code{ipw()} +returns three effect measures: \itemize{ -\item \code{rd}: Risk difference +\item \code{rd}: Risk difference (marginal risk in exposed minus unexposed) \item \code{log(rr)}: Log risk ratio \item \code{log(or)}: Log odds ratio - -For a linear outcome model (using \code{\link[stats:lm]{stats::lm()}} or \code{\link[stats:glm]{stats::glm()}} with -\code{family = gaussian()}), only the difference in means (\code{diff}) is returned. } -\strong{Variance Estimation} +For continuous outcomes (\code{\link[stats:lm]{stats::lm()}} or \code{\link[stats:glm]{stats::glm()}} with +\code{family = gaussian()}), only the difference in means (\code{diff}) is returned. -The variance is estimated via linearization, which provide variance -estimates for IPW that correctly account for the uncertainty in estimation -of the propensity scores. For more details on various types of propensity -score weights and their corresponding variance estimators, see: -\itemize{ -\item \emph{Kostouraki A, Hajage D, Rachet B, et al. On variance estimation of the inverse -probability-of-treatment weighting estimator: A tutorial for different -types of propensity score weights. Statistics in Medicine. 2024; 43(13): -2672-2694. doi: \href{https://doi.org/10.1002/sim.10078}{10.1002/sim.10078}} +Use \code{\link[=as.data.frame]{as.data.frame()}} with \code{exponentiate = TRUE} to obtain risk ratios and +odds ratios on their natural scale. } + +\section{Variance estimation}{ +Standard errors are computed via linearization, which correctly accounts for +the uncertainty introduced by estimating propensity scores. This avoids the +known problem of underestimated standard errors that arises from treating +estimated weights as fixed. See Kostouraki et al. (2024) for details. } + \examples{ +# Simulate data with a confounder, binary exposure, and binary outcome set.seed(123) -n <- 100 -# confounder +n <- 200 x1 <- rnorm(n) -# exposure -z <- rbinom(n, 1, plogis(0.2 * x1)) -# binary outcome -y <- rbinom(n, 1, plogis(1 + 2*z + 0.5*x1)) - +z <- rbinom(n, 1, plogis(0.5 * x1)) +y <- rbinom(n, 1, plogis(-0.5 + 0.8 * z + 0.3 * x1)) dat <- data.frame(x1, z, y) -# fit a propensity score model (exposure ~ x1) +# Step 1: Fit a propensity score model ps_mod <- glm(z ~ x1, data = dat, family = binomial()) -# calculate weights for ATE -ps <- predict(ps_mod, type = "response") -wts <- wt_ate(ps, z) - -# fit an outcome model (binary y ~ z) using IPW +# Step 2: Calculate ATE weights and fit a weighted outcome model +wts <- wt_ate(ps_mod) outcome_mod <- glm(y ~ z, data = dat, family = binomial(), weights = wts) -# run IPW -ipw_res <- ipw(ps_mod, outcome_mod) +# Step 3: Estimate causal effects with correct standard errors +result <- ipw(ps_mod, outcome_mod) +result -ipw_res +# Exponentiate log-RR and log-OR to get RR and OR +as.data.frame(result, exponentiate = TRUE) -# Convert to a data frame with exponentiated RR/OR -ipw_res_df <- as.data.frame(ipw_res, exponentiate = TRUE) -ipw_res_df +# Continuous outcome example +y_cont <- 2 + 0.8 * z + 0.3 * x1 + rnorm(n) +dat$y_cont <- y_cont +outcome_cont <- lm(y_cont ~ z, data = dat, weights = wts) +ipw(ps_mod, outcome_cont) +} +\references{ +Kostouraki A, Hajage D, Rachet B, et al. On variance estimation of the +inverse probability-of-treatment weighting estimator: A tutorial for +different types of propensity score weights. \emph{Statistics in Medicine}. +2024;43(13):2672--2694. \doi{10.1002/sim.10078} } \seealso{ -\code{\link[stats:glm]{stats::glm()}}, \code{\link[stats:lm]{stats::lm()}} +\code{\link[=wt_ate]{wt_ate()}}, \code{\link[=wt_att]{wt_att()}}, \code{\link[=wt_atm]{wt_atm()}}, \code{\link[=wt_ato]{wt_ato()}} for calculating propensity +score weights. + +\code{\link[=ps_trim]{ps_trim()}}, \code{\link[=ps_trunc]{ps_trunc()}} for handling extreme propensity scores before +weighting. } diff --git a/man/is_ps_calibrated.Rd b/man/is_ps_calibrated.Rd index 98ea9df..ca659a1 100644 --- a/man/is_ps_calibrated.Rd +++ b/man/is_ps_calibrated.Rd @@ -2,17 +2,30 @@ % Please edit documentation in R/ps_calibration.R \name{is_ps_calibrated} \alias{is_ps_calibrated} -\title{Check if object is calibrated} +\title{Check if propensity scores are calibrated} \usage{ is_ps_calibrated(x) } \arguments{ -\item{x}{An R object.} +\item{x}{An object to test.} } \value{ -A logical scalar (\code{TRUE} or \code{FALSE}). +A single \code{TRUE} or \code{FALSE}. } \description{ -\code{is_ps_calibrated()} is an S3 generic that returns \code{TRUE} if its argument represents -calibrated propensity scores. +\code{is_ps_calibrated()} tests whether \code{x} is a calibrated propensity score +object (class \code{ps_calib}) or a \code{psw} object derived from calibrated scores. +} +\examples{ +ps <- runif(100) +exposure <- rbinom(100, 1, ps) + +is_ps_calibrated(ps) + +calibrated <- ps_calibrate(ps, exposure) +is_ps_calibrated(calibrated) + +} +\seealso{ +\code{\link[=ps_calibrate]{ps_calibrate()}} to calibrate propensity scores. } diff --git a/man/is_ps_trimmed.Rd b/man/is_ps_trimmed.Rd index 7806c00..a43d8ef 100644 --- a/man/is_ps_trimmed.Rd +++ b/man/is_ps_trimmed.Rd @@ -2,20 +2,32 @@ % Please edit documentation in R/ps_trim.R \name{is_ps_trimmed} \alias{is_ps_trimmed} -\title{Check if object is trimmed} +\title{Test whether propensity scores have been trimmed} \usage{ is_ps_trimmed(x) } \arguments{ -\item{x}{An object.} +\item{x}{An object to test.} } \value{ A logical scalar (\code{TRUE} or \code{FALSE}). } \description{ -\code{is_ps_trimmed()} is an S3 generic that returns \code{TRUE} if its -argument represents a \code{ps_trim} object or \code{psw} object created from trimmed -propensity scores. \code{is_ps_trimmed()} is a question about whether or not the -propensity scores \emph{have} been trimmed, as opposed to \code{\link[=is_unit_trimmed]{is_unit_trimmed()}}, -which is a question about which \emph{units} have been trimmed. +\code{is_ps_trimmed()} returns \code{TRUE} if \code{x} is a \code{ps_trim} object +or a \code{psw} object created from trimmed propensity scores, and \code{FALSE} +otherwise. This tests whether the \emph{object} carries trimming information, not +which individual units were trimmed; see \code{\link[=is_unit_trimmed]{is_unit_trimmed()}} for that. +} +\examples{ +ps <- c(0.05, 0.3, 0.6, 0.95) +trimmed <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) + +is_ps_trimmed(trimmed) +is_ps_trimmed(ps) + +} +\seealso{ +\code{\link[=ps_trim]{ps_trim()}} for trimming propensity scores, \code{\link[=is_unit_trimmed]{is_unit_trimmed()}} to +identify which units were trimmed, \code{\link[=ps_trim_meta]{ps_trim_meta()}} to retrieve full +trimming metadata. } diff --git a/man/is_ps_truncated.Rd b/man/is_ps_truncated.Rd index 86bba59..b2ea3e3 100644 --- a/man/is_ps_truncated.Rd +++ b/man/is_ps_truncated.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/ps_trunc.R \name{is_ps_truncated} \alias{is_ps_truncated} -\title{Check if object is truncated} +\title{Test whether propensity scores have been truncated} \usage{ is_ps_truncated(x) } @@ -10,13 +10,21 @@ is_ps_truncated(x) \item{x}{An object.} } \value{ -A logical scalar (\code{TRUE} or \code{FALSE}). +A single \code{TRUE} or \code{FALSE}. } \description{ -\code{is_ps_truncated()} is an S3 generic that returns \code{TRUE} if its -argument represents a \code{ps_trunc} object or \code{psw} object created from -truncated propensity scores. \code{is_ps_truncated()} is a question about whether -the propensity scores \emph{have} been truncated, as opposed to -\code{\link[=is_unit_truncated]{is_unit_truncated()}}, which is a question about which \emph{units} have been -truncated. +\code{is_ps_truncated()} returns \code{TRUE} if \code{x} is a \code{ps_trunc} +object or a \code{psw} object derived from truncated propensity scores. +Use \code{\link[=is_unit_truncated]{is_unit_truncated()}} to find out \emph{which} observations were modified. +} +\examples{ +ps <- c(0.02, 0.3, 0.5, 0.7, 0.98) +is_ps_truncated(ps) + +ps_t <- ps_trunc(ps, method = "ps", lower = 0.05, upper = 0.95) +is_ps_truncated(ps_t) + +} +\seealso{ +\code{\link[=ps_trunc]{ps_trunc()}}, \code{\link[=is_unit_truncated]{is_unit_truncated()}}, \code{\link[=ps_trunc_meta]{ps_trunc_meta()}} } diff --git a/man/is_refit.Rd b/man/is_refit.Rd index 127ec16..88d3734 100644 --- a/man/is_refit.Rd +++ b/man/is_refit.Rd @@ -2,18 +2,37 @@ % Please edit documentation in R/ps_trim.R \name{is_refit} \alias{is_refit} -\title{Check if an object has been refit} +\title{Check if propensity scores have been refit} \usage{ is_refit(x) } \arguments{ -\item{x}{An R object (e.g. a \link{ps_trim} or \link{psw}).} +\item{x}{An object to test (typically a \link{ps_trim} vector).} } \value{ -A logical scalar (\code{TRUE} or \code{FALSE}). +A single \code{TRUE} or \code{FALSE}. } \description{ -\strong{\code{is_refit()}} is an S3 generic that returns \code{TRUE} if its argument -represents a \link{ps_trim} object (or a weighting object) that has had the -propensity model refit on the retained subset. +\code{is_refit()} tests whether \code{x} is a \code{ps_trim} object whose propensity +model has been refit on the retained (non-trimmed) observations via +\code{\link[=ps_refit]{ps_refit()}}. +} +\examples{ +set.seed(2) +n <- 30 +x <- rnorm(n) +z <- rbinom(n, 1, plogis(0.4 * x)) +fit <- glm(z ~ x, family = binomial) +ps <- predict(fit, type = "response") + +trimmed <- ps_trim(ps, lower = 0.2, upper = 0.8) +is_refit(trimmed) + +refit <- ps_refit(trimmed, fit) +is_refit(refit) + +} +\seealso{ +\code{\link[=ps_refit]{ps_refit()}} to refit a propensity model after trimming, +\code{\link[=ps_trim]{ps_trim()}} to trim propensity scores. } diff --git a/man/is_unit_trimmed.Rd b/man/is_unit_trimmed.Rd index 9d2d360..f88c989 100644 --- a/man/is_unit_trimmed.Rd +++ b/man/is_unit_trimmed.Rd @@ -2,20 +2,36 @@ % Please edit documentation in R/ps_trim.R \name{is_unit_trimmed} \alias{is_unit_trimmed} -\title{Check if units have been trimmed} +\title{Identify which units were trimmed} \usage{ is_unit_trimmed(x) } \arguments{ -\item{x}{An object.} +\item{x}{A \code{ps_trim} object created by \code{\link[=ps_trim]{ps_trim()}}.} } \value{ -A logical scalar (\code{TRUE} or \code{FALSE}). +A logical vector the same length as \code{x}, where \code{TRUE} marks a +trimmed unit. } \description{ -\code{is_unit_trimmed()} is an that vector of \code{TRUE} or \code{FALSE} -values, representing if the unit was trimmed. \code{is_unit_trimmed()} is a -question about which \emph{units} have been trimmed, as opposed to -\code{\link[=is_ps_trimmed]{is_ps_trimmed()}}, which is a question about whether or not the propensity -scores \emph{have} been trimmed. +\code{is_unit_trimmed()} returns a logical vector indicating which +observations were removed by trimming. This is a per-unit query, as opposed +to \code{\link[=is_ps_trimmed]{is_ps_trimmed()}}, which tests whether the object has been trimmed at +all. +} +\examples{ +ps <- c(0.05, 0.3, 0.6, 0.95) +trimmed <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) + +is_unit_trimmed(trimmed) + +# Use to subset data to retained observations +kept <- !is_unit_trimmed(trimmed) +ps[kept] + +} +\seealso{ +\code{\link[=ps_trim]{ps_trim()}} for trimming propensity scores, \code{\link[=is_ps_trimmed]{is_ps_trimmed()}} to +test whether an object has been trimmed, \code{\link[=ps_trim_meta]{ps_trim_meta()}} to retrieve full +trimming metadata. } diff --git a/man/is_unit_truncated.Rd b/man/is_unit_truncated.Rd index b5b44e7..fda4a9e 100644 --- a/man/is_unit_truncated.Rd +++ b/man/is_unit_truncated.Rd @@ -2,20 +2,28 @@ % Please edit documentation in R/ps_trunc.R \name{is_unit_truncated} \alias{is_unit_truncated} -\title{Check if units have been truncated} +\title{Identify which units were truncated} \usage{ is_unit_truncated(x) } \arguments{ -\item{x}{An object.} +\item{x}{A \code{ps_trunc} object created by \code{\link[=ps_trunc]{ps_trunc()}}.} } \value{ -A logical vector. +A logical vector the same length as \code{x} (or number of rows for +matrix input). \code{TRUE} marks observations whose values were winsorized. } \description{ -\code{is_ps_truncated()} is an S3 generic that returns a vector of -\code{TRUE} or \code{FALSE}, representing if the element has been truncated. -\code{\link[=is_unit_truncated]{is_unit_truncated()}} is a question about which \emph{units} have been -truncated, as opposed to \code{is_ps_truncated()}, which is a question about -whether the propensity scores \emph{have} been truncated. +\code{is_unit_truncated()} returns a logical vector indicating which +observations had their propensity scores modified by truncation. Use +\code{\link[=is_ps_truncated]{is_ps_truncated()}} to test whether an object has been truncated at all. +} +\examples{ +ps <- c(0.02, 0.3, 0.5, 0.7, 0.98) +ps_t <- ps_trunc(ps, method = "ps", lower = 0.05, upper = 0.95) +is_unit_truncated(ps_t) + +} +\seealso{ +\code{\link[=ps_trunc]{ps_trunc()}}, \code{\link[=is_ps_truncated]{is_ps_truncated()}}, \code{\link[=ps_trunc_meta]{ps_trunc_meta()}} } diff --git a/man/propensity-package.Rd b/man/propensity-package.Rd index 028d8a5..1d1f623 100644 --- a/man/propensity-package.Rd +++ b/man/propensity-package.Rd @@ -6,21 +6,65 @@ \alias{propensity-package} \title{propensity: A Toolkit for Calculating and Working with Propensity Scores} \description{ -\if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} +propensity provides tools for propensity score analysis in causal inference. +Calculate propensity score weights for a variety of causal estimands, handle +extreme propensity scores through trimming, truncation, and calibration, and +estimate causal effects with inverse probability weighting. The package +supports binary, categorical, and continuous exposures. +} +\section{Weight functions}{ -A comprehensive toolkit for propensity score analysis in causal inference. Supports calculating propensity score weights for multiple causal estimands across binary, continuous, and categorical exposures. Provides methods for handling extreme propensity scores through trimming, truncation, and calibration. Includes inverse probability weighted estimators that correctly accounts for propensity score estimation uncertainty. +Calculate propensity score weights for different causal estimands: +\itemize{ +\item \code{\link[=wt_ate]{wt_ate()}}: Average treatment effect (ATE) weights +\item \code{\link[=wt_att]{wt_att()}}: Average treatment effect on the treated (ATT) weights +\item \code{\link[=wt_atu]{wt_atu()}}: Average treatment effect on the untreated (ATU) weights +(\code{wt_atc()} is an alias) +\item \code{\link[=wt_atm]{wt_atm()}}: Average treatment effect for the evenly matchable (ATM) weights +\item \code{\link[=wt_ato]{wt_ato()}}: Average treatment effect for the overlap population (ATO) weights +\item \code{\link[=wt_entropy]{wt_entropy()}}: Entropy balancing weights +\item \code{\link[=wt_cens]{wt_cens()}}: Censoring weights } -\seealso{ -Useful links: +} + +\section{Propensity score modifications}{ + +Handle extreme propensity scores before calculating weights: +\itemize{ +\item \code{\link[=ps_trim]{ps_trim()}}: Trim observations with extreme propensity scores +\item \code{\link[=ps_trunc]{ps_trunc()}}: Truncate (winsorize) extreme propensity scores +\item \code{\link[=ps_calibrate]{ps_calibrate()}}: Calibrate propensity scores to improve balance +\item \code{\link[=ps_refit]{ps_refit()}}: Re-estimate the propensity score model after trimming +} +} + +\section{Estimation}{ + +\itemize{ +\item \code{\link[=ipw]{ipw()}}: Inverse probability weighted estimator with variance estimation +that accounts for propensity score estimation uncertainty +} +} + +\section{PSW class}{ + +The \code{\link[=psw]{psw()}} class represents propensity score weights with metadata about +the estimand and modifications applied: \itemize{ - \item \url{https://r-causal.github.io/propensity/} - \item \url{https://github.com/r-causal/propensity} - \item Report bugs at \url{https://github.com/r-causal/propensity/issues} +\item \code{\link[=psw]{psw()}}, \code{\link[=as_psw]{as_psw()}}, \code{\link[=is_psw]{is_psw()}}: Create and test propensity score weights +\item \code{\link[=estimand]{estimand()}}: Query the causal estimand +\item \code{\link[=is_stabilized]{is_stabilized()}}: Check if weights are stabilized +} } +\seealso{ +\itemize{ +\item \code{vignette("propensity")} for a getting started guide +\item The \href{https://r-causal.github.io/propensity/}{package website} for +full documentation +} } \author{ \strong{Maintainer}: Malcolm Barrett \email{malcolmbarrett@gmail.com} (\href{https://orcid.org/0000-0003-0299-5825}{ORCID}) [copyright holder] } -\keyword{internal} diff --git a/man/ps_calibrate.Rd b/man/ps_calibrate.Rd index ec8d3b5..00edeaa 100644 --- a/man/ps_calibrate.Rd +++ b/man/ps_calibrate.Rd @@ -16,59 +16,96 @@ ps_calibrate( ) } \arguments{ -\item{ps}{Numeric vector of propensity scores between 0 and 1} +\item{ps}{A numeric vector of propensity scores between 0 and 1. Must not +already be calibrated.} -\item{.exposure}{A binary vector of treatment assignments} +\item{.exposure}{A binary vector of observed treatment assignments, the same +length as \code{ps}.} -\item{method}{Calibration method: +\item{method}{Calibration method. One of: \describe{ -\item{\code{"logistic"}}{(Default) Logistic calibration (also known as Platt scaling). -Assumes a sigmoid relationship between observed and true probabilities. -Best when: propensity scores follow a logistic pattern but are -systematically biased. Provides smooth, parametric calibration. -Faster and more stable with small samples.} -\item{\code{"isoreg"}}{Isotonic regression calibration. Uses a non-parametric -monotonic transformation. Best when: the relationship between observed -and true probabilities is non-linear or when you want to preserve -the rank order without assuming a specific functional form. -More flexible but requires larger samples for stable estimates.} +\item{\code{"logistic"}}{(Default) Logistic calibration, also called Platt +scaling. Fits a logistic regression of \code{.exposure} on \code{ps}, yielding +a smooth, parametric correction. Works well with small samples and +when the bias in \code{ps} is approximately monotone.} +\item{\code{"isoreg"}}{Isotonic regression. Fits a non-parametric, +monotone step function. More flexible than logistic calibration +because it makes no distributional assumption, but needs larger +samples for stable estimates.} }} -\item{smooth}{Logical. For \code{method = "logistic"}, whether to use a smoothed -logistic spline model (\code{smooth = TRUE}, default) or simple logistic -regression (\code{smooth = FALSE}). When \code{TRUE}, uses \code{mgcv::gam()} with -spline smoothing. When \code{FALSE}, uses \code{stats::glm()}. Ignored for -\code{method = "isoreg"}.} +\item{smooth}{Logical. When \code{method = "logistic"}, controls the form of the +calibration model. If \code{TRUE} (default), fits a GAM with a spline on +\code{ps} via \code{\link[mgcv:gam]{mgcv::gam()}}; if \code{FALSE}, fits a simple logistic regression +via \code{\link[stats:glm]{stats::glm()}}. Ignored when \code{method = "isoreg"}.} -\item{.focal_level}{The value representing the focal group (typically treatment). -If not provided, \code{ps_calibrate()} will attempt to automatically determine the coding.} +\item{.focal_level}{The value of \code{.exposure} representing the focal group +(typically the treated group). If \code{NULL} (default), coding is determined +automatically.} -\item{.reference_level}{The value representing the reference group (typically control). -If not provided, \code{ps_calibrate()} will attempt to automatically determine the coding.} +\item{.reference_level}{The value of \code{.exposure} representing the reference +group (typically the control group). If \code{NULL} (default), coding is +determined automatically.} \item{.treated}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{.focal_level} instead.} \item{.untreated}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{.reference_level} instead.} } \value{ -A calibrated propensity score object (\code{ps_calib}) +A \code{ps_calib} vector the same length as \code{ps}. The attribute +\code{ps_calib_meta} stores calibration metadata (method and whether +smoothing was applied). Use \code{\link[=is_ps_calibrated]{is_ps_calibrated()}} to test whether an +object has been calibrated. } \description{ -This function calibrates propensity scores to improve their accuracy using -either Platt scaling (logistic regression) or isotonic regression. It -preserves the attributes of causal weight objects when applicable. +\code{ps_calibrate()} adjusts estimated propensity scores so they better reflect +true treatment probabilities. This can improve the accuracy of inverse +probability weights derived from a misspecified propensity score model. +} +\details{ +Calibration is useful when the propensity score model is correctly +specified in terms of variable selection but produces probabilities that +are systematically too high or too low. Unlike \code{\link[=ps_trim]{ps_trim()}} and +\code{\link[=ps_trunc]{ps_trunc()}}, which handle extreme scores by removing or bounding them, +calibration reshapes the entire distribution of scores. + +\strong{Choosing a method:} +\itemize{ +\item Use \code{"logistic"} (the default) as a first choice. It is stable and +fast, and the \code{smooth = TRUE} option adds flexibility via a spline. +\item Use \code{"isoreg"} when you suspect a non-smooth or irregular relationship +between estimated and true probabilities and have a sufficiently large +sample. +} + +The calibrated scores are returned as a \code{ps_calib} object, which can be +passed directly to weight functions such as \code{\link[=wt_ate]{wt_ate()}}. } \examples{ -# Generate example data -ps <- runif(100) -exposure <- rbinom(100, 1, ps) +# Simulate data +set.seed(42) +ps <- runif(200) +exposure <- rbinom(200, 1, ps) -# Logistic calibration with smoothing (default) -calibrated_smooth <- ps_calibrate(ps, exposure) +# Logistic calibration without smoothing (simple Platt scaling) +cal <- ps_calibrate(ps, exposure, smooth = FALSE) +cal -# Logistic calibration without smoothing (simple logistic regression) -calibrated_simple <- ps_calibrate(ps, exposure, smooth = FALSE) +# Use calibrated scores to calculate weights +wt_ate(cal, exposure) -# Isotonic regression -calibrated_iso <- ps_calibrate(ps, exposure, method = "isoreg") +# Isotonic regression calibration +cal_iso <- ps_calibrate(ps, exposure, method = "isoreg") + +if (rlang::is_installed("mgcv")) { + # Logistic calibration with spline smoothing (default) + cal_smooth <- ps_calibrate(ps, exposure) +} + +} +\seealso{ +\code{\link[=is_ps_calibrated]{is_ps_calibrated()}} to test for calibrated scores; +\code{\link[=ps_trim]{ps_trim()}} and \code{\link[=ps_trunc]{ps_trunc()}} for alternative approaches to extreme +propensity scores; \code{\link[=wt_ate]{wt_ate()}} and other weight functions that accept +\code{ps_calib} objects. } diff --git a/man/ps_refit.Rd b/man/ps_refit.Rd index f7c1ce1..9df9e2c 100644 --- a/man/ps_refit.Rd +++ b/man/ps_refit.Rd @@ -2,49 +2,60 @@ % Please edit documentation in R/ps_trim.R \name{ps_refit} \alias{ps_refit} -\title{Refit the Propensity Score Model on Retained Observations} +\title{Refit a Propensity Score Model on Retained Observations} \usage{ ps_refit(trimmed_ps, model, .data = NULL, ...) } \arguments{ -\item{trimmed_ps}{A \code{ps_trim} object (same length as data, NAs for trimmed).} +\item{trimmed_ps}{A \code{ps_trim} object returned by \code{\link[=ps_trim]{ps_trim()}}.} -\item{model}{The fitted model used to get the original PS (e.g. a glm).} +\item{model}{The original fitted model used to estimate the propensity +scores (e.g. a \link[stats:glm]{glm} or \link[nnet:multinom]{multinom} object). +The model is refit via \link[stats:update]{update()} on the retained subset.} -\item{.data}{Optional. A data frame. If \code{NULL}, we try to retrieve from \code{model}.} +\item{.data}{A data frame. If \code{NULL} (the default), the data are extracted +from \code{model} via \link[stats:model.frame]{model.frame()}.} -\item{...}{Additional arguments passed to \code{update()}.} +\item{...}{Additional arguments passed to \link[stats:update]{update()}.} } \value{ -A new \code{ps_trim} object with updated propensity scores and -\code{ps_trim_meta(x)$refit} set to \code{TRUE}. +A \code{ps_trim} object with re-estimated propensity scores for retained +observations and \code{NA} for trimmed observations. Use \code{\link[=is_refit]{is_refit()}} to +confirm refitting was applied. } \description{ -Takes a \code{ps_trim} object and the original model -used to calculate the propensity score, then: -\enumerate{ -\item Retrieves data from the model (or from \code{.df} argument if provided) -\item Subsets rows to the non‐trimmed indices -\item Refits the model -\item Predicts new propensity scores for all rows (trimmed rows -> \code{NA}) -\item Returns a new \code{ps_trim} object with \code{refit = TRUE}. -} +Re-estimates a propensity score model using only the observations retained +after trimming. This is the recommended intermediate step between +\code{\link[=ps_trim]{ps_trim()}} and weight calculation (e.g. \code{\link[=wt_ate]{wt_ate()}}): + +\strong{\code{ps_trim()} -> \code{ps_refit()} -> \verb{wt_*()}} + +Trimming changes the target population by removing observations with extreme +propensity scores. Refitting the model on the retained subset produces +propensity scores that better reflect this population, improving both model +fit and downstream weight estimation. Weight functions warn if a trimmed +propensity score has not been refit. } \examples{ set.seed(2) -n <- 30 +n <- 200 x <- rnorm(n) z <- rbinom(n, 1, plogis(0.4 * x)) -fit <- glm(z ~ x, family = binomial) -ps <- predict(fit, type = "response") -# trim and refit -refit <- ps_trim(ps, lower = .2, upper = .8) |> - ps_refit(fit) +# fit a propensity score model +ps_model <- glm(z ~ x, family = binomial) +ps <- predict(ps_model, type = "response") + +# trim -> refit -> weight pipeline +trimmed <- ps_trim(ps, lower = 0.1, upper = 0.9) +refit <- ps_refit(trimmed, ps_model) +wts <- wt_ate(refit, .exposure = z) is_refit(refit) } \seealso{ -\code{\link[=ps_trim]{ps_trim()}}, \code{\link[=is_refit]{is_refit()}}, \code{\link[=is_ps_trimmed]{is_ps_trimmed()}} +\code{\link[=ps_trim]{ps_trim()}} for the trimming step, \code{\link[=is_refit]{is_refit()}} to check refit +status, \code{\link[=wt_ate]{wt_ate()}} and other weight functions for the next step in the +pipeline. } diff --git a/man/ps_trim.Rd b/man/ps_trim.Rd index 5a60e2a..b47ab24 100644 --- a/man/ps_trim.Rd +++ b/man/ps_trim.Rd @@ -18,88 +18,134 @@ ps_trim( ) } \arguments{ -\item{ps}{The propensity score, either a numeric vector between 0 and 1 for -binary exposures, or a matrix/data.frame where each column represents -propensity scores for each level of a categorical exposure.} +\item{ps}{A numeric vector of propensity scores in (0, 1) for binary +exposures, or a matrix / data frame where each column gives the propensity +score for one level of a categorical exposure.} -\item{method}{One of \code{c("ps", "adaptive", "pctl", "pref", "cr", "optimal")}. -For categorical exposures, only \code{"ps"} and \code{"optimal"} are supported.} - -\item{lower, upper}{Numeric cutoffs or quantiles. If \code{NULL}, defaults vary by -method. For categorical exposures with method \code{"ps"}, \code{lower} represents the -symmetric trimming threshold (delta).} +\item{method}{Trimming method. One of: +\itemize{ +\item \strong{\code{"ps"}} (default): Fixed threshold. Observations with propensity +scores outside \verb{[lower, upper]} are trimmed. For categorical exposures, +observations where \emph{any} column falls below \code{lower} (the symmetric +threshold delta) are trimmed. +\item \strong{\code{"adaptive"}}: Data-driven threshold that minimizes the asymptotic +variance of the IPW estimator (Crump et al., 2009). The \code{lower} and +\code{upper} arguments are ignored. +\item \strong{\code{"pctl"}}: Quantile-based. Observations outside the \verb{[lower, upper]} +quantiles of the propensity score distribution are trimmed. Defaults: +\code{lower = 0.05}, \code{upper = 0.95}. +\item \strong{\code{"pref"}}: Preference score trimming. Transforms propensity scores +to the preference scale (Walker et al., 2013) and trims outside +\verb{[lower, upper]}. Requires \code{.exposure}. Binary exposures only. Defaults: +\code{lower = 0.3}, \code{upper = 0.7}. +\item \strong{\code{"cr"}}: Common range (clinical equipoise). Trims to the overlap +region of the propensity score distributions across exposure groups. +Requires \code{.exposure}. Binary exposures only. The \code{lower} and \code{upper} +arguments are ignored. +\item \strong{\code{"optimal"}}: Multi-category optimal trimming (Yang et al., 2016). +Categorical exposures only. Requires \code{.exposure}. +} -\item{.exposure}{For methods like \code{"pref"} or \code{"cr"}, a vector for a binary -exposure. For categorical exposures with method \code{"optimal"}, must be a -factor or character vector.} +For categorical exposures, only \code{"ps"} and \code{"optimal"} are supported.} -\item{.focal_level}{For binary exposures, the value representing the focal group -(typically the treatment group). For categorical exposures with ATT or ATU estimands, -specifies the focal category. Must be one of the levels of the exposure variable. +\item{lower, upper}{Numeric thresholds whose interpretation depends on +\code{method}: +\itemize{ +\item \code{"ps"}: absolute propensity score bounds (defaults: 0.1, 0.9). For +categorical exposures, only \code{lower} is used as the symmetric threshold. +\item \code{"pctl"}: quantile probabilities (defaults: 0.05, 0.95). +\item \code{"pref"}: preference score bounds (defaults: 0.3, 0.7). +\item \code{"adaptive"}, \code{"cr"}, \code{"optimal"}: ignored (thresholds are data-driven). +}} + +\item{.exposure}{An exposure variable. Required for \code{"pref"}, \code{"cr"} (binary +vector), and \code{"optimal"} (factor or character). Not required for other +methods.} + +\item{.focal_level}{The value of \code{.exposure} representing the focal +(treated) group. For binary exposures, defaults to the higher value. Required for \code{wt_att()} and \code{wt_atu()} with categorical exposures.} -\item{.reference_level}{For binary exposures, the value representing the reference group -(typically the control group). If not provided, it is automatically detected.} +\item{.reference_level}{The value of \code{.exposure} representing the reference +(control) group. Automatically detected if not supplied.} -\item{...}{Additional arguments passed to methods} +\item{...}{Additional arguments passed to methods.} \item{.treated}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{.focal_level} instead.} \item{.untreated}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{.reference_level} instead.} } \value{ -A \code{ps_trim} object (numeric vector or matrix). The attribute -\code{ps_trim_meta} stores metadata. +A \strong{\code{ps_trim}} object (a numeric vector with class \code{"ps_trim"}, or a +matrix with class \code{"ps_trim_matrix"}). Trimmed observations are \code{NA}. +Metadata is stored in the \code{"ps_trim_meta"} attribute and can be accessed +with \code{\link[=ps_trim_meta]{ps_trim_meta()}}. Key fields include: +\itemize{ +\item \code{method}: the trimming method used +\item \code{keep_idx}: integer indices of retained observations +\item \code{trimmed_idx}: integer indices of trimmed (NA) observations +\item Method-specific fields such as \code{cutoff} (adaptive), \code{q_lower}/\code{q_upper} +(pctl), \code{cr_lower}/\code{cr_upper} (cr), \code{delta} (categorical ps), +or \code{lambda} (optimal) +} } \description{ -\code{ps_trim()} applies trimming methods to a propensity-score vector or matrix, -returning a new vector/matrix of the \emph{same length/dimensions}, with trimmed -entries replaced by \code{NA.} You can inspect further metadata in \code{ps_trim_meta(x)}. -After running \code{ps_trim()}, you should refit the model with \code{ps_refit()}. +Trim observations with extreme propensity scores by replacing them with \code{NA}, +effectively removing those units from downstream analyses. The returned object +has the same length (or dimensions) as the input, with trimmed entries set to +\code{NA}. After trimming, refit the propensity score model on the retained +observations with \code{\link[=ps_refit]{ps_refit()}}. } \details{ -The returned object is a \strong{\code{ps_trim}} vector/matrix of the same -length/dimensions as \code{ps}, but with trimmed entries replaced by \code{NA}. An -attribute \code{ps_trim_meta} contains: -\itemize{ -\item \code{method}: Which trimming method was used -\item \code{keep_idx}: Indices retained -\item \code{trimmed_idx}: Indices replaced by \code{NA} -\item Possibly other fields such as final cutoffs, etc. +\subsection{How trimming works}{ + +Trimming identifies observations with extreme (near 0 or 1) propensity +scores and sets them to \code{NA}. These observations are excluded from +subsequent weight calculations and effect estimation. The goal is to +remove units that lack sufficient overlap between exposure groups, which +would otherwise receive extreme weights and destabilize estimates. } -For categorical exposures: +\subsection{Choosing a method}{ \itemize{ -\item \strong{Symmetric trimming} (\code{method = "ps"}): Removes observations where any -propensity score falls below the threshold delta (specified via \code{lower}). -\item \strong{Optimal trimming} (\code{method = "optimal"}): Uses the Yang et al. (2016) -approach for multi-category treatments. +\item Use \code{"ps"} when you have a specific threshold in mind or want a simple +default. +\item Use \code{"adaptive"} for a principled, data-driven cutoff that targets +variance reduction. +\item Use \code{"pctl"} to trim a fixed percentage of extreme values from each tail. +\item Use \code{"pref"} when you want to restrict to the region of clinical +equipoise based on the preference score. +\item Use \code{"cr"} to restrict to the common support region where both exposure +groups have observed propensity scores. +\item Use \code{"optimal"} for multi-category (3+) exposures; this is the only +data-driven method available for categorical treatments. +} } -\strong{Arithmetic behavior}: Arithmetic operations on \code{ps_trim} objects return -numeric vectors, not \code{ps_trim} objects. This is intentional - once you -transform propensity scores (e.g., \code{1/ps} for weights), the result is no -longer a propensity score. +\subsection{Typical workflow}{ +\enumerate{ +\item Fit a propensity score model +\item Apply \code{ps_trim()} to flag extreme values +\item Call \code{\link[=ps_refit]{ps_refit()}} to re-estimate propensity scores on the retained sample +\item Compute weights with \code{\link[=wt_ate]{wt_ate()}} or another weight function +} +} -\strong{NA handling}: Trimmed values are set to \code{NA}. Operations that don't handle -\code{NA} values will propagate them (e.g., \code{sum()} returns \code{NA} unless -\code{na.rm = TRUE}). +\subsection{Object behavior}{ -\strong{Metadata tracking}: The \code{trimmed_idx} and \code{keep_idx} are updated when -subsetting or reordering: -\itemize{ -\item Subsetting with \code{[} updates indices to new positions -\item \code{sort()} reorders data and updates indices accordingly -\item \code{unique()} may change lengths but preserves the class -\item \code{na.omit()} removes trimmed values and updates indices -} +Arithmetic operations on \code{ps_trim} objects return plain numeric vectors, +since transformed propensity scores (e.g., \code{1/ps}) are no longer propensity +scores. Trimmed values propagate as \code{NA} in calculations; use \code{na.rm = TRUE} +where appropriate. + +When combining \code{ps_trim} objects with \code{\link[=c]{c()}}, trimming parameters must match. +Mismatched parameters trigger a warning and return a numeric vector. -\strong{Combining behavior}: When combining \code{ps_trim} objects with \code{c()}, metadata -must match (same trimming parameters). Mismatched metadata triggers a warning -and returns a numeric vector. +Use \code{\link[=ps_trim_meta]{ps_trim_meta()}} to inspect the trimming metadata, including the method, +cutoffs, and which observations were retained or trimmed. +} } \examples{ - set.seed(2) n <- 300 x <- rnorm(n) @@ -107,25 +153,42 @@ z <- rbinom(n, 1, plogis(1.3 * x)) fit <- glm(z ~ x, family = binomial) ps <- predict(fit, type = "response") -ps_trim(ps, method = "adaptive") +# Fixed threshold trimming (default) +trimmed <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) +trimmed -# Coercion behavior with ps_trim objects -ps_trim1 <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) -ps_trim2 <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) +# How many observations were trimmed? +sum(is_unit_trimmed(trimmed)) -# Compatible objects combine silently -c(ps_trim1[1:50], ps_trim2[51:100]) # Returns ps_trim object +# Data-driven adaptive trimming +ps_trim(ps, method = "adaptive") -# Different trim parameters trigger warning -ps_trim3 <- ps_trim(ps, method = "ps", lower = 0.2, upper = 0.8) -c(ps_trim1[1:50], ps_trim3[51:100]) # Warning: returns numeric +# Quantile-based trimming at 5th and 95th percentiles +ps_trim(ps, method = "pctl") -# Cross-class combinations warn and return numeric -psw_obj <- psw(ps[1:50], estimand = "ate") -c(ps_trim1[1:50], psw_obj) # Warning: returns numeric +# Refit after trimming, then compute weights +trimmed <- ps_trim(ps, method = "adaptive") +refitted <- ps_refit(trimmed, fit) +wt_ate(refitted, .exposure = z) +} +\references{ +Crump, R. K., Hotz, V. J., Imbens, G. W., & Mitnik, O. A. (2009). Dealing +with limited overlap in estimation of average treatment effects. +\emph{Biometrika}, 96(1), 187--199. + +Walker, A. M., Patrick, A. R., Lauer, M. S., et al. (2013). A tool for +assessing the feasibility of comparative effectiveness research. +\emph{Comparative Effectiveness Research}, 3, 11--20. + +Yang, S., Imbens, G. W., Cui, Z., Faries, D. E., & Kadziola, Z. (2016). +Propensity score matching and subclassification in observational studies +with multi-level treatments. \emph{Biometrics}, 72(4), 1055--1065. } \seealso{ -\code{\link[=ps_trunc]{ps_trunc()}} for bounding/winsorizing instead of discarding, -\code{\link[=is_refit]{is_refit()}}, \code{\link[=is_ps_trimmed]{is_ps_trimmed()}} +\code{\link[=ps_trunc]{ps_trunc()}} for bounding (winsorizing) instead of discarding, +\code{\link[=ps_refit]{ps_refit()}} to re-estimate propensity scores after trimming, +\code{\link[=ps_calibrate]{ps_calibrate()}} for calibration-based adjustment, +\code{\link[=ps_trim_meta]{ps_trim_meta()}} to inspect trimming metadata, +\code{\link[=is_ps_trimmed]{is_ps_trimmed()}} and \code{\link[=is_unit_trimmed]{is_unit_trimmed()}} for logical queries. } diff --git a/man/ps_trim_meta.Rd b/man/ps_trim_meta.Rd index 6640d4d..94d75f1 100644 --- a/man/ps_trim_meta.Rd +++ b/man/ps_trim_meta.Rd @@ -2,16 +2,37 @@ % Please edit documentation in R/ps_trim.R \name{ps_trim_meta} \alias{ps_trim_meta} -\title{Extract \code{ps_trim} metadata} +\title{Extract trimming metadata from a \code{ps_trim} object} \usage{ ps_trim_meta(x) } \arguments{ -\item{x}{A \strong{\code{ps_trim}} object.} +\item{x}{A \code{ps_trim} object.} } \value{ -A named list of metadata. +A named list with elements: +\describe{ +\item{\code{method}}{Character string indicating the trimming method used.} +\item{\code{keep_idx}}{Integer vector of retained observation indices.} +\item{\code{trimmed_idx}}{Integer vector of trimmed observation indices.} +\item{\code{lower}, \code{upper}}{Numeric cutoffs, when applicable.} +\item{\code{refit}}{Logical, \code{TRUE} if the model was refit via \code{\link[=ps_refit]{ps_refit()}}.} +} +Additional method-specific elements (e.g. \code{cutoff}, \code{delta}, \code{lambda}) may +also be present. } \description{ -Returns the internal metadata list for a \code{ps_trim} object. +\code{ps_trim_meta()} returns the metadata list attached to a +\code{ps_trim} object by \code{\link[=ps_trim]{ps_trim()}}. +} +\examples{ +ps <- c(0.05, 0.3, 0.6, 0.95) +trimmed <- ps_trim(ps, method = "ps", lower = 0.1, upper = 0.9) + +ps_trim_meta(trimmed) + +} +\seealso{ +\code{\link[=ps_trim]{ps_trim()}} for trimming propensity scores, \code{\link[=is_ps_trimmed]{is_ps_trimmed()}} and +\code{\link[=is_unit_trimmed]{is_unit_trimmed()}} for predicate queries. } diff --git a/man/ps_trunc.Rd b/man/ps_trunc.Rd index e48576e..79fdb0c 100644 --- a/man/ps_trunc.Rd +++ b/man/ps_trunc.Rd @@ -18,117 +18,109 @@ ps_trunc( ) } \arguments{ -\item{ps}{The propensity score, either a numeric vector between 0 and 1 for -binary exposures, or a matrix/data.frame where each column represents -propensity scores for each level of a categorical exposure.} +\item{ps}{A numeric vector of propensity scores between 0 and 1 (binary +exposures), or a matrix/data.frame where each column contains propensity +scores for one level of a categorical exposure.} -\item{method}{One of \code{"ps"}, \code{"pctl"}, or \code{"cr"}. +\item{method}{One of \code{"ps"}, \code{"pctl"}, or \code{"cr"}: \itemize{ -\item \code{"ps"}: directly cut on \verb{[lower, upper]} of \code{ps}. For categorical, uses -symmetric truncation with \code{lower} as the threshold. -\item \code{"pctl"}: use quantiles of \code{ps} as bounding values. For categorical, -calculates quantiles across all propensity score values. -\item \code{"cr"}: the common range of \code{ps} given \code{.exposure}, bounding -\verb{[min(ps[treated]), max(ps[untreated])]} (binary only) +\item \code{"ps"} (default): Truncate directly on propensity score values. Values +outside \verb{[lower, upper]} are set to the nearest bound. For categorical +exposures, applies symmetric truncation using \code{lower} as the threshold +(delta) and renormalizes rows to sum to 1. +\item \code{"pctl"}: Truncate at quantiles of the propensity score distribution. +The \code{lower} and \code{upper} arguments specify quantile probabilities. For +categorical exposures, quantiles are computed across all columns. +\item \code{"cr"}: Truncate to the common range of propensity scores across +exposure groups (binary exposures only). Bounds are +\verb{[min(ps[focal]), max(ps[reference])]}. Requires \code{.exposure}. }} -\item{lower, upper}{Numeric or quantile bounds. If \code{NULL}, defaults vary by method. -For categorical exposures with method \code{"ps"}, \code{lower} represents the -truncation threshold (delta).} +\item{lower, upper}{Bounds for truncation. Interpretation depends on \code{method}: +\itemize{ +\item \code{method = "ps"}: Propensity score values (defaults: 0.1 and 0.9). For +categorical exposures, \code{lower} is the truncation threshold delta +(default: 0.01); \code{upper} is ignored. +\item \code{method = "pctl"}: Quantile probabilities (defaults: 0.05 and 0.95; +categorical defaults: 0.01 and 0.99). +\item \code{method = "cr"}: Ignored; bounds are determined by the data. +}} -\item{.exposure}{For method "cr", a binary exposure vector. For categorical -exposures, must be a factor or character vector.} +\item{.exposure}{An exposure vector. Required for method \code{"cr"} (binary +exposure vector) and for categorical exposures (factor or character vector) +with any method.} -\item{.focal_level}{For binary exposures, the value representing the focal group -(typically the treatment group). For categorical exposures with ATT or ATU estimands, -specifies the focal category. Must be one of the levels of the exposure variable. +\item{.focal_level}{The value of \code{.exposure} representing the focal +(treated) group. For binary exposures, defaults to the higher value. Required for \code{wt_att()} and \code{wt_atu()} with categorical exposures.} -\item{.reference_level}{For binary exposures, the value representing the reference group -(typically the control group). If not provided, it is automatically detected.} +\item{.reference_level}{The value of \code{.exposure} representing the reference +(control) group. Automatically detected if not supplied.} -\item{...}{Additional arguments passed to methods} +\item{...}{Additional arguments passed to methods.} \item{.treated}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{.focal_level} instead.} \item{.untreated}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{.reference_level} instead.} } \value{ -A \strong{\code{ps_trunc}} object (numeric vector or matrix). It has an attribute -\code{ps_trunc_meta} storing fields like \code{method}, \code{lower_bound}, and -\code{upper_bound}. +A \code{ps_trunc} object (a numeric vector for binary exposures, or a +matrix for categorical exposures). Use \code{\link[=ps_trunc_meta]{ps_trunc_meta()}} to inspect +metadata including \code{method}, \code{lower_bound}, \code{upper_bound}, and +\code{truncated_idx} (positions of modified values). } \description{ -\strong{\code{ps_trunc()}} sets out‐of‐range propensity scores to fixed bounding values -(a form of \emph{winsorizing}). This is an alternative to \code{\link[=ps_trim]{ps_trim()}}, which removes -(sets \code{NA}) instead of bounding and is then refit with \code{\link[=ps_refit]{ps_refit()}} +\code{ps_trunc()} bounds extreme propensity scores to fixed limits, replacing +out-of-range values with the boundary value (a form of \emph{winsorizing}). The +result is a vector or matrix of the same length and dimensions as \code{ps}, with +no observations removed. This contrasts with \code{\link[=ps_trim]{ps_trim()}}, which sets extreme +values to \code{NA} (effectively removing those observations from analysis). } \details{ -For binary exposures with each \eqn{ps[i]}: -\itemize{ -\item If \eqn{ps[i] < lower\_bound}, we set \eqn{ps[i] = lower\_bound}. -\item If \eqn{ps[i] > upper\_bound}, we set \eqn{ps[i] = upper\_bound}. -} +Unlike \code{\link[=ps_trim]{ps_trim()}}, truncation preserves all observations. No \code{NA} values +are introduced; out-of-range scores are replaced with the boundary value. -For categorical exposures: +For \strong{binary exposures}, each propensity score \eqn{e_i} is bounded: \itemize{ -\item Each value below the threshold is set to the threshold -\item Rows are renormalized to sum to 1 +\item If \eqn{e_i < l}, set \eqn{e_i = l} (the lower bound). +\item If \eqn{e_i > u}, set \eqn{e_i = u} (the upper bound). } -This approach is often called \emph{winsorizing}. - -\strong{Arithmetic behavior}: Like \code{ps_trim}, arithmetic operations on \code{ps_trunc} -objects return numeric vectors. The reasoning is the same - transformed -propensity scores (e.g., weights) are no longer propensity scores. +For \strong{categorical exposures}, values below the threshold are set to the +threshold and each row is renormalized to sum to 1. -\strong{No NA values}: Unlike \code{ps_trim}, truncation doesn't create \code{NA} values. -Out-of-range values are set to the boundaries, so all values remain finite -and valid for calculations. +\strong{Arithmetic behavior}: Arithmetic operations on \code{ps_trunc} objects return +plain numeric vectors. Once propensity scores are transformed (e.g., into +weights), the result is no longer a propensity score. -\strong{Metadata tracking}: The \code{truncated_idx} tracks which positions had their -values modified (winsorized to boundaries): -\itemize{ -\item Subsetting with \code{[} updates indices to new positions -\item \code{sort()} reorders data and updates indices accordingly -\item Operations preserve finite values (no \code{NA} handling needed) -} - -\strong{Boundary detection}: Values exactly at the boundaries (after truncation) -may indicate truncation, but aren't necessarily truncated - they could have -been at the boundary originally. - -\strong{Combining behavior}: When combining \code{ps_trunc} objects with \code{c()}, -truncation parameters must match. Mismatched parameters trigger a warning -and return a numeric vector. +\strong{Combining behavior}: Combining \code{ps_trunc} objects with \code{c()} requires +matching truncation parameters. Mismatched parameters produce a warning and +return a plain numeric vector. } \examples{ set.seed(2) -n <- 30 +n <- 200 x <- rnorm(n) -z <- rbinom(n, 1, plogis(0.4 * x)) +z <- rbinom(n, 1, plogis(1.2 * x)) fit <- glm(z ~ x, family = binomial) ps <- predict(fit, type = "response") -# truncate just the 99th percentile -ps_trunc(ps, method = "pctl", lower = 0, upper = .99) - -# Coercion behavior with ps_trunc objects -ps_trunc1 <- ps_trunc(ps, method = "ps", lower = 0.1, upper = 0.9) -ps_trunc2 <- ps_trunc(ps, method = "ps", lower = 0.1, upper = 0.9) +# Truncate to [0.1, 0.9] +ps_t <- ps_trunc(ps, method = "ps", lower = 0.1, upper = 0.9) +ps_t -# Compatible objects combine silently -c(ps_trunc1[1:15], ps_trunc2[16:30]) # Returns ps_trunc object +# Truncate at the 1st and 99th percentiles +ps_trunc(ps, method = "pctl", lower = 0.01, upper = 0.99) -# Different truncation parameters trigger warning -ps_trunc3 <- ps_trunc(ps, method = "ps", lower = 0.2, upper = 0.8) -c(ps_trunc1[1:15], ps_trunc3[16:30]) # Warning: returns numeric +# Use truncated scores to calculate weights +wt_ate(ps_t, .exposure = z) -# Mixing with other propensity classes warns -ps_trim_obj <- ps_trim(ps[1:15], method = "ps", lower = 0.1) -c(ps_trunc1[1:15], ps_trim_obj) # Warning: returns numeric +# Inspect which observations were truncated +is_unit_truncated(ps_t) } \seealso{ -\code{\link[=ps_trim]{ps_trim()}} and \code{\link[=ps_refit]{ps_refit()}} for removing extreme values vs. bounding +\code{\link[=ps_trim]{ps_trim()}} for removing (rather than bounding) extreme values, +\code{\link[=ps_refit]{ps_refit()}} for refitting the propensity model after trimming, +\code{\link[=is_ps_truncated]{is_ps_truncated()}}, \code{\link[=is_unit_truncated]{is_unit_truncated()}}, \code{\link[=ps_trunc_meta]{ps_trunc_meta()}} } diff --git a/man/ps_trunc_meta.Rd b/man/ps_trunc_meta.Rd index fb9cbf8..47842f9 100644 --- a/man/ps_trunc_meta.Rd +++ b/man/ps_trunc_meta.Rd @@ -2,16 +2,32 @@ % Please edit documentation in R/ps_trunc.R \name{ps_trunc_meta} \alias{ps_trunc_meta} -\title{Extract \code{ps_trunc} metadata} +\title{Extract truncation metadata from a \code{ps_trunc} object} \usage{ ps_trunc_meta(x) } \arguments{ -\item{x}{A \strong{\code{ps_trunc}} object.} +\item{x}{A \code{ps_trunc} object created by \code{\link[=ps_trunc]{ps_trunc()}}.} } \value{ -A named list of metadata. +A named list with truncation metadata, including: +\itemize{ +\item \code{method} -- the truncation method used (\code{"ps"}, \code{"pctl"}, or \code{"cr"}) +\item \code{lower_bound}, \code{upper_bound} -- the applied bounds +\item \code{truncated_idx} -- integer positions of values that were winsorized +} } \description{ -Returns the internal metadata list for a \code{ps_trunc} object. +Returns the metadata list attached to a \code{\link[=ps_trunc]{ps_trunc}} +object. The list includes fields such as \code{method}, \code{lower_bound}, +\code{upper_bound}, and \code{truncated_idx}. +} +\examples{ +ps <- c(0.02, 0.3, 0.5, 0.7, 0.98) +ps_t <- ps_trunc(ps, method = "ps", lower = 0.05, upper = 0.95) +ps_trunc_meta(ps_t) + +} +\seealso{ +\code{\link[=ps_trunc]{ps_trunc()}}, \code{\link[=is_ps_truncated]{is_ps_truncated()}}, \code{\link[=is_unit_truncated]{is_unit_truncated()}} } diff --git a/man/psw.Rd b/man/psw.Rd index c103cca..d1c89d4 100644 --- a/man/psw.Rd +++ b/man/psw.Rd @@ -9,7 +9,7 @@ \alias{as_psw} \alias{estimand} \alias{estimand<-} -\title{Create and Manipulate \code{psw} Objects} +\title{Propensity Score Weight Vectors} \usage{ new_psw( x = double(), @@ -43,89 +43,111 @@ estimand(wt) estimand(wt) <- value } \arguments{ -\item{x}{A numeric vector (default: \code{double()}).} +\item{x}{For \code{psw()} and \code{new_psw()}: a numeric vector of weights +(default: \code{double()}). For \code{is_psw()}, \code{is_causal_wt()}, and \code{as_psw()}: +an object to test or coerce.} -\item{estimand}{A character string representing the estimand (e.g., "ate", -"att", "ato"). Default is \code{NULL}.} +\item{estimand}{A character string identifying the target estimand (e.g., +\code{"ate"}, \code{"att"}, \code{"ato"}). Defaults to \code{NULL}.} -\item{stabilized}{A logical \code{TRUE}} +\item{stabilized}{Logical. Were the weights stabilized? Defaults to \code{FALSE}.} -\item{trimmed}{Logical, whether these weights came from a trimmed PS.} +\item{trimmed}{Logical. Were the weights derived from trimmed propensity +scores? Defaults to \code{FALSE}.} -\item{truncated}{Logical, whether these weights came from a truncated PS.} +\item{truncated}{Logical. Were the weights derived from truncated propensity +scores? Defaults to \code{FALSE}.} -\item{calibrated}{Logical, whether these weights came from a calibrated PS.} +\item{calibrated}{Logical. Were the weights derived from calibrated +propensity scores? Defaults to \code{FALSE}.} -\item{...}{Additional attributes to track in the weights.} +\item{...}{Additional attributes stored on the object (developer use only).} -\item{wt}{An object to check or convert.} +\item{wt}{A \code{psw} or \code{causal_wts} object.} -\item{value}{The value to add to the attribute.} +\item{value}{A character string: the new estimand to assign.} } \value{ \itemize{ -\item \code{new_psw()}: A \code{psw} object. -\item \code{psw()}: A \code{psw} object. -\item \code{is_psw()}: \code{TRUE} if the object is a \code{psw}, otherwise \code{FALSE}. -\item \code{as_psw()}: A \code{psw} object. -\item \code{estimand()}: The \code{estimand} attribute of a \code{psw} object. -\item \code{is_stabilized()}: The \code{stabilized} attribute of a \code{psw} object. +\item \code{new_psw()}, \code{psw()}, \code{as_psw()}: A \code{psw} vector. +\item \code{is_psw()}, \code{is_causal_wt()}, \code{is_stabilized()}: A single logical value. +\item \code{estimand()}: A character string, or \code{NULL} if no estimand is set. +\item \verb{estimand<-}: The modified \code{psw} object (called for its side effect). } } \description{ -Functions to create and manipulate \code{psw} objects, which are specialized -vectors for propensity score weights with optional \code{estimand} attributes. -Most users should use \code{\link[=wt_ate]{wt_ate()}} and friends, but these functions can help -extend the functionality of \code{psw} objects. +\code{psw} objects are numeric vectors that carry metadata about propensity score +weights, including the target estimand and whether the underlying propensity +scores were trimmed, truncated, or calibrated. + +Most users will encounter \code{psw} objects as return values from \code{\link[=wt_ate]{wt_ate()}} and +related weight functions. These constructor and helper functions are useful +for inspecting weight objects or for package developers extending propensity. } \details{ -The \code{psw} class is a vctrs-based S3 class that represents propensity score -weights. It extends numeric vectors with additional metadata tracking the -estimand type, stabilization status, and source transformations. +\subsection{Constructors}{ +\itemize{ +\item \code{psw()} is the \strong{user-facing} constructor. It coerces \code{x} to double and +validates inputs before creating the object. +\item \code{new_psw()} is the \strong{low-level} constructor intended for developers. It +assumes \code{x} is already a double vector and performs minimal validation. +\item \code{as_psw()} coerces an existing numeric vector to a \code{psw} object. +} +} -\strong{Arithmetic behavior}: Unlike \code{ps_trim} and \code{ps_trunc} objects, arithmetic -operations on \code{psw} objects preserve the class and attributes. This allows -weight manipulations like normalization (\code{weights / sum(weights)}) while -maintaining metadata. +\subsection{Queries}{ +\itemize{ +\item \code{is_psw()} tests whether an object is a \code{psw} vector. +\item \code{is_causal_wt()} tests whether an object inherits from the broader +\code{causal_wts} class (which includes \code{psw} objects). +\item \code{estimand()} and \verb{estimand<-} get and set the estimand attribute. +\item \code{is_stabilized()} returns \code{TRUE} if the weights are stabilized. +} +} -\strong{Combining behavior}: When combining \code{psw} objects with \code{c()}, the class -is preserved only if all metadata matches. Mismatched metadata triggers a -warning and returns a numeric vector. +\subsection{Arithmetic and combining}{ -\strong{Base R compatibility}: Most base R operations work seamlessly: -\itemize{ -\item Subsetting with \code{[} preserves class and attributes -\item Summary functions (\code{sum()}, \code{mean()}, etc.) return numeric values -\item Comparison operators return logical vectors -\item Works in data frames and with tidyverse functions +Arithmetic operations on \code{psw} objects preserve the class and attributes, +so operations like normalization (\code{weights / sum(weights)}) retain metadata. +Combining \code{psw} objects with \code{\link[=c]{c()}} preserves the class only when all +metadata matches; mismatched metadata produces a warning and falls back to a +plain numeric vector. + +Subsetting with \code{[} preserves class and attributes. Summary functions +(\code{\link[=sum]{sum()}}, \code{\link[=mean]{mean()}}, etc.) return plain numeric values. } } \examples{ -psw_weights <- new_psw(c(0.1, 0.2, 0.3), estimand = "ate") -is_psw(psw_weights) -estimand(psw_weights) - -psw_helper <- psw(c(0.5, 0.7), estimand = "att") -as_psw(c(0.1, 0.2), estimand = "ato") - -# Coercion behavior - compatible objects combine silently -x <- psw(c(0.5, 0.7), estimand = "ate") -y <- psw(c(0.3, 0.8), estimand = "ate") -c(x, y) # Returns psw object - -# Incompatible metadata triggers warning and returns numeric -x <- psw(c(0.5, 0.7), estimand = "ate") -y <- psw(c(0.3, 0.8), estimand = "att") -c(x, y) # Warning: returns numeric - -# Works with tidyr::pivot_longer for plotting -if (requireNamespace("tidyr", quietly = TRUE)) { - df <- data.frame( - id = 1:4, - ate_wts = psw(c(0.5, 0.7, 0.3, 0.8), estimand = "ate"), - att_wts = psw(c(0.4, 0.6, 0.2, 0.9), estimand = "att") - ) - # This will warn but succeed, returning numeric in the pivoted column - tidyr::pivot_longer(df, cols = c(ate_wts, att_wts)) +# Create psw objects directly +w <- psw(c(1.2, 0.8, 1.5), estimand = "ate") +w + +# Query metadata +is_psw(w) +estimand(w) +is_stabilized(w) + +# Coerce a plain numeric vector +as_psw(c(1.0, 2.0), estimand = "att") + +# Arithmetic preserves the psw class +w / sum(w) + +# Combining: compatible metadata is preserved +x <- psw(c(1.2, 0.8), estimand = "ate") +y <- psw(c(1.1, 0.9), estimand = "ate") +c(x, y) + +# Combining: incompatible metadata warns and returns numeric +x <- psw(c(1.2, 0.8), estimand = "ate") +y <- psw(c(1.1, 0.9), estimand = "att") +c(x, y) + } +\seealso{ +\code{\link[=wt_ate]{wt_ate()}}, \code{\link[=wt_att]{wt_att()}}, \code{\link[=wt_atu]{wt_atu()}}, \code{\link[=wt_atm]{wt_atm()}}, \code{\link[=wt_ato]{wt_ato()}} for +calculating propensity score weights (which return \code{psw} objects). + +\code{\link[=ps_trim]{ps_trim()}}, \code{\link[=ps_trunc]{ps_trunc()}}, and \code{\link[=ps_calibrate]{ps_calibrate()}} for modifying propensity +scores before weight calculation. } diff --git a/man/wt_ate.Rd b/man/wt_ate.Rd index 566f13d..08bc28d 100644 --- a/man/wt_ate.Rd +++ b/man/wt_ate.Rd @@ -16,7 +16,7 @@ \alias{wt_atc} \alias{wt_cens} \alias{wt_cens.data.frame} -\title{Calculate Propensity Score Weights for Causal Inference} +\title{Calculate propensity score weights} \usage{ wt_ate( .propensity, @@ -203,315 +203,269 @@ wt_cens( ) } \arguments{ -\item{.propensity}{Either a numeric vector of predicted probabilities, a -\code{data.frame} where each column corresponds to a level of the exposure, -or a fitted GLM object. For data frames, the second column is used by -default for binary exposures unless specified otherwise with -\code{.propensity_col}. For GLM objects, fitted values are extracted -automatically.} - -\item{.exposure}{The exposure variable. For binary exposures, a vector of 0s -and 1s; for continuous exposures, a numeric vector. When \code{.propensity} is -a GLM object, this argument is optional and will be extracted from the -model if not provided.} - -\item{.sigma}{For continuous exposures, a numeric vector of standard errors -used with \code{dnorm()}. For example, this can be derived from the influence -measures of a model (e.g., \code{influence(model)$sigma}).} - -\item{exposure_type}{Character string specifying the type of exposure. -Options are \code{"auto"}, \code{"binary"}, \code{"categorical"}, and \code{"continuous"}. -Defaults to \code{"auto"}, which detects the type automatically.} - -\item{.focal_level}{For binary exposures, the value representing the focal group -(typically the treatment group). For categorical exposures with ATT or ATU estimands, -specifies the focal category. Must be one of the levels of the exposure variable. +\item{.propensity}{Propensity scores in one of several forms: +\itemize{ +\item A \strong{numeric vector} of predicted probabilities (binary/continuous). +\item A \strong{data frame} or matrix with one column per exposure level +(categorical), or two columns for binary (see \code{.propensity_col}). +\item A fitted \strong{\code{glm}} object -- fitted values are extracted automatically. +\item A modified propensity score created by \code{\link[=ps_trim]{ps_trim()}}, \code{\link[=ps_trunc]{ps_trunc()}}, +\code{\link[=ps_refit]{ps_refit()}}, or \code{\link[=ps_calibrate]{ps_calibrate()}}. +}} + +\item{.exposure}{The exposure (treatment) variable. For binary exposures, a +numeric 0/1 vector, logical, or two-level factor. For categorical +exposures, a factor or character vector. For continuous exposures, a +numeric vector. Optional when \code{.propensity} is a \code{glm} object (extracted +from the model).} + +\item{.sigma}{Numeric vector of observation-level standard deviations for +continuous exposures (e.g., \code{influence(model)$sigma}). Extracted +automatically when \code{.propensity} is a \code{glm} object.} + +\item{exposure_type}{Type of exposure: \code{"auto"} (default), \code{"binary"}, +\code{"categorical"}, or \code{"continuous"}. \code{"auto"} detects the type from +\code{.exposure}.} + +\item{.focal_level}{The value of \code{.exposure} representing the focal +(treated) group. For binary exposures, defaults to the higher value. Required for \code{wt_att()} and \code{wt_atu()} with categorical exposures.} -\item{.reference_level}{For binary exposures, the value representing the reference group -(typically the control group). If not provided, it is automatically detected.} +\item{.reference_level}{The value of \code{.exposure} representing the reference +(control) group. Automatically detected if not supplied.} -\item{stabilize}{Logical indicating whether to stabilize the weights. For ATE -weights, stabilization multiplies the weight by either the mean of -\code{.exposure} or the supplied \code{stabilization_score}. Note: stabilization is only -supported for ATE and continuous exposures.} +\item{stabilize}{If \code{TRUE}, multiply weights by an estimate of the marginal +treatment probability (binary) or density (continuous). Only supported by +\code{wt_ate()} and \code{wt_cens()}. See \strong{Stabilization} in Details.} -\item{stabilization_score}{Optional numeric value for stabilizing the weights -(e.g., a predicted value from a regression model without predictors). Only -used when \code{stabilize} is \code{TRUE}.} +\item{stabilization_score}{Optional numeric value to use as the +stabilization multiplier instead of the default (the marginal mean of +\code{.exposure}). Ignored when \code{stabilize = FALSE}.} -\item{...}{Reserved for future expansion. Not currently used.} +\item{...}{These dots are for future extensions and must be empty.} \item{.treated}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{.focal_level} instead.} \item{.untreated}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Use \code{.reference_level} instead.} -\item{.propensity_col}{With a binary exposure, when \code{.propensity} is a data frame, specifies which -column to use for propensity scores. Can be a column name (quoted or -unquoted) or a numeric index. Defaults to the second column if available, -otherwise the first. For categorical exposures, the entire data frame is -used as a matrix of propensity scores.} +\item{.propensity_col}{Column to use when \code{.propensity} is a data frame +with a binary exposure. Accepts a column name (quoted or unquoted) or +numeric index. Defaults to the second column. Ignored for categorical +exposures, where all columns are used.} } \value{ -A \code{psw} object (a numeric vector) with additional attributes: +A \code{\link{psw}} vector (a double vector with class \code{psw}) carrying +these attributes: \itemize{ -\item \strong{estimand}: A description of the estimand (e.g., "ate", "att"). -\item \strong{stabilized}: A logical flag indicating if stabilization was applied. -\item \strong{trimmed}: A logical flag indicating if the weights are based on trimmed propensity scores. -\item \strong{truncated}: A logical flag indicating if the weights are based on truncated propensity scores. +\item \code{estimand}: character, e.g. \code{"ate"}, \code{"att"}, \code{"uncensored"}. +\item \code{stabilized}: logical, whether stabilization was applied. +\item \code{trimmed}: logical, whether the propensity scores were trimmed. +\item \code{truncated}: logical, whether the propensity scores were truncated. +\item \code{calibrated}: logical, whether the propensity scores were calibrated. } } \description{ -This family of functions computes propensity score weights for -various causal estimands: +Compute inverse probability weights for causal inference under different +estimands. Each function targets a different population: \itemize{ -\item \strong{ATE} (Average Treatment Effect) -\item \strong{ATT} (Average Treatment Effect on the Treated) -\item \strong{ATU} (Average Treatment Effect on the Untreated, sometimes called -the \strong{ATC}, where the "C" stands for "control"). \code{wt_atc()} is provided -as an alias for \code{wt_atu()} -\item \strong{ATM} (Average Treatment Effect for the Evenly Matchable) -\item \strong{ATO} (Average Treatment Effect for the Overlap population) -\item \strong{Entropy} (Average Treatment Effect for the Entropy-weighted population) -\item \strong{Censoring weights} can be calculated using \code{wt_cens()}, which uses -the same formula as ATE weights but with estimand "uncensored". These -are useful for handling censoring in survival analysis - -The propensity score can be provided as a numeric vector of predicted -probabilities, as a \code{data.frame} where each column represents the -predicted probability for a level of the exposure, or as a fitted -GLM object. They can also be propensity score objects created by -\code{\link[=ps_trim]{ps_trim()}}, \code{\link[=ps_refit]{ps_refit()}}, or \code{\link[=ps_trunc]{ps_trunc()}} - -The returned weights are encapsulated in a \code{psw} object, which is a numeric -vector with additional attributes that record the estimand, and whether the -weights have been stabilized, trimmed, or truncated. +\item \code{wt_ate()}: \strong{Average Treatment Effect} -- the full population. +\item \code{wt_att()}: \strong{Average Treatment Effect on the Treated} -- the treated +(focal) group. +\item \code{wt_atu()}: \strong{Average Treatment Effect on the Untreated} -- the +untreated (reference) group. \code{wt_atc()} is an alias. +\item \code{wt_atm()}: \strong{Average Treatment Effect for the Evenly Matchable} -- +units with the most overlap. +\item \code{wt_ato()}: \strong{Average Treatment Effect for the Overlap Population} -- +weights proportional to overlap. +\item \code{wt_entropy()}: \strong{Entropy-weighted Average Treatment Effect} -- +an entropy-balanced population. +\item \code{wt_cens()}: \strong{Inverse probability of censoring weights} -- uses the +same formula as \code{wt_ate()} but labels the estimand \code{"uncensored"}. Use +these to adjust for censoring in survival analysis, not for treatment +weighting. } + +\code{.propensity} accepts a numeric vector of predicted probabilities, a +\code{data.frame} of per-level probabilities, a fitted \code{glm} object, or a +modified propensity score created by \code{\link[=ps_trim]{ps_trim()}}, \code{\link[=ps_trunc]{ps_trunc()}}, +\code{\link[=ps_refit]{ps_refit()}}, or \code{\link[=ps_calibrate]{ps_calibrate()}}. + +All functions return a \code{\link{psw}} object -- a numeric vector that tracks the +estimand, stabilization status, and any trimming or truncation applied. } \details{ -\subsection{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. -} - -\subsection{Mathematical Formulas}{ -\subsection{Binary Exposures}{ +\subsection{Exposure types}{ -For binary treatments (\eqn{A = 0} or \eqn{1}), the weights are: +All weight functions support binary exposures. \code{wt_ate()} and \code{wt_cens()} +also support continuous exposures. All except \code{wt_cens()} support +categorical exposures. \itemize{ -\item \strong{ATE}: \eqn{w = \frac{A}{e(X)} + \frac{1-A}{1-e(X)}} -\item \strong{ATT}: \eqn{w = A + \frac{(1-A) \cdot e(X)}{1-e(X)}} -\item \strong{ATU}: \eqn{w = \frac{A \cdot (1-e(X))}{e(X)} + (1-A)} -\item \strong{ATM}: \eqn{w = \frac{\min(e(X), 1-e(X))}{A \cdot e(X) + (1-A) \cdot (1-e(X))}} -\item \strong{ATO}: \eqn{w = A \cdot (1-e(X)) + (1-A) \cdot e(X)} -\item \strong{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)]} +\item \strong{Binary}: \code{.exposure} is a two-level vector (e.g., 0/1, logical, or a +two-level factor). \code{.propensity} is a numeric vector of P(treatment | X). +\item \strong{Categorical}: \code{.exposure} is a factor or character vector with 3+ +levels. \code{.propensity} must be a matrix or data frame with one column per +level, where rows sum to 1. +\item \strong{Continuous}: \code{.exposure} is a numeric vector. \code{.propensity} is a +vector of conditional means (fitted values). Weights use a normal density +ratio; stabilization is strongly recommended. +\item \strong{Auto} (default): Detects the exposure type from \code{.exposure}. } } -\subsection{Continuous Exposures}{ +\subsection{Stabilization}{ -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}. +Setting \code{stabilize = TRUE} multiplies the base weight by an estimate of +P(A) (binary) or f_A(A) (continuous), reducing variance. When no +\code{stabilization_score} is supplied, the marginal mean of \code{.exposure} is +used. Stabilization is supported for ATE and censoring weights +(\code{wt_ate()} and \code{wt_cens()}) and is strongly recommended for continuous +exposures. } -\subsection{Categorical Exposures}{ +\subsection{Handling extreme weights}{ -For categorical treatments with \eqn{K} levels, weights use a tilting function approach: -\eqn{w_i = \frac{h(e_i)}{e_{i,Z_i}}}, where \eqn{e_{i,Z_i}} is the propensity score for unit \eqn{i}'s -observed treatment level, and \eqn{h(e_i)} is a tilting function that depends on the estimand: +Extreme weights signal positivity violations, poor model fit, or limited +overlap. You can address them by: \itemize{ -\item \strong{ATE}: \eqn{h(e) = 1} -\item \strong{ATT}: \eqn{h(e) = e_{focal}} (propensity score for the focal category) -\item \strong{ATU}: \eqn{h(e) = 1 - e_{focal}} (complement of focal category propensity) -\item \strong{ATM}: \eqn{h(e) = \min(e_1, ..., e_K)} -\item \strong{ATO}: \eqn{h(e) = 1 / \sum_k(1/e_k)} (reciprocal of harmonic mean denominator) -\item \strong{Entropy}: \eqn{h(e) = -\sum_k[e_k \cdot \log(e_k)]} (entropy of propensity scores) -} +\item Choosing an overlap-focused estimand (\code{wt_ato()}, \code{wt_atm()}, +\code{wt_entropy()}), which down-weight units in regions of poor overlap. +\item Trimming (\code{\link[=ps_trim]{ps_trim()}}) or truncating (\code{\link[=ps_trunc]{ps_trunc()}}) propensity scores +before computing weights. +\item Calibrating weights with \code{\link[=ps_calibrate]{ps_calibrate()}}. +\item Stabilizing ATE weights (\code{stabilize = TRUE}). } +See the \href{https://CRAN.R-project.org/package=halfmoon}{halfmoon} package +for weight diagnostics and visualization. } -\subsection{Exposure Types}{ +\subsection{Weight formulas}{ +\subsection{Binary exposures}{ -The functions support different types of exposures: +For binary treatments (\eqn{A \in \{0, 1\}}), with propensity score +\eqn{e(X) = P(A=1 \mid X)}: \itemize{ -\item \strong{\code{binary}}: For dichotomous treatments (e.g. 0/1). -\item \strong{\code{continuous}}: For numeric exposures. Here, weights are calculated via the normal density using -\code{dnorm()}. -\item \strong{\code{categorical}}: For exposures with more than 2 categories. Requires \code{.propensity} to be a -matrix or data frame with columns representing propensity scores for each category. -\item \strong{\code{auto}}: Automatically detects the exposure type based on \code{.exposure}. +\item \strong{ATE}: \eqn{w = \frac{A}{e(X)} + \frac{1-A}{1-e(X)}} +\item \strong{ATT}: \eqn{w = A + \frac{(1-A) \cdot e(X)}{1-e(X)}} +\item \strong{ATU}: \eqn{w = \frac{A \cdot (1-e(X))}{e(X)} + (1-A)} +\item \strong{ATM}: \eqn{w = \frac{\min(e(X), 1-e(X))}{A \cdot e(X) + (1-A) \cdot (1-e(X))}} +\item \strong{ATO}: \eqn{w = A \cdot (1-e(X)) + (1-A) \cdot e(X)} +\item \strong{Entropy}: \eqn{w = \frac{h(e(X))}{A \cdot e(X) + (1-A) \cdot (1-e(X))}}, where \eqn{h(e) = -[e \log(e) + (1-e) \log(1-e)]} } } -\subsection{Stabilization}{ +\subsection{Continuous exposures}{ -For ATE weights, stabilization can improve the performance of the estimator -by reducing variance. When \code{stabilize} is \code{TRUE} and no -\code{stabilization_score} is provided, the weights are multiplied by the mean -of \code{.exposure}. Alternatively, if a \code{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. +Weights use the density ratio +\eqn{w = f_A(A) / f_{A|X}(A \mid X)}, where \eqn{f_A} is the marginal +density and \eqn{f_{A|X}} is the conditional density (both assumed +normal). Only \code{wt_ate()} and \code{wt_cens()} support continuous exposures. } -\subsection{Weight Properties and Diagnostics}{ +\subsection{Categorical exposures}{ -Extreme weights can indicate: +For \eqn{K}-level treatments, weights take the tilting-function form +\eqn{w_i = h(\mathbf{e}_i) / e_{i,Z_i}}, where \eqn{e_{i,Z_i}} is the +propensity for unit \eqn{i}'s observed level and \eqn{h(\cdot)} depends +on the estimand: \itemize{ -\item Positivity violations (near 0 or 1 propensity scores) -\item Poor model specification -\item Lack of overlap between treatment groups +\item \strong{ATE}: \eqn{h(\mathbf{e}) = 1} +\item \strong{ATT}: \eqn{h(\mathbf{e}) = e_{\text{focal}}} +\item \strong{ATU}: \eqn{h(\mathbf{e}) = 1 - e_{\text{focal}}} +\item \strong{ATM}: \eqn{h(\mathbf{e}) = \min(e_1, \ldots, e_K)} +\item \strong{ATO}: \eqn{h(\mathbf{e}) = \bigl(\sum_k 1/e_k\bigr)^{-1}} +\item \strong{Entropy}: \eqn{h(\mathbf{e}) = -\sum_k e_k \log(e_k)} } - -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. } -\subsection{Trimmed and Truncated Weights}{ - -In addition to the standard weight functions, versions exist for trimmed -and truncated propensity score weights created by \code{\link[=ps_trim]{ps_trim()}}, -\code{\link[=ps_trunc]{ps_trunc()}}, and \code{\link[=ps_refit]{ps_refit()}}. These variants calculate the weights using -modified propensity scores (trimmed or truncated) and update the estimand -attribute accordingly. } } \examples{ -## Basic Usage with Binary Exposures - -# Simulate a simple dataset +# -- Binary exposure, numeric propensity scores ---------------------- 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) - -# With explicit focal and reference levels -weights_att_explicit <- wt_att(propensity_scores, treatment, - .focal_level = 1, .reference_level = 0) -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 +ps <- runif(100, 0.1, 0.9) +trt <- rbinom(100, 1, ps) -## Stabilized Weights +wt_ate(ps, trt) +wt_att(ps, trt) +wt_atu(ps, trt) +wt_atm(ps, trt) +wt_ato(ps, trt) +wt_entropy(ps, trt) -# Stabilization reduces variance -weights_ate_stab <- wt_ate(propensity_scores, treatment, stabilize = TRUE) +# Stabilized ATE weights (reduces variance) +wt_ate(ps, trt, stabilize = TRUE) -## Handling Extreme Propensity Scores +# Inspect the result +w <- wt_ate(ps, trt) +estimand(w) +summary(w) -# Create data with positivity violations +# -- Overlap-focused estimands handle extreme PS better -------------- 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) +max(wt_ate(ps_extreme, trt_extreme)) +max(wt_ato(ps_extreme, trt_extreme)) -# ATO weights are bounded -wt_extreme_ato <- wt_ato(ps_extreme, trt_extreme) -# Much more reasonable -max(wt_extreme_ato) -# but they target a different population -estimand(wt_extreme_ato) # "ato" +# -- From a fitted GLM ----------------------------------------------- +x1 <- rnorm(100) +x2 <- rnorm(100) +trt2 <- rbinom(100, 1, plogis(0.5 * x1 + 0.3 * x2)) +ps_model <- glm(trt2 ~ x1 + x2, family = binomial) -## Working with Data Frames +# Exposure is extracted from the model automatically +wt_ate(ps_model) -# Example with custom data frame +# -- Data frame input ------------------------------------------------ ps_df <- data.frame( control = c(0.9, 0.7, 0.3, 0.1), treated = c(0.1, 0.3, 0.7, 0.9) ) exposure <- c(0, 0, 1, 1) - -# Uses second column by default (treated probabilities) wt_ate(ps_df, exposure) - -# Explicitly specify column by name wt_ate(ps_df, exposure, .propensity_col = "treated") -# Or by position -wt_ate(ps_df, exposure, .propensity_col = 2) - -## Working with GLM Objects - -# Fit a propensity score model -set.seed(123) -n <- 100 -x1 <- rnorm(n) -x2 <- rnorm(n) -treatment <- rbinom(n, 1, plogis(0.5 * x1 + 0.3 * x2)) - -ps_model <- glm(treatment ~ x1 + x2, family = binomial) - -# Use GLM directly for weight calculation -weights_from_glm <- wt_ate(ps_model, treatment) - -# Or omit the exposure argument (it will be extracted from the GLM) -weights_from_glm_auto <- wt_ate(ps_model) +# -- Censoring weights ----------------------------------------------- +cens_ps <- runif(50, 0.6, 0.95) +cens_ind <- rbinom(50, 1, cens_ps) +wt_cens(cens_ps, cens_ind) +estimand(wt_cens(cens_ps, cens_ind)) # "uncensored" } \references{ -For detailed guidance on causal inference in R, see \href{https://www.r-causal.org/}{\emph{Causal Inference in R}} -by Malcolm Barrett, Lucy D'Agostino McGowan, and Travis Gerke. -\subsection{Foundational Papers}{ +Barrett, M., D'Agostino McGowan, L., & Gerke, T. \emph{Causal Inference in R}. +\url{https://www.r-causal.org/} Rosenbaum, P. R., & Rubin, D. B. (1983). The central role of the propensity -score in observational studies for causal effects. \emph{Biometrika}, 70(1), 41-55. -} - -\subsection{Estimand-Specific Methods}{ +score in observational studies for causal effects. \emph{Biometrika}, 70(1), +41--55. Li, L., & Greene, T. (2013). A weighting analogue to pair matching in -propensity score analysis. \emph{The International Journal of Biostatistics}, 9(2), -215-234. (ATM weights) +propensity score analysis. \emph{The International Journal of Biostatistics}, +9(2), 215--234. (ATM weights) Li, F., Morgan, K. L., & Zaslavsky, A. M. (2018). Balancing covariates via -propensity score weighting. \emph{Journal of the American Statistical Association}, -113(521), 390-400. (ATO weights) +propensity score weighting. \emph{Journal of the American Statistical +Association}, 113(521), 390--400. (ATO weights) Zhou, Y., Matsouaka, R. A., & Thomas, L. (2020). Propensity score weighting under limited overlap and model misspecification. \emph{Statistical Methods in -Medical Research}, 29(12), 3721-3756. (Entropy weights) -} - -\subsection{Continuous Exposures}{ +Medical Research}, 29(12), 3721--3756. (Entropy weights) Hirano, K., & Imbens, G. W. (2004). The propensity score with continuous -treatments. \emph{Applied Bayesian Modeling and Causal Inference from -Incomplete-Data Perspectives}, 226164, 73-84. -} - -\subsection{Practical Guidance}{ +treatments. In \emph{Applied Bayesian Modeling and Causal Inference from +Incomplete-Data Perspectives} (pp. 73--84). 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. -\emph{Statistics in Medicine}, 34(28), 3661-3679. -} +using inverse probability of treatment weighting (IPTW). \emph{Statistics in +Medicine}, 34(28), 3661--3679. } \seealso{ \itemize{ -\item \code{\link[=psw]{psw()}} for details on the structure of the returned weight objects. -\item \code{\link[=ps_trim]{ps_trim()}}, \code{\link[=ps_trunc]{ps_trunc()}}, and \code{\link[=ps_refit]{ps_refit()}} for handling extreme weights. -\item \code{\link[=ps_calibrate]{ps_calibrate()}} for calibrating weights. +\item \code{\link[=psw]{psw()}} for the returned weight vector class. +\item \code{\link[=ps_trim]{ps_trim()}}, \code{\link[=ps_trunc]{ps_trunc()}}, \code{\link[=ps_refit]{ps_refit()}}, and \code{\link[=ps_calibrate]{ps_calibrate()}} for +modifying propensity scores before weighting. +\item \code{\link[=ipw]{ipw()}} for inverse-probability-weighted estimation of causal effects. } } diff --git a/tests/testthat/test-ps_trim-base-methods.R b/tests/testthat/test-ps_trim-base-methods.R index dff7086..817cefc 100644 --- a/tests/testthat/test-ps_trim-base-methods.R +++ b/tests/testthat/test-ps_trim-base-methods.R @@ -399,7 +399,7 @@ test_that("ps_trim handles values exactly at boundaries", { # Values exactly at boundaries should be kept boundary_vals <- c(0.2, 0.5, 0.8) trimmed <- ps_trim(boundary_vals, method = "ps", lower = 0.2, upper = 0.8) - expect_false(any(is.na(trimmed))) + expect_false(anyNA(trimmed)) expect_equal(as.numeric(trimmed), boundary_vals) expect_equal(ps_trim_meta(trimmed)$keep_idx, 1:3) diff --git a/tests/testthat/test-ps_trim-categorical.R b/tests/testthat/test-ps_trim-categorical.R index 41ddd6a..9ec2dbf 100644 --- a/tests/testthat/test-ps_trim-categorical.R +++ b/tests/testthat/test-ps_trim-categorical.R @@ -32,7 +32,7 @@ test_that("ps_trim works with matrix propensity scores for symmetric trimming", # Check that trimmed rows are NA expect_true(all(is.na(trimmed[meta$trimmed_idx, ]))) - expect_false(any(is.na(trimmed[meta$keep_idx, ]))) + expect_false(anyNA(trimmed[meta$keep_idx, ])) }) test_that("ps_trim works with data.frame propensity scores", { @@ -357,7 +357,7 @@ test_that("ps_trim optimal trimming matches PSweight for multi-category", { ) trt_probs <- trt_probs / rowSums(trt_probs) - trt <- factor(apply(trt_probs, 1, function(p) sample(1:4, 1, prob = p))) + trt <- factor(apply(trt_probs, 1, function(p) sample.int(4, 1, prob = p))) test_data <- data.frame( trt = trt, @@ -524,7 +524,7 @@ test_that("ps_refit works with categorical propensity score trimming", { # Kept observations should have valid propensity scores kept_ps <- refitted_ps[refit_meta$keep_idx, ] - expect_false(any(is.na(kept_ps))) + expect_false(anyNA(kept_ps)) expect_true(all(kept_ps >= 0)) expect_true(all(kept_ps <= 1)) diff --git a/tests/testthat/test-ps_trim.R b/tests/testthat/test-ps_trim.R index 46c4dbd..0432d80 100644 --- a/tests/testthat/test-ps_trim.R +++ b/tests/testthat/test-ps_trim.R @@ -336,7 +336,7 @@ test_that("adaptive method: triggers uniroot path (k < 0) coverage", { out_data <- as.numeric(out_adapt) # Just confirm there's at least some NA for the extreme values # e.g. near 0.001 or 0.999 - expect_true(any(is.na(out_data))) + expect_true(anyNA(out_data)) }) test_that("Check defaults for helper functions", { @@ -600,7 +600,7 @@ test_that("ps_trim index tracking works when combining objects", { # Check that NA values are at the correct positions combined_data <- vec_data(combined) expect_true(all(is.na(combined_data[combined_meta$trimmed_idx]))) - expect_true(all(!is.na(combined_data[combined_meta$keep_idx]))) + expect_true(!anyNA(combined_data[combined_meta$keep_idx])) }) test_that("ps_trim warns when combining objects with different parameters", { @@ -675,5 +675,5 @@ test_that("ps_trim handles multiple combines correctly", { expect_true(all(is.na(combined_data[combined_meta$trimmed_idx]))) # All kept indices should have non-NA values - expect_true(all(!is.na(combined_data[combined_meta$keep_idx]))) + expect_true(!anyNA(combined_data[combined_meta$keep_idx])) }) diff --git a/tests/testthat/test-vctrs-base-methods.R b/tests/testthat/test-vctrs-base-methods.R index 157ea43..902d279 100644 --- a/tests/testthat/test-vctrs-base-methods.R +++ b/tests/testthat/test-vctrs-base-methods.R @@ -249,7 +249,7 @@ test_that("is.finite/is.infinite work for ps_trim", { inf <- is.infinite(x) expect_type(inf, "logical") - expect_true(all(!inf[!is.na(x)])) # Non-NA values should not be infinite + expect_true(!any(inf[!is.na(x)])) # Non-NA values should not be infinite }) test_that("is.finite/is.infinite work for ps_trunc", { @@ -261,7 +261,7 @@ test_that("is.finite/is.infinite work for ps_trunc", { inf <- is.infinite(x) expect_type(inf, "logical") - expect_true(all(!inf)) # No truncated values should be infinite + expect_true(!any(inf)) # No truncated values should be infinite }) # ============================================================================= @@ -297,7 +297,7 @@ test_that("is.na/anyNA work for ps_trunc", { na_check <- is.na(x) expect_type(na_check, "logical") - expect_true(all(!na_check)) # Truncation doesn't create NAs + expect_true(!any(na_check)) # Truncation doesn't create NAs any_na <- anyNA(x) expect_type(any_na, "logical") diff --git a/tests/testthat/test-weight-integration-categorical.R b/tests/testthat/test-weight-integration-categorical.R index 3d6259c..7adf288 100644 --- a/tests/testthat/test-weight-integration-categorical.R +++ b/tests/testthat/test-weight-integration-categorical.R @@ -29,7 +29,7 @@ test_that("weight functions work with trimmed categorical propensity scores", { # Check that weights are NA for trimmed units meta <- ps_trim_meta(trimmed_ps) expect_true(all(is.na(wt_ate_trimmed[meta$trimmed_idx]))) - expect_true(all(!is.na(wt_ate_trimmed[meta$keep_idx]))) + expect_true(!anyNA(wt_ate_trimmed[meta$keep_idx])) }) test_that("weight functions work with truncated categorical propensity scores", { @@ -59,7 +59,7 @@ test_that("weight functions work with truncated categorical propensity scores", expect_equal(estimand(wt_ate_truncated), "ate; truncated") # No weights should be NA for truncation - expect_true(all(!is.na(wt_ate_truncated))) + expect_true(!anyNA(wt_ate_truncated)) }) test_that("weight functions work with data.frame propensity scores for categorical", { @@ -215,7 +215,7 @@ test_that("weight functions work with refitted trimmed categorical propensity sc # Check that weights are NA for trimmed units meta <- ps_trim_meta(refitted_ps) expect_true(all(is.na(wt_ate_refitted[meta$trimmed_idx]))) - expect_true(all(!is.na(wt_ate_refitted[meta$keep_idx]))) + expect_true(!anyNA(wt_ate_refitted[meta$keep_idx])) }) test_that("truncated categorical propensity scores don't trigger refit warning", { @@ -245,5 +245,5 @@ test_that("truncated categorical propensity scores don't trigger refit warning", expect_equal(estimand(wt_ate_truncated), "ate; truncated") # No weights should be NA for truncation - expect_true(all(!is.na(wt_ate_truncated))) + expect_true(!anyNA(wt_ate_truncated)) }) diff --git a/tests/testthat/test-weights.R b/tests/testthat/test-weights.R index 794de7e..d683467 100644 --- a/tests/testthat/test-weights.R +++ b/tests/testthat/test-weights.R @@ -1,5 +1,5 @@ test_that("wt_atc is an alias for wt_atu", { - ps <- c(.1, .3, .4, .3) + ps <- c(0.1, 0.3, 0.4, 0.3) exposure <- c(0, 0, 1, 0) # Compare results from wt_atu and wt_atc @@ -101,7 +101,7 @@ test_that("wt_atc works with all object types", { }) test_that("psw objects can be multiplied together", { - ps <- c(.1, .3, .4, .3) + ps <- c(0.1, 0.3, 0.4, 0.3) exposure <- c(0, 0, 1, 0) # Create ATE and censoring weights @@ -157,7 +157,7 @@ test_that("psw objects can be multiplied together", { }) test_that("wt_cens uses ATE formula with uncensored estimand", { - ps <- c(.1, .3, .4, .3) + ps <- c(0.1, 0.3, 0.4, 0.3) exposure <- c(0, 0, 1, 0) # Get weights from wt_ate and wt_cens @@ -234,13 +234,13 @@ test_that("wt_cens uses ATE formula with uncensored estimand", { test_that("ATE works for binary cases", { withr::local_options(propensity.quiet = FALSE) expect_message( - weights <- wt_ate(c(.1, .3, .4, .3), .exposure = c(0, 0, 1, 0)), + weights <- wt_ate(c(0.1, 0.3, 0.4, 0.3), .exposure = c(0, 0, 1, 0)), "Treating `.exposure` as binary" ) expect_silent( weights2 <- wt_ate( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), .exposure = c(0, 0, 1, 0), exposure_type = "binary" ) @@ -251,7 +251,7 @@ test_that("ATE works for binary cases", { withr::local_options(propensity.quiet = FALSE) expect_message( weights3 <- wt_ate( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), .exposure = as.logical(c(0, 0, 1, 0)) ), "Treating `.exposure` as binary" @@ -261,7 +261,7 @@ test_that("ATE works for binary cases", { expect_silent( weights4 <- wt_ate( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), .exposure = c(2, 2, 1, 2), exposure_type = "binary", .reference_level = 2 @@ -272,7 +272,7 @@ test_that("ATE works for binary cases", { expect_propensity_error( wt_ate( - c(-.1, .3, .4, 3.3), + c(-0.1, 0.3, 0.4, 3.3), .exposure = c(0, 0, 1, 0), exposure_type = "binary" ) @@ -286,7 +286,7 @@ test_that("ATE works for binary cases", { withr::local_options(propensity.quiet = FALSE) expect_message( weights5 <- wt_ate( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), exposure_type = "binary", .exposure = .exposure ), @@ -298,7 +298,7 @@ test_that("ATE works for binary cases", { expect_equal( weights, psw(c(1.11, 1.43, 2.50, 1.43), "ate"), - tolerance = .01 + tolerance = 0.01 ) }) @@ -370,7 +370,7 @@ test_that("ATE errors appropriately for categorical with vector propensity score # For categorical exposures, propensity scores must be a matrix expect_propensity_error( wt_ate( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), .exposure = c(0, 2, 1, 4), exposure_type = "categorical" ) @@ -657,13 +657,13 @@ test_that("wt_ato.ps_trim triggers refit check, sets 'ato; trimmed'", { test_that("wt_entropy works for binary cases", { withr::local_options(propensity.quiet = FALSE) expect_message( - weights <- wt_entropy(c(.1, .3, .4, .3), .exposure = c(0, 0, 1, 0)), + weights <- wt_entropy(c(0.1, 0.3, 0.4, 0.3), .exposure = c(0, 0, 1, 0)), "Treating `.exposure` as binary" ) expect_silent( weights2 <- wt_entropy( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), .exposure = c(0, 0, 1, 0), exposure_type = "binary" ) @@ -674,7 +674,7 @@ test_that("wt_entropy works for binary cases", { withr::local_options(propensity.quiet = FALSE) expect_message( weights3 <- wt_entropy( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), .exposure = as.logical(c(0, 0, 1, 0)) ), "Treating `.exposure` as binary" @@ -684,7 +684,7 @@ test_that("wt_entropy works for binary cases", { expect_silent( weights4 <- wt_entropy( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), .exposure = c(2, 2, 1, 2), exposure_type = "binary", .reference_level = 2 @@ -695,7 +695,7 @@ test_that("wt_entropy works for binary cases", { expect_propensity_error( wt_entropy( - c(-.1, .3, .4, 3.3), + c(-0.1, 0.3, 0.4, 3.3), .exposure = c(0, 0, 1, 0), exposure_type = "binary" ) @@ -709,7 +709,7 @@ test_that("wt_entropy works for binary cases", { withr::local_options(propensity.quiet = FALSE) expect_message( weights5 <- wt_entropy( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), exposure_type = "binary", .exposure = .exposure ), @@ -788,7 +788,7 @@ test_that("entropy weights handle extreme propensity scores", { }) test_that("wt_entropy works with ps_trim objects", { - ps <- c(.1, .3, .4, .3) + ps <- c(0.1, 0.3, 0.4, 0.3) ps_trimmed <- ps_trim(ps, method = "ps", lower = 0.15, upper = 0.85) expect_propensity_warning( @@ -805,7 +805,7 @@ test_that("wt_entropy works with ps_trim objects", { }) test_that("wt_entropy works with ps_trunc objects", { - ps <- c(.1, .3, .4, .3) + ps <- c(0.1, 0.3, 0.4, 0.3) ps_truncated <- ps_trunc(ps, lower = 0.15, upper = 0.85) weights <- wt_entropy( @@ -823,7 +823,7 @@ test_that("entropy weights error on unsupported exposure types", { # For categorical exposures, propensity scores must be a matrix expect_propensity_error( wt_entropy( - c(.1, .3, .4, .3), + c(0.1, 0.3, 0.4, 0.3), .exposure = c(1, 2, 3, 4), exposure_type = "categorical" ) @@ -1745,7 +1745,7 @@ test_that("all methods handle NAs appropriately", { for (fn in list(wt_ate, wt_att, wt_atu, wt_atm, wt_ato, wt_entropy)) { weights <- fn(ps_na, exposure_na, exposure_type = "binary") expect_s3_class(weights, "psw") - expect_true(any(is.na(weights))) + expect_true(anyNA(weights)) } # Exposure with NAs @@ -1755,7 +1755,7 @@ test_that("all methods handle NAs appropriately", { for (fn in list(wt_ate, wt_att, wt_atu, wt_atm, wt_ato, wt_entropy)) { weights <- fn(ps_good, exposure_with_na, exposure_type = "binary") expect_s3_class(weights, "psw") - expect_true(any(is.na(weights))) + expect_true(anyNA(weights)) } # Data frame with NAs @@ -1767,7 +1767,7 @@ test_that("all methods handle NAs appropriately", { # Data frame with NAs produces NA weights weights_df_na <- wt_ate(df_na, c(0, 1, 0), exposure_type = "binary") expect_s3_class(weights_df_na, "psw") - expect_true(any(is.na(weights_df_na))) + expect_true(anyNA(weights_df_na)) # GLM predictions with NAs set.seed(789) diff --git a/vignettes/propensity.Rmd b/vignettes/propensity.Rmd new file mode 100644 index 0000000..1dba6ef --- /dev/null +++ b/vignettes/propensity.Rmd @@ -0,0 +1,331 @@ +--- +title: "Getting Started with propensity" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Getting Started with propensity} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +This vignette walks through the core propensity score weighting workflow: +fitting a propensity score model, calculating weights, and estimating causal +effects with `ipw()`. We'll also cover what to do when propensity scores are +extreme. + +## Setup + +```{r setup} +library(propensity) +``` + +We'll work with a simulated dataset throughout. There are two confounders +(`x1` and `x2`), a binary exposure (`z`), and a binary outcome (`y`): + +```{r simulate-data} +set.seed(42) +n <- 100 +x1 <- rnorm(n) +x2 <- rnorm(n) +z <- rbinom(n, 1, plogis(0.5 * x1 + 0.3 * x2)) +y <- rbinom(n, 1, plogis(-0.5 + 0.8 * z + 0.3 * x1 + 0.2 * x2)) +dat <- data.frame(x1, z, y, x2) +``` + +Both `x1` and `x2` affect treatment and outcome, so we need to adjust for +them. + +## Basic workflow + +### Step 1: Fit a propensity score model + +Start with a model for treatment assignment. Here we use logistic regression: + +```{r step1} +ps_mod <- glm(z ~ x1 + x2, data = dat, family = binomial()) +``` + +### Step 2: Calculate weights and fit a weighted outcome model + +Pass the fitted model directly to `wt_ate()` to get ATE weights. It pulls +out the fitted values and exposure for you: + +```{r step2} +wts <- wt_ate(ps_mod) +outcome_mod <- glm(y ~ z, data = dat, family = binomial(), weights = wts) +``` + +`wt_ate()` returns a `psw` object, which is just a numeric vector with some +extra metadata attached: + +```{r psw-inspect} +estimand(wts) +is_stabilized(wts) +``` + +You can also pass propensity scores as a plain numeric vector. In that case +you need to supply the exposure too: + +```{r data-frame-input} +ps <- fitted(ps_mod) +wt_ate(ps, dat$z) +``` + +### Step 3: Estimate causal effects + +`ipw()` takes the propensity score model and the weighted outcome model and +returns causal effect estimates. The standard errors use linearization to +account for the fact that the propensity scores are estimated: + +```{r step3} +result <- ipw(ps_mod, outcome_mod) +result +``` + +## Choosing an estimand + +Each estimand targets a different population: + +| Estimand | Target population | Function | +|----------|-------------------|----------| +| ATE | Entire study population | `wt_ate()` | +| ATT | Treated (focal) group | `wt_att()` | +| ATU | Untreated (reference) group | `wt_atu()` | +| ATO | Overlap population | `wt_ato()` | +| ATM | Matched population | `wt_atm()` | +| Entropy | Entropy-balanced population | `wt_entropy()` | + +`wt_atc()` is an alias for `wt_atu()`. + +ATE is the most common choice. ATT and ATU narrow the question to the treated +or untreated, respectively. ATO, ATM, and entropy weights target overlap +populations -- they produce bounded weights by construction, which makes them +a good option when propensity scores are extreme (more on that below). + +To switch estimands, just swap the weight function: + +```{r switching-estimands} +wts_ate <- wt_ate(ps_mod) +wts_att <- wt_att(ps_mod) +wts_ato <- wt_ato(ps_mod) +``` + +## Handling extreme weights + +Propensity scores near 0 or 1 produce large weights that can blow up +your variance. The `summary()` method gives a quick look at the weight +distribution: + +```{r diagnose-weights} +summary(wts_ate) +``` + +If you see a very large maximum or high variance, you have a few options. + +### Overlap estimands + +The easiest fix is to use an estimand with bounded weights. `wt_ato()` and +`wt_atm()` down-weight observations where overlap is poor: + +```{r overlap-estimands} +summary(wt_ato(ps_mod)) +summary(wt_atm(ps_mod)) +``` + +The trade-off is that you're now targeting a different population. + +### Trimming + +`ps_trim()` drops observations with extreme propensity scores by setting +them to `NA`. The `"ps"` method uses fixed thresholds (by default, 0.1 +and 0.9): + +```{r trim-ps} +ps_trimmed <- ps_trim(ps, method = "ps") +``` + +The `"adaptive"` method (Crump et al., 2009) finds a data-driven threshold: + +```{r trim-adaptive} +ps_trimmed_adapt <- ps_trim(ps, method = "adaptive") +``` + +You can inspect the result with a few helpers: + +```{r trim-diagnostics} +# Confirm the object has been trimmed +is_ps_trimmed(ps_trimmed) + +# Which observations were removed? +sum(is_unit_trimmed(ps_trimmed)) + +# View trimming metadata (method, cutoffs, etc.) +ps_trim_meta(ps_trimmed) +``` + +Use `!is_unit_trimmed()` to subset your data down to the retained +observations: + +```{r trim-subset} +retained <- !is_unit_trimmed(ps_trimmed) +dat_trimmed <- dat[retained, ] +``` + +After trimming, you should refit the propensity score model on the retained +sample so the scores reflect the trimmed population: + +```{r refit} +ps_refitted <- ps_refit(ps_trimmed, ps_mod) +is_refit(ps_refitted) +``` + +Then pass the refitted scores to the weight function as usual: + +```{r weights-from-refit} +wts_trimmed <- wt_ate(ps_refitted, dat$z) +summary(wts_trimmed) +``` + +See `?ps_trim` for other trimming methods, including percentile-based +(`"pctl"`), preference score (`"pref"`), and common range (`"cr"`). + +### Truncation + +Truncation is similar to trimming but keeps all observations -- it just +clips extreme scores to specified bounds: + +```{r truncate} +ps_truncated <- ps_trunc(ps, lower = 0.05, upper = 0.95) +``` + +`is_unit_truncated()` tells you which observations were clipped: + +```{r trunc-diagnostics} +is_ps_truncated(ps_truncated) +sum(is_unit_truncated(ps_truncated)) +ps_trunc_meta(ps_truncated) +``` + +```{r weights-from-trunc} +wts_truncated <- wt_ate(ps_truncated, dat$z) +summary(wts_truncated) +``` + +### Which approach? + +These aren't mutually exclusive. In general: overlap estimands like +`wt_ato()` are the easiest path if your research question allows it. +Trimming (followed by `ps_refit()`) is the standard choice when you need ATE +but have near-violations of positivity. Truncation is a lighter touch when +you want to keep the full sample. + +## Interpreting results + +### Binary outcomes + +For binary outcomes, `ipw()` returns three effect measures: the risk +difference, log risk ratio, and log odds ratio: + +```{r interpret-binary} +result +``` + +`as.data.frame()` pulls the estimates into a data frame: + +```{r as-data-frame} +as.data.frame(result) +``` + +Use `exponentiate = TRUE` to get risk ratios and odds ratios on their natural +scale. The standard errors, z-statistics, and p-values stay on the log scale: + +```{r exponentiate} +as.data.frame(result, exponentiate = TRUE) +``` + +### Continuous outcomes + +For continuous outcomes, `ipw()` returns the mean difference. Use `lm()` +for the outcome model: + +```{r continuous-outcome} +y_cont <- 2 + 0.8 * z + 0.3 * x1 + 0.2 * x2 + rnorm(n) +dat$y_cont <- y_cont +outcome_cont <- lm(y_cont ~ z, data = dat, weights = wts) +ipw(ps_mod, outcome_cont) +``` + +## Next steps + +The examples above all use binary exposures. propensity also handles +continuous and categorical treatments. + +### Continuous exposures + +For continuous exposures, weights use density ratios. Stabilization is +usually a good idea here: + +```{r continuous-exposure, eval = FALSE} +# Fit a model for the continuous exposure +ps_cont <- glm(continuous_exposure ~ x1 + x2, data = dat, family = gaussian()) + +# Stabilized weights (strongly recommended for continuous exposures) +wts_cont <- wt_ate(ps_cont, stabilize = TRUE) +``` + +### Categorical exposures + +For multi-level treatments, pass a matrix or data frame of predicted +probabilities with one column per level: + +```{r categorical-exposure, eval = FALSE} +# Multinomial propensity scores (one column per treatment level) +ps_matrix <- predict(multinom_model, type = "probs") +wt_ate(ps_matrix, exposure, exposure_type = "categorical") + +# ATT and ATU require specifying the focal level +wt_att(ps_matrix, exposure, .focal_level = "treated") +``` + +### Calibration + +`ps_calibrate()` adjusts propensity scores so they better reflect treatment +probabilities. Where trimming and truncation deal with the tails, calibration +reshapes the whole distribution. It supports logistic calibration (the +default) and isotonic regression: + +```{r calibrate, eval = FALSE} +ps_calibrated <- ps_calibrate(ps, dat$z, method = "logistic", smooth = FALSE) +is_ps_calibrated(ps_calibrated) + +wts_calibrated <- wt_ate(ps_calibrated, dat$z) +``` + +### Censoring weights + +`wt_cens()` calculates inverse probability of censoring weights for survival +or longitudinal analyses: + +```{r censoring-weights, eval = FALSE} +# Model the probability of being uncensored +cens_mod <- glm(uncensored ~ x1 + x2, data = dat, family = binomial()) +wts_cens <- wt_cens(cens_mod) + +# Censoring weights use the same formula as ATE weights +estimand(wts_cens) # "uncensored" +``` + +### Learning more + +See the function reference for details: + +- `?wt_ate` -- Weight calculation for all estimands +- `?ps_trim`, `?ps_trunc`, `?ps_calibrate` -- Handling extreme propensity + scores +- `?ipw` -- Inverse probability weighted estimation diff --git a/vignettes/propensity.html b/vignettes/propensity.html new file mode 100644 index 0000000..b0682bd --- /dev/null +++ b/vignettes/propensity.html @@ -0,0 +1,780 @@ + + + + + + + + + + + + + + +Getting Started with propensity + + + + + + + + + + + + + + + + + + + + + + + + + + +

Getting Started with propensity

+ + + +

This vignette walks through the core propensity score weighting +workflow: fitting a propensity score model, calculating weights, and +estimating causal effects with ipw(). We’ll also cover what +to do when propensity scores are extreme.

+
+

Setup

+
library(propensity)
+

We’ll work with a simulated dataset throughout. There are two +confounders (x1 and x2), a binary exposure +(z), and a binary outcome (y):

+
set.seed(42)
+n <- 100
+x1 <- rnorm(n)
+x2 <- rnorm(n)
+z <- rbinom(n, 1, plogis(0.5 * x1 + 0.3 * x2))
+y <- rbinom(n, 1, plogis(-0.5 + 0.8 * z + 0.3 * x1 + 0.2 * x2))
+dat <- data.frame(x1, z, y, x2)
+

Both x1 and x2 affect treatment and +outcome, so we need to adjust for them.

+
+
+

Basic workflow

+
+

Step 1: Fit a propensity score model

+

Start with a model for treatment assignment. Here we use logistic +regression:

+
ps_mod <- glm(z ~ x1 + x2, data = dat, family = binomial())
+
+
+

Step 2: Calculate weights and fit a weighted outcome model

+

Pass the fitted model directly to wt_ate() to get ATE +weights. It pulls out the fitted values and exposure for you:

+
wts <- wt_ate(ps_mod)
+#> ℹ Using exposure variable "z" from GLM model
+#> ℹ Treating `.exposure` as binary
+#> ℹ Setting focal level to 1
+outcome_mod <- glm(y ~ z, data = dat, family = binomial(), weights = wts)
+#> Warning in eval(family$initialize): non-integer #successes in a binomial glm!
+

wt_ate() returns a psw object, which is +just a numeric vector with some extra metadata attached:

+
estimand(wts)
+#> [1] "ate"
+is_stabilized(wts)
+#> [1] FALSE
+

You can also pass propensity scores as a plain numeric vector. In +that case you need to supply the exposure too:

+
ps <- fitted(ps_mod)
+wt_ate(ps, dat$z)
+#> ℹ Treating `.exposure` as binary
+#> ℹ Setting focal level to 1
+#> <psw{estimand = ate}[100]>
+#>   [1]  1.237569  1.962759  2.211732  1.312977  1.974772  1.918957  3.413991
+#>   [8]  1.844849  1.223426  2.048453  1.409967  1.189795  1.283684  2.580633
+#>  [15]  1.439961  1.771951  1.627989  3.438494  1.092310  1.379591  1.414973
+#>  [22]  1.142879  2.132832  2.539924  1.264028  1.584122  1.614753  1.115628
+#>  [29]  2.235160  1.641530  1.598952  1.767794  1.494051  2.039262  3.465881
+#>  [36]  1.174226  1.511863  1.832668  1.135144  2.045876  2.067593  2.960898
+#>  [43]  1.724205  2.807457  1.296458  1.487979  1.433057  3.287998  2.085343
+#>  [50]  2.000254  1.845028  1.286187  1.207434  2.360698  1.840088  1.704295
+#>  [57]  1.642486  2.362152 12.582758  2.974447  1.677742  1.704949  2.553764
+#>  [64]  1.438721  1.711034  1.227343  1.812465  1.409825  1.518867  3.314572
+#>  [71]  1.404951  1.799540  2.354036  1.941761  1.909359  1.731474  2.080547
+#>  [78]  2.731912  1.606549  3.350612  1.327948  2.103802  2.178471  2.018730
+#>  [85]  3.813295  1.864473  2.078958  1.959235  1.747083  1.907159  3.853789
+#>  [92]  1.584359  2.693732  1.644175  1.286716  1.788770  3.037240  1.416308
+#>  [99]  1.474800  1.619529
+
+
+

Step 3: Estimate causal effects

+

ipw() takes the propensity score model and the weighted +outcome model and returns causal effect estimates. The standard errors +use linearization to account for the fact that the propensity scores are +estimated:

+
result <- ipw(ps_mod, outcome_mod)
+result
+#> Inverse Probability Weight Estimator
+#> Estimand: ATE 
+#> 
+#> Propensity Score Model:
+#>   Call: glm(formula = z ~ x1 + x2, family = binomial(), data = dat) 
+#> 
+#> Outcome Model:
+#>   Call: glm(formula = y ~ z, family = binomial(), data = dat, weights = wts) 
+#> 
+#> Estimates:
+#>         estimate  std.err        z ci.lower ci.upper conf.level   p.value    
+#> rd       0.32000  0.10411  3.07376   0.1160  0.52404       0.95  0.002114 ** 
+#> log(rr)  0.69137  0.12490  5.53528   0.4466  0.93618       0.95 3.107e-08 ***
+#> log(or)  1.32884  0.12288 10.81398   1.0880  1.56969       0.95 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+
+
+

Choosing an estimand

+

Each estimand targets a different population:

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
EstimandTarget populationFunction
ATEEntire study populationwt_ate()
ATTTreated (focal) groupwt_att()
ATUUntreated (reference) groupwt_atu()
ATOOverlap populationwt_ato()
ATMMatched populationwt_atm()
EntropyEntropy-balanced populationwt_entropy()
+

wt_atc() is an alias for wt_atu().

+

ATE is the most common choice. ATT and ATU narrow the question to the +treated or untreated, respectively. ATO, ATM, and entropy weights target +overlap populations – they produce bounded weights by construction, +which makes them a good option when propensity scores are extreme (more +on that below).

+

To switch estimands, just swap the weight function:

+
wts_ate <- wt_ate(ps_mod)
+#> ℹ Using exposure variable "z" from GLM model
+#> ℹ Treating `.exposure` as binary
+#> ℹ Setting focal level to 1
+wts_att <- wt_att(ps_mod)
+#> ℹ Using exposure variable "z" from GLM model
+#> ℹ Treating `.exposure` as binary
+#> ℹ Setting focal level to 1
+wts_ato <- wt_ato(ps_mod)
+#> ℹ Using exposure variable "z" from GLM model
+#> ℹ Treating `.exposure` as binary
+#> ℹ Setting focal level to 1
+
+
+

Handling extreme weights

+

Propensity scores near 0 or 1 produce large weights that can blow up +your variance. The summary() method gives a quick look at +the weight distribution:

+
summary(wts_ate)
+#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+#>   1.092   1.440   1.780   2.028   2.111  12.583
+

If you see a very large maximum or high variance, you have a few +options.

+
+

Overlap estimands

+

The easiest fix is to use an estimand with bounded weights. +wt_ato() and wt_atm() down-weight observations +where overlap is poor:

+
summary(wt_ato(ps_mod))
+#> ℹ Using exposure variable "z" from GLM model
+#> ℹ Treating `.exposure` as binary
+#> ℹ Setting focal level to 1
+#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+#> 0.08451 0.30539 0.43830 0.43370 0.52629 0.92053
+summary(wt_atm(ps_mod))
+#> ℹ Using exposure variable "z" from GLM model
+#> ℹ Treating `.exposure` as binary
+#> ℹ Setting focal level to 1
+#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+#> 0.09231 0.43965 0.78036 0.70946 1.00000 1.00000
+

The trade-off is that you’re now targeting a different +population.

+
+
+

Trimming

+

ps_trim() drops observations with extreme propensity +scores by setting them to NA. The "ps" method +uses fixed thresholds (by default, 0.1 and 0.9):

+
ps_trimmed <- ps_trim(ps, method = "ps")
+

The "adaptive" method (Crump et al., 2009) finds a +data-driven threshold:

+
ps_trimmed_adapt <- ps_trim(ps, method = "adaptive")
+

You can inspect the result with a few helpers:

+
# Confirm the object has been trimmed
+is_ps_trimmed(ps_trimmed)
+#> [1] TRUE
+
+# Which observations were removed?
+sum(is_unit_trimmed(ps_trimmed))
+#> [1] 2
+
+# View trimming metadata (method, cutoffs, etc.)
+ps_trim_meta(ps_trimmed)
+#> $method
+#> [1] "ps"
+#> 
+#> $lower
+#> [1] 0.1
+#> 
+#> $upper
+#> [1] 0.9
+#> 
+#> $keep_idx
+#>   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  20  21 
+#>   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  20  21 
+#>  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40  41 
+#>  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40  41 
+#>  42  43  44  45  46  47  48  49  50  51  52  53  54  55  56  57  58  60  61  62 
+#>  42  43  44  45  46  47  48  49  50  51  52  53  54  55  56  57  58  60  61  62 
+#>  63  64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79  80  81  82 
+#>  63  64  65  66  67  68  69  70  71  72  73  74  75  76  77  78  79  80  81  82 
+#>  83  84  85  86  87  88  89  90  91  92  93  94  95  96  97  98  99 100 
+#>  83  84  85  86  87  88  89  90  91  92  93  94  95  96  97  98  99 100 
+#> 
+#> $trimmed_idx
+#> [1] 19 59
+

Use !is_unit_trimmed() to subset your data down to the +retained observations:

+
retained <- !is_unit_trimmed(ps_trimmed)
+dat_trimmed <- dat[retained, ]
+

After trimming, you should refit the propensity score model on the +retained sample so the scores reflect the trimmed population:

+
ps_refitted <- ps_refit(ps_trimmed, ps_mod)
+is_refit(ps_refitted)
+#> [1] TRUE
+

Then pass the refitted scores to the weight function as usual:

+
wts_trimmed <- wt_ate(ps_refitted, dat$z)
+#> ℹ Treating `.exposure` as binary
+#> ℹ Setting focal level to 1
+summary(wts_trimmed)
+#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
+#>   1.073   1.386   1.726   1.970   2.157   4.724       2
+

See ?ps_trim for other trimming methods, including +percentile-based ("pctl"), preference score +("pref"), and common range ("cr").

+
+
+

Truncation

+

Truncation is similar to trimming but keeps all observations – it +just clips extreme scores to specified bounds:

+
ps_truncated <- ps_trunc(ps, lower = 0.05, upper = 0.95)
+

is_unit_truncated() tells you which observations were +clipped:

+
is_ps_truncated(ps_truncated)
+#> [1] TRUE
+sum(is_unit_truncated(ps_truncated))
+#> [1] 0
+ps_trunc_meta(ps_truncated)
+#> $method
+#> [1] "ps"
+#> 
+#> $lower_bound
+#> [1] 0.05
+#> 
+#> $upper_bound
+#> [1] 0.95
+#> 
+#> $truncated_idx
+#> integer(0)
+
wts_truncated <- wt_ate(ps_truncated, dat$z)
+#> ℹ Treating `.exposure` as binary
+#> ℹ Setting focal level to 1
+summary(wts_truncated)
+#>    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
+#>   1.092   1.440   1.780   2.028   2.111  12.583
+
+
+

Which approach?

+

These aren’t mutually exclusive. In general: overlap estimands like +wt_ato() are the easiest path if your research question +allows it. Trimming (followed by ps_refit()) is the +standard choice when you need ATE but have near-violations of +positivity. Truncation is a lighter touch when you want to keep the full +sample.

+
+
+
+

Interpreting results

+
+

Binary outcomes

+

For binary outcomes, ipw() returns three effect +measures: the risk difference, log risk ratio, and log odds ratio:

+
result
+#> Inverse Probability Weight Estimator
+#> Estimand: ATE 
+#> 
+#> Propensity Score Model:
+#>   Call: glm(formula = z ~ x1 + x2, family = binomial(), data = dat) 
+#> 
+#> Outcome Model:
+#>   Call: glm(formula = y ~ z, family = binomial(), data = dat, weights = wts) 
+#> 
+#> Estimates:
+#>         estimate  std.err        z ci.lower ci.upper conf.level   p.value    
+#> rd       0.32000  0.10411  3.07376   0.1160  0.52404       0.95  0.002114 ** 
+#> log(rr)  0.69137  0.12490  5.53528   0.4466  0.93618       0.95 3.107e-08 ***
+#> log(or)  1.32884  0.12288 10.81398   1.0880  1.56969       0.95 < 2.2e-16 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+

as.data.frame() pulls the estimates into a data +frame:

+
as.data.frame(result)
+#>    effect  estimate   std.err         z  ci.lower  ci.upper conf.level
+#> 1      rd 0.3199973 0.1041062  3.073758 0.1159529 0.5240417       0.95
+#> 2 log(rr) 0.6913736 0.1249031  5.535278 0.4465679 0.9361792       0.95
+#> 3 log(or) 1.3288426 0.1228819 10.813984 1.0879986 1.5696867       0.95
+#>        p.value
+#> 1 2.113806e-03
+#> 2 3.107345e-08
+#> 3 0.000000e+00
+

Use exponentiate = TRUE to get risk ratios and odds +ratios on their natural scale. The standard errors, z-statistics, and +p-values stay on the log scale:

+
as.data.frame(result, exponentiate = TRUE)
+#>   effect  estimate   std.err         z  ci.lower  ci.upper conf.level
+#> 1     rd 0.3199973 0.1041062  3.073758 0.1159529 0.5240417       0.95
+#> 2     rr 1.9964559 0.1249031  5.535278 1.5629389 2.5502189       0.95
+#> 3     or 3.7766698 0.1228819 10.813984 2.9683272 4.8051424       0.95
+#>        p.value
+#> 1 2.113806e-03
+#> 2 3.107345e-08
+#> 3 0.000000e+00
+
+
+

Continuous outcomes

+

For continuous outcomes, ipw() returns the mean +difference. Use lm() for the outcome model:

+
y_cont <- 2 + 0.8 * z + 0.3 * x1 + 0.2 * x2 + rnorm(n)
+dat$y_cont <- y_cont
+outcome_cont <- lm(y_cont ~ z, data = dat, weights = wts)
+ipw(ps_mod, outcome_cont)
+#> Inverse Probability Weight Estimator
+#> Estimand: ATE 
+#> 
+#> Propensity Score Model:
+#>   Call: glm(formula = z ~ x1 + x2, family = binomial(), data = dat) 
+#> 
+#> Outcome Model:
+#>   Call: lm(formula = y_cont ~ z, data = dat, weights = wts) 
+#> 
+#> Estimates:
+#>      estimate std.err       z ci.lower ci.upper conf.level   p.value    
+#> diff  0.92737 0.20498 4.52416   0.5256   1.3291       0.95 6.064e-06 ***
+#> ---
+#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
+
+
+
+

Next steps

+

The examples above all use binary exposures. propensity also handles +continuous and categorical treatments.

+
+

Continuous exposures

+

For continuous exposures, weights use density ratios. Stabilization +is usually a good idea here:

+
# Fit a model for the continuous exposure
+ps_cont <- glm(continuous_exposure ~ x1 + x2, data = dat, family = gaussian())
+
+# Stabilized weights (strongly recommended for continuous exposures)
+wts_cont <- wt_ate(ps_cont, stabilize = TRUE)
+
+
+

Categorical exposures

+

For multi-level treatments, pass a matrix or data frame of predicted +probabilities with one column per level:

+
# Multinomial propensity scores (one column per treatment level)
+ps_matrix <- predict(multinom_model, type = "probs")
+wt_ate(ps_matrix, exposure, exposure_type = "categorical")
+
+# ATT and ATU require specifying the focal level
+wt_att(ps_matrix, exposure, .focal_level = "treated")
+
+
+

Calibration

+

ps_calibrate() adjusts propensity scores so they better +reflect treatment probabilities. Where trimming and truncation deal with +the tails, calibration reshapes the whole distribution. It supports +logistic calibration (the default) and isotonic regression:

+
ps_calibrated <- ps_calibrate(ps, dat$z, method = "logistic", smooth = FALSE)
+is_ps_calibrated(ps_calibrated)
+
+wts_calibrated <- wt_ate(ps_calibrated, dat$z)
+
+
+

Censoring weights

+

wt_cens() calculates inverse probability of censoring +weights for survival or longitudinal analyses:

+
# Model the probability of being uncensored
+cens_mod <- glm(uncensored ~ x1 + x2, data = dat, family = binomial())
+wts_cens <- wt_cens(cens_mod)
+
+# Censoring weights use the same formula as ATE weights
+estimand(wts_cens) # "uncensored"
+
+
+

Learning more

+

See the function reference for details:

+
    +
  • ?wt_ate – Weight calculation for all estimands
  • +
  • ?ps_trim, ?ps_trunc, +?ps_calibrate – Handling extreme propensity scores
  • +
  • ?ipw – Inverse probability weighted estimation
  • +
+
+
+ + + + + + + + + + +