Code
suppressMessages(library(MatchIt))
set.seed(2026)
n <- 4000
# Customers decide whether to join a retailer's loyalty app.
# Frequent and loyal customers are more likely to join, and visit more anyway.
past_visits <- rpois(n, 6)
loyalty <- runif(n)
join <- rbinom(n, 1, plogis(-3 + 0.3 * past_visits + 2 * loyalty))
visits <- 2 + 0.8 * past_visits + 3 * loyalty + 1.0 * join + rnorm(n) # true effect = 1
dat <- data.frame(visits, join, past_visits, loyalty)
# Nearest-neighbour propensity score matching with a caliper
m <- matchit(join ~ past_visits + loyalty, data = dat, method = "nearest",
distance = "glm", caliper = 0.1)
md <- match.data(m)
# Inverse probability weighting for the ATT
ps <- glm(join ~ past_visits + loyalty, family = binomial, data = dat)$fitted
w <- ifelse(dat$join == 1, 1, ps / (1 - ps))
round(c(true_effect = 1,
naive = mean(visits[join == 1]) - mean(visits[join == 0]),
regression = unname(coef(lm(visits ~ join + past_visits + loyalty, dat))["join"]),
PS_matching = unname(coef(lm(visits ~ join, md, weights = weights))["join"]),
IPW = weighted.mean(visits[join == 1], w[join == 1]) -
weighted.mean(visits[join == 0], w[join == 0])), 2)true_effect naive regression PS_matching IPW
1.00 2.64 1.02 1.09 1.08