-
Notifications
You must be signed in to change notification settings - Fork 45
/
weighting_plot.R
63 lines (62 loc) · 2.58 KB
/
weighting_plot.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
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
59
60
61
62
63
#' Propensity score weighting plot
#'
#' @param ps vector of propensity scores.
#' @param treatment vector of treatment indicators.
#' @param outcome vector of outcome values.
#' @param estimand the estimand to use, either ATE, ATT, ATC, or ATM.
#' @param null_hypothesis the value of the null hypothesis (typically zero). A
#' horizontal line will be drawn to compare with regression line.
#' @param method the method to use for the regression line. Typically loess, gan, or lm.
#' @param se Display confidence interval around smooth? (TRUE by default, see level to control.)
#' @param level Level of confidence interval to use (0.95 by default).
#' @param colors vector of colors to use for control and treatment, respectively.
#' @param point_size_range range of the point sizes. Needs to be a vector of length two.
#' @param xlab label for the x-axis.
#' @param ylab label for the y-axis.
#' @param treat_lab label for the legend of group colors.
#' @param size_lab label for the legend of point sizes.
#' @param plot_points whether to plot the individual points.
#' @return a ggplot2 expression.
#' @export
#' @examples
#' if(require(Matching)) {
#' data(lalonde, package = 'Matching')
#' lr_out <- glm(treat ~ age + I(age^2) + educ + I(educ^2) + black +
#' hisp + married + nodegr + re74 + I(re74^2) + re75 + I(re75^2) +
#' u74 + u75,
#' data = lalonde,
#' family = binomial(link = 'logit'))
#' lalonde$ps <- fitted(lr_out)
#' weighting_plot(ps = lalonde$ps,
#' treatment = lalonde$treat,
#' outcome = log(lalonde$re78))
#' }
weighting_plot <- function(ps, treatment, outcome,
estimand = 'ATE',
null_hypothesis = 0,
method = 'loess',
se = TRUE,
level = 0.95,
colors = c('#fc8d62', '#66c2a5'),
point_size_range = c(1, 8),
xlab = 'Propensity Score',
ylab = 'Outcome',
treat_lab = 'Treatment',
size_lab = 'PS Weight',
plot_points = TRUE) {
df <- data.frame(ps = ps,
treatment = treatment,
outcome = outcome)
df$ps_weights <- psa::calculate_ps_weights(treatment = treatment,
ps = ps,
estimand = estimand)
p <- ggplot(df, aes(x = ps, y = outcome)) +
geom_hline(yintercept = null_hypothesis) +
geom_point(aes(size = ps_weights, color = as.logical(treatment)), alpha = 0.5) +
geom_smooth(method = method, se = se, level = level,
formula = y ~ x, aes(weight = ps_weights)) +
scale_size(size_lab, range = point_size_range) +
scale_color_manual(treat_lab, values = colors) +
xlab(xlab) + ylab(ylab)
return(p)
}