/
plot_continuous.R
110 lines (104 loc) · 3.73 KB
/
plot_continuous.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
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
101
102
103
104
105
106
107
108
109
110
#' Plot weights across a continuous covariate
#'
#' This provides a simple plot for the distribution of a single
#' continuous covariate in the nominal sample and the implicit sample
#' defined by the Aronow and Samii (2015) \doi{10.1111/ajps.12185} regression
#' weights.
#' @param mod Weighting model object
#' @param covariate Covariate vector
#' @param alpha Number between zero and one indicating the desired alpha level
#' for confidence intervals.
#' @param num_eval Number of points at which to evaluate the density.
#' @param ... unused arguments
#' @details
#' Kernel density estimates use the bias-corrected methods of
#' Cattaneo et al (2020).
#' @return A `ggplot2::ggplot` object.
#' @examples
#' y <- rnorm(100)
#' a <- rbinom(100, 1, 0.5)
#' x <- rnorm(100)
#' cov <- runif(100)
#' mod <- stats::lm(y ~ a + x)
#' rw_mod <- calculate_weights(mod, "a")
#' plot_weighting_continuous(rw_mod, cov, num_eval = 25)
#' @seealso [lpdensity::lpdensity()]
#' @references \itemize{
#' \item Cattaneo, Jansson and Ma (2021): lpdensity:
#' Local Polynomial Density Estimation and Inference.
#' *Journal of Statistical Software*, forthcoming.
#' \item Cattaneo, Jansson and Ma (2020):
#' Simple Local Polynomial Density Estimators.
#' *Journal of the American Statistical Association* 115(531): 1449-1455.
#' }
#' @importFrom ggplot2 ggplot aes geom_line scale_x_discrete scale_y_continuous
#' @importFrom ggplot2 scale_fill_manual scale_color_manual
#' @importFrom ggplot2 scale_alpha_continuous scale_linetype_discrete
#' @importFrom ggplot2 theme_minimal
#' @importFrom checkmate assert_class assert_numeric
#' @importFrom lpdensity lpdensity
#' @importFrom dplyr tibble %>%
#' @export
plot_weighting_continuous <- function(
mod,
covariate,
alpha = 0.05,
num_eval = 250,
...
) {
checkmate::assert_class(mod, "regweight")
checkmate::assert_numeric(covariate)
ok <- stats::complete.cases(covariate, mod$weights)
n <- sum(ok)
covariate <- covariate[ok]
wts <- mod$weights[ok]
range <- stats::quantile(covariate, probs = c(0.05, 0.95))
eval_pts <- seq(range[1], range[2], length = num_eval)
wkde <- lpdensity::lpdensity(
covariate,
grid = eval_pts,
Pweights = wts / sum(wts) * n,
kernel = "epanechnikov",
bwselect = "imse-dpi"
)
kde <- lpdensity::lpdensity(
covariate,
grid = eval_pts,
kernel = "epanechnikov",
bwselect = "imse-dpi"
)
tbl <- dplyr::tibble(
weight = rep(
c("Implicit regression", "Nominal"),
c(num_eval, num_eval)
),
transp = rep(c(1, 0.5), c(num_eval, num_eval)),
covariate = c(eval_pts, eval_pts),
density = c(wkde$Estimate[, "f_p"], kde$Estimate[, "f_p"]),
std_error = c(wkde$Estimate[, "se_q"], kde$Estimate[, "se_q"]),
lwr = density - stats::qnorm(1 - alpha / 2) * std_error,
upr = density + stats::qnorm(1 - alpha / 2) * std_error
)
ggplot2::ggplot(tbl,
ggplot2::aes(
x = covariate,
alpha = transp,
color = weight,
fill = weight
)
) +
ggplot2::geom_line(aes(y = density)) +
ggplot2::geom_line(aes(y = lwr), linetype = "dashed") +
ggplot2::geom_line(aes(y = upr), linetype = "dashed") +
ggplot2::scale_x_continuous("") +
ggplot2::scale_y_continuous("Covariate density") +
ggplot2::scale_fill_manual("",
values = c("Implicit regression" = "black", "Nominal" = "red")
) +
ggplot2::scale_color_manual("",
values = c("Implicit regression" = "black", "Nominal" = "red")
) +
ggplot2::scale_alpha_continuous(guide = "none", limits = c(0, 1)) +
ggplot2::scale_linetype_discrete(guide = "none") +
ggplot2::theme_minimal()
}