In jbryer/psa: Applied Propensity Score Analysis with R

Matching {#chapter-matching}

::: {.rmdtip} match
verb
1. correspond or cause to correspond in some essential respect; make or be harmonious.
2. be equal to (something) in quality or strength. :::

As the name suggests, propensity score matching is concerned with matching treatment to control observations...

Matching Methods

Nearest Neighbor Matching

MatchIt::matchit(method = "nearest")

Optimal Pair Matching

MatchIt::matchit(method = "optimal")

Optimal Full Matching

MatchIt::matchit(method = "full")

Generalized Full Matching

MatchIt::matchit(method = "quick")

Genetic Matching

MatchIt::matchit(method = "genetic")

X <- cbind(age, educ, black, hisp, married, nodegr, re74, re75, u74, u75) BalanceMatrix <- cbind(age, I(age^2), educ, I(educ^2), black, hisp, married, nodegr, re74, I(re74^2), re75, I(re75^2), u74, u75, I(re74 * re75), I(age * nodegr), I(educ * re74), I(educ * re75)) gen1 <- GenMatch(Tr = Tr, X = X, BalanceMatrix = BalanceMatrix, pop.size = 1000)

Exact Matching

MatchIt::matchit(method = "exact")

Coarsened Exact Matching

MatchIt::matchit(method = "cem")

Subclassification

MatchIt::matchit(method = "subclass")

Cardinality and Profile Matching

MatchIt::matchit(method = "cardinality")

lr_out <- glm(lalonde.formu, 
              data = lalonde,
              family = binomial(link = logit))
lalonde$lr_ps <- fitted(lr_out)  # Propensity scores

lalonde_match <- Match(Y = lalonde$re78, 
                       Tr = lalonde$treat, 
                       X = lalonde$lr_ps, 
                       M = 1,
                       caliper = 0.1,
                       replace = TRUE,
                       estimand = 'ATE')
lalonde_match_df <- data.frame(treated.ps = lalonde[lalonde_match$index.treated,]$lr_ps,
                               control.ps = lalonde[lalonde_match$index.control,]$lr_ps,
                               treated.y = 1,
                               control.y = 0)
lalonde_match_df <- lalonde_match_df[order(lalonde_match_df$control.ps),]
rows <- (1:nrow(lalonde_match_df) - 1) %% floor(nrow(lalonde_match_df) / 5) == 0
ggplot(lalonde, aes(x = lr_ps, y = treat)) + 
    geom_point(alpha = 0.5) +
    geom_smooth(method = glm, formula = y ~ x, method.args = list(family=binomial(link='logit')), se = FALSE) +
    xlim(c(0,1)) + 
    xlab('Propensity Score') + ylab('Treatment') +
    geom_segment(data = lalonde_match_df, 
                 aes(x = treated.ps, xend = control.ps, y = treated.y, yend = control.y),
                 color = 'purple', alpha = 0.1)

One-to-One Matching ATE

One-to-one matching with replacement (the M = 1 option). Estimating the treatment effect on the treated (default is ATT).

rr_att <- Match(Y = lalonde$re78, 
                Tr = lalonde$treat, 
                X = lalonde$lr_ps,
                M = 1,
                estimand='ATT')
summary(rr_att) # The default estimate is ATT here

Checking Balance

rr_att_mb <- psa::MatchBalance(
    df = lalonde,
    formu = lalonde.formu,
    formu.Y = update.formula(lalonde.formu, re78 ~ .),
    index.treated = rr_att$index.treated,
    index.control = rr_att$index.control,
    tolerance = 0.25,
    M = 1,
    estimand = 'ATT')
plot(rr_att_mb)
# ls(rr_att_mb)
summary(rr_att_mb)

# TODO: Decide whether to include this. Could write a function to present results as a table
rr_att_mb2  <- Matching::MatchBalance(
    formul = lalonde.formu,
    data = lalonde, 
    match.out = rr_att,
    nboots = 500, 
    print.level = 0)
# rr_att_mb2 |> print() # Output is too long

One-to-One matching (ATT)

rr.ate <- Match(Y = lalonde$re78, 
                Tr = lalonde$treat, 
                X = lalonde$lr_ps,
                M = 1,
                estimand = 'ATE')
summary(rr.ate)

One-to-Many Matching (ATT)

rr2 <- Match(Y = lalonde$re78,      
             Tr = lalonde$treat, 
             X = lalonde$lr_ps,
             M = 1, 
             ties = TRUE, 
             replace = TRUE,
             estimand = 'ATT')
summary(rr2) # The default estimate is ATT here

The MatchIt Package

matchit.out <- MatchIt::matchit(lalonde.formu, data = lalonde)
summary(matchit.out)

# Same as above but calculate average treatment effect
rr.ate <- Match(Y = lalonde$re78, 
                Tr = lalonde$treat, 
                X = lalonde$lr_ps,
                M = 1,
                ties = FALSE, 
                replace = FALSE, 
                estimand='ATE')
summary(rr.ate) # Here the estimate is ATE

## Genetic Matching
rr.gen <- GenMatch(Tr = lalonde$treat, 
                   X = lalonde$lr_ps, 
                   BalanceMatrix = lalonde[,all.vars(lalonde.formu)[-1]],
                   estimand = 'ATE', 
                   M = 1, 
                   pop.size = 16,
                   print.level = 0)
rr.gen.mout <- Match(Y = lalonde$re78, 
                     Tr = lalonde$treat, 
                     X = lalonde$lr_ps,
                     estimand = 'ATE',
                     Weight.matrix = rr.gen)
summary(rr.gen.mout)

## Partial exact matching
rr2 <- Matchby(Y = lalonde$re78, 
               Tr = lalonde$treat, 
               X = lalonde$lr_ps, 
               by = factor(lalonde$nodegr),
               print.level = 0)
summary(rr2)

## Partial exact matching on two covariates
rr3 <- Matchby(Y = lalonde$re78, 
               Tr = lalonde$treat, 
               X = lalonde$lr_ps, 
               by = lalonde[,c('nodegr','married')],
               print.level = 0)
summary(rr3)

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