In jbryer/psa: Applied Propensity Score Analysis with R

Weighting {#chapter-weighting}

::: {.rmdtip} weight
verb
1. hold (something) down by placing a heavy object on top of it.
2. attach importance or value to. :::

Propensity score weighting is the approach to using propensity scores as weights in other statistical models such as regression or ANOVA. Like stratification (see Chapter \@ref(chapter-stratification)), propensity score weighting has the advantage of all observations. In section \@ref(introduction-effects) we introduced four different treatment estimators. The histograms used to conceptually explain what observations are included, or not included, in their calculation used propensity score weights. In this chapter will discuss the mathematical details of how those weights are calculated and applied, include the R code to generate the estimates.

We will present a formula for each of the treatment effects we wish to estimate. These formulas define the weights. Once we have the weights we can use them in a statistical model or using the following formula to estimate the treatment effect.

\begin{equation} \begin{aligned} Treatment\ Effect = \frac{\sum Y_{i}Z_{i}w_{i}}{\sum Z_{i} w_{i}} - \frac{\sum Y_{i}(1 - Z_{i}) w_{i}}{\sum (1 - Z_{i}) w_{i} } \end{aligned} (#eq:eqcalcte) \end{equation}

For equation \@ref(eq:eqcalcte), $w$ is the weight (as defined in the following sections), $Z_i$ is the treatment assignment such that $Z = 1$ is treatment and $Z = 0$ is control, and $Y_i$ is the outcome.

Estimate Propensity Scores

To begin, we estimate the propensity scores, here using logistic regression.

data("lalonde", package = 'Matching')
lr_out <- glm(formula = lalonde.formu,
              data = lalonde,
              family = binomial(link = 'logit'))
lalonde$lr_ps <- fitted(lr_out)

Checking Balance

Checking balance for propensity score weighting is the same as stratification. Figure \@ref(fig:weight-balance) is a multiple covariate balance assessment plot. See section \@ref(stratification-balance) in the stratification chapter for more details on how you can check for balance for individual covariates.

PSAgraphics::cv.bal.psa(covariates = lalonde[,all.vars(lalonde.formu)[-1]],
                        treatment = lalonde$treat,
                        propensity = lalonde$lr_ps,
                        strata = 5)

There is one additional balance check that can be done with propensity score weights. We can run the propensity score estimation model with the estimated propensity score weights. This should result in all the covariates having a non-statistically significant effect on the treatment. We will explore the details for the four treatment effects discussed in the next section.

# lalonde$treat <- as.logical(lalonde$treat)

loess_treat_out <- loess(formula = log(re78 + 1) ~ lr_ps,                 
                         data = lalonde[lalonde$treat == 1,],
                         weights = lalonde[lalonde$treat == 1,]$lr_weights)
loess_control_out <- loess(formula = log(re78 + 1) ~ lr_ps,
                           data = lalonde[lalonde$treat == 0,],
                           weights = lalonde[lalonde$treat == 0,]$lr_weights)

x_vals <- seq(0, 1, by = 0.001)
loess_treat_df <- data.frame(x = x_vals, y = predict(loess_treat_out, newdata = x_vals))
loess_control_df <- data.frame(x = x_vals, y = predict(loess_control_out, newdata = x_vals))
loess_treat_df <- loess_treat_df[complete.cases(loess_treat_df),]
loess_control_df <- loess_control_df[complete.cases(loess_control_df),]

loess_treat_df$treat <- 1
loess_control_df$treat <- 0
loess_df <- rbind(loess_treat_df, loess_control_df)

ggplot(lalonde, aes(x = lr_ps, y = log(re78 + 1), color = as.logical(treat))) +
    geom_point(aes(size = lr_weights), alpha = 0.3, show.legend = FALSE) +
    geom_path(data = loess_df, aes(x = x, y = y, color = as.logical(treat))) +
    # geom_smooth(method = 'loess', se = FALSE, formula = y ~ x, linetype= 2) +
    scale_color_manual('Treatment', values = palette2) +
    xlab('Propensity Score')

lm(log(re78+1) ~ treat, data = lalonde, weights = lalonde$lr_weights) |> summary()
lm(log(re78+1) ~ treat, data = lalonde) |> summary()

Average Treatment Effect (ATE)

\begin{equation} \begin{aligned} w_{ATE} = \frac{Z_i}{\pi_i} + \frac{1 - Z_i}{1 - \pi_i} \end{aligned} (#eq:eqatew) \end{equation}

ate_weights <- psa::calculate_ps_weights(treatment = lalonde$treat,
                                         ps = lalonde$lr_ps,                          
                                         estimand = 'ATE')

# The glm call below will through an error but is ok.
# https://stackoverflow.com/questions/12953045/warning-non-integer-successes-in-a-binomial-glm-survey-packages

Check Balance with ATE Weights

glm(formula = lalonde.formu,
    data = lalonde,
    family = quasibinomial(link = 'logit'),
    weights = ate_weights
) |> summary()

Estimate ATE

lm(formula = re78 ~ treat, 
   data = lalonde,
   weights = ate_weights) |> summary()

psa::treatment_effect(treatment = lalonde$treat,
                      outcome = lalonde$re78,
                      weights = ate_weights)

Average Treatment Effect Among the Treated (ATT)

\begin{equation} \begin{aligned} w_{ATT} = \frac{\pi_i Z_i}{\pi_i} + \frac{\pi_i (1 - Z_i)}{1 - \pi_i} \end{aligned} (#eq:eqattw) \end{equation}

att_weights <- psa::calculate_ps_weights(treatment = lalonde$treat,
                                         ps = lalonde$lr_ps, 
                                         estimand = 'ATT')

Check Balance with ATT Weights

glm(formula = lalonde.formu,
    data = lalonde,
    family = quasibinomial(link = 'logit'),
    weights = att_weights
) |> summary()

Estimate ATT

lm(formula = re78 ~ treat, 
   data = lalonde,
   weights = att_weights) |> summary()

psa::treatment_effect(treatment = lalonde$treat,
                      outcome = lalonde$re78,
                      weights = att_weights)

Average Treatment Effect Among the Control (ATC)

\begin{equation} \begin{aligned} w_{ATC} = \frac{(1 - \pi_i) Z_i}{\pi_i} + \frac{(1 - e_i)(1 - Z_i)}{1 - \pi_i} \end{aligned} (#eq:eqatcw) \end{equation}

atc_weights <- psa::calculate_ps_weights(treatment = lalonde$treat,
                                         ps = lalonde$lr_ps, 
                                         estimand = 'ATC')

Check Balance with ATC Weights

glm(formula = lalonde.formu,
    data = lalonde,
    family = quasibinomial(link = 'logit'),
    weights = atc_weights
) |> summary()

Estimate ATC

lm(formula = re78 ~ treat, 
   data = lalonde,
   weights = atc_weights) |> summary()

psa::treatment_effect(treatment = lalonde$treat,
                      outcome = lalonde$re78,
                      weights = atc_weights)

Average Treatment Effect Among the Evenly Matched (ATM)

\begin{equation} \begin{aligned} w_{ATM} = \frac{min{\pi_i, 1 - \pi_i}}{Z_i \pi_i (1 - Z_i)(1 - \pi_i)} \end{aligned} (#eq:eqatmw) \end{equation}

atm_weights <- psa::calculate_ps_weights(treatment = lalonde$treat,
                                         ps = lalonde$lr_ps, 
                                         estimand = 'ATM')

Check Balance with ATM Weights

glm(formula = lalonde.formu,
    data = lalonde,
    family = quasibinomial(link = 'logit'),
    weights = atm_weights
) |> summary()

Estimate ATM

lm(formula = re78 ~ treat, 
   data = lalonde,
   weights = atm_weights) |> summary()

psa::treatment_effect(treatment = lalonde$treat,
                      outcome = lalonde$re78,
                      weights = atm_weights)

jbryer/psa documentation built on Nov. 17, 2023, 8:21 a.m.