Introduction

Let \(Y\) be a binary response, \(A\) a categorical treatment, and \(W\) a vector of confounders. Assume that we have observed \(n\) i.i.d. observations \((Y_i, W_i, A_i) \sim P, i=1,\ldots,n\). In the following we are interested in estimating the target parameter \(\psi(P) = (E[Y(a)]\), where \(Y(a)\) is the potential outcome we would have observed if treatment \(a\) had been administered, possibly contrary to the actual treatment that was observed, i.e., \(Y = Y(A)\).

Under the following assumptions

  1. Stable Unit Treatment Values Assumption (the treatment of a specific subject is not affecting the potential outcome of other subjects)
  2. Positivity, \(P(A\mid W)>\epsilon\) for some \(\epsilon>0.\)
  3. No unmeasured confounders, \(Y(a)\perp \!\!\! \perp A|W\)

the target parameter can be identified from the observed data distribution as \[E(E[Y|W,A=a]) = E(E[Y(a)|W]) = E[Y(a)]\] or \[E[Y I(A=a)/P(A=a|W)] = E[Y(a)].\]

This suggests estimation via either outcome regression (OR, g-computation) or inverse probability weighting (IPW). These can eventually also be combined to a doubly-robust augmented inverse probability weighted (AIPW) estimator.

Simulation

As an illustration we simulate from the following model \[Y \sim Bernoulli(\operatorname{expit}\{A+X+Z\})\] \[A \sim Bernoulli(\operatorname{expit}\{X+Z\})\] \[Z \sim \mathcal{N}(X,1)\]

m <- lvm(Y ~ A+X+Z, A~X+Z, Z~X)
m <- distribution(m, ~A+Y, binomial.lvm())
d <- sim(m, 1e3, seed=1)
head(d)
#>   Y A          X          Z
#> 1 0 0 -0.6264538  0.5085113
#> 2 1 1  0.1836433  1.2955752
#> 3 0 0 -0.8356286 -1.7064062
#> 4 1 1  1.5952808  1.8060124
#> 5 1 0  0.3295078  0.3989034
#> 6 0 0 -0.8204684 -2.4831172

Estimation

The target parameter, \(E[Y(a)]\) can be estimated with the targeted::ate function:

args(ate)
#> function (formula, data = parent.frame(), weights, offset, family = stats::gaussian(identity), 
#>     nuisance = NULL, propensity = nuisance, all, labels = NULL, 
#>     ...) 
#> NULL

The formula should be specified as formula = response ~ treatment, and the outcome regression specified as nuisance = ~ covariates, and propensity model propensity = ~ covariates. Alternatively, the formula can be specified with the notation formula = response ~ treatment | OR-covariates | propensity-covariates. Parametric models are assumed for both the outcome regression and the propensity model which defaults to be logistic regression models (as in the simulation). A linear model can be used for the outcome regression part by setting binary=FALSE.

To illustrate this, we can estimate the (non-causal) marginal mean of each treatment value

ate(Y ~ A, data=d, nuisance=~1, propensity=~1)
#>     Estimate Std.Err   2.5%  97.5%   P-value
#> A=0   0.2937 0.02029 0.2539 0.3334 1.741e-47
#> A=1   0.8367 0.01660 0.8042 0.8692 0.000e+00

or equivalently

ate(Y ~ A | 1 | 1, data=d)
#>     Estimate Std.Err   2.5%  97.5%   P-value
#> A=0   0.2937 0.02029 0.2539 0.3334 1.741e-47
#> A=1   0.8367 0.01660 0.8042 0.8692 0.000e+00

In this simulation we can compare the estimates to the actual expected potential outcomes which can be approximated by Monte Carlo integration by simulating from the model where we intervene on \(A\) (i.e., break the dependence on \(X, Z\)):

mean(sim(intervention(m, "A", 0), 2e5)$Y)
#> [1] 0.50102
mean(sim(intervention(m, "A", 1), 2e5)$Y)
#> [1] 0.639415

The IPW estimator can then be estimated

ate(Y ~ A | 1 | X+Z, data=d)
#>     Estimate Std.Err   2.5%  97.5%   P-value
#> A=0   0.4793 0.02678 0.4268 0.5318 1.278e-71
#> A=1   0.6669 0.03263 0.6029 0.7308 7.528e-93

Similarly, the OR estimator is obtained by

ate(Y ~ A | A*(X+Z) | 1, data=d)
#>     Estimate Std.Err   2.5%  97.5%    P-value
#> A=0   0.4858 0.02796 0.4310 0.5406  1.243e-67
#> A=1   0.7213 0.02600 0.6703 0.7723 2.248e-169

Both estimates are in this case consistent though we can see that the OR estimate is much more efficient compared to the IPW estimator. However, both of these models rely on correct model specifications.

ate(Y ~ A | 1 | X, data=d)
#>     Estimate Std.Err   2.5%  97.5%   P-value
#> A=0   0.4208 0.02706 0.3678 0.4739 1.543e-54
#> A=1   0.7072 0.03366 0.6412 0.7731 5.204e-98
ate(Y ~ A | A*X | 1, data=d)
#>     Estimate Std.Err   2.5%  97.5%    P-value
#> A=0   0.4240 0.02617 0.3727 0.4752  4.794e-59
#> A=1   0.7474 0.02411 0.7001 0.7946 5.297e-211

In contrast, the doubly-robust AIPW estimator is consistent in the intersection model where either the propensity model or the outcome regression model is correctly specified

a <- ate(Y ~ A | A*X | X+Z, data=d)
summary(a)
#> 
#> Augmented Inverse Probability Weighting estimator
#>   Response Y (Outcome model: gaussian):
#>   Y ~ A * X 
#>   Exposure A (Propensity model: logistic regression):
#>   A ~ X + Z 
#> 
#>                    Estimate Std.Err    2.5%    97.5%    P-value
#>  A=0               0.492322 0.02609  0.4412  0.54346  2.028e-79
#>  A=1               0.663735 0.03068  0.6036  0.72386 8.429e-104
#> Outcome model:                                                 
#>  (Intercept)       0.426675 0.02498  0.3777  0.47563  2.048e-65
#>  A                 0.322545 0.03399  0.2559  0.38916  2.303e-21
#>  X                 0.232605 0.01825  0.1968  0.26837  3.266e-37
#>  A:X              -0.075738 0.02609 -0.1269 -0.02461  3.693e-03
#> Propensity model:                                              
#>  (Intercept)      -0.006421 0.08337 -0.1698  0.15699  9.386e-01
#>  X                -0.863004 0.12123 -1.1006 -0.62539  1.091e-12
#>  Z                -1.005211 0.09080 -1.1832 -0.82725  1.742e-28
#> 
#> Average Treatment Effect (constrast: 'A=1' - 'A=0'):
#> 
#>     Estimate Std.Err    2.5%  97.5%   P-value
#> ATE   0.1714 0.03661 0.09967 0.2432 2.831e-06

From the summary output we also get the estimates of the Average Treatment Effects expressed as a causal relative risk (RR), causal odds ratio (OR), or causal risk difference (RD) including the confidence limits.

From the model object a we can extract the estimated coefficients (expected potential outcomes) and corresponding asympotic variance matrix with the coef and vcov methods. The estimated influence function can extracted with the iid method:

coef(a)
#>       A=0       A=1 
#> 0.4923220 0.6637346
vcov(a)
#>              A=0          A=1
#> A=0 0.0006807275 0.0001409887
#> A=1 0.0001409887 0.0009411920
head(iid(a))
#>             A=0           A=1
#> 1 -0.0012182867 -0.0002821609
#> 2  0.0002438822  0.0002898771
#> 3 -0.0004583641 -0.0002555994
#> 4  0.0003753253  0.0002567340
#> 5  0.0011971267  0.0001267515
#> 6 -0.0004585485 -0.0001710518

Multiple treatments

As an example with multiple treatment levels, we simulate from a new model where the outcome is continuous and the treatment follows a proportional odds model

m <- lvm(y ~ a+x, a~x)
m <- ordinal(m, K=4, ~a)
d <- transform(sim(m, 1e4), a=factor(a))

The AIPW estimator is obtained by estimating a logistic regression model for each treatment level (vs all others) in the propensity model (here a correct model is specified for both the OR and IPW part)

summary(a2 <- ate(y ~ a | a*x | x, data=d, binary=FALSE))
#> 
#> Augmented Inverse Probability Weighting estimator
#>   Response y (Outcome model: gaussian):
#>   y ~ a * x 
#>   Exposure a (Propensity model: logistic regression):
#>   a ~ x 
#> 
#>     Estimate Std.Err    2.5%   97.5%    P-value
#> a=0  -1.5759 0.04515 -1.6644 -1.4874 6.236e-267
#> a=1  -0.7983 0.04009 -0.8769 -0.7197  3.038e-88
#> a=2  -0.4766 0.03434 -0.5439 -0.4093  8.477e-44
#> a=3   0.7130 0.02528  0.6635  0.7625 5.110e-175
#> 
#> Average Treatment Effect (constrast: 'a=1' - 'a=0'):
#> 
#>     Estimate Std.Err   2.5%  97.5%   P-value
#> ATE   0.7775 0.05819 0.6635 0.8916 1.015e-40

Choosing a different contrast for the association measures:

summary(a2, contrast=c(2,4))
#> 
#> Augmented Inverse Probability Weighting estimator
#>   Response y (Outcome model: gaussian):
#>   y ~ a * x 
#>   Exposure a (Propensity model: logistic regression):
#>   a ~ x 
#> 
#>     Estimate Std.Err    2.5%   97.5%    P-value
#> a=0  -1.5759 0.04515 -1.6644 -1.4874 6.236e-267
#> a=1  -0.7983 0.04009 -0.8769 -0.7197  3.038e-88
#> a=2  -0.4766 0.03434 -0.5439 -0.4093  8.477e-44
#> a=3   0.7130 0.02528  0.6635  0.7625 5.110e-175
#> 
#> Average Treatment Effect (constrast: 'a=1' - 'a=3'):
#> 
#>     Estimate Std.Err   2.5%  97.5%    P-value
#> ATE   -1.511 0.04397 -1.597 -1.425 6.379e-259
head(iid(a2))
#>             a=0           a=1           a=2           a=3
#> 1  1.357178e-04  9.998739e-05  9.330374e-05  1.077818e-04
#> 2  1.545104e-04  1.123059e-04  1.049215e-04  4.466851e-06
#> 3  1.448942e-04  1.059891e-04  9.896282e-05 -7.341852e-05
#> 4 -1.864814e-06  1.140371e-05  1.009997e-05  9.922705e-06
#> 5  3.868800e-06  1.517953e-05  1.363176e-05 -3.435807e-04
#> 6 -8.272741e-05 -6.127659e-04 -4.771777e-05 -6.483081e-05
estimate(a2, function(x) x[2]-x[4])
#>     Estimate Std.Err   2.5%  97.5%    P-value
#> a=1   -1.511 0.04397 -1.597 -1.425 6.379e-259

SessionInfo

sessionInfo()
#> R version 4.3.2 (2023-10-31)
#> Platform: x86_64-pc-linux-gnu (64-bit)
#> Running under: Ubuntu 22.04.4 LTS
#> 
#> Matrix products: default
#> BLAS:   /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3 
#> LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.20.so;  LAPACK version 3.10.0
#> 
#> locale:
#>  [1] LC_CTYPE=C.UTF-8       LC_NUMERIC=C           LC_TIME=C.UTF-8       
#>  [4] LC_COLLATE=C.UTF-8     LC_MONETARY=C.UTF-8    LC_MESSAGES=C.UTF-8   
#>  [7] LC_PAPER=C.UTF-8       LC_NAME=C              LC_ADDRESS=C          
#> [10] LC_TELEPHONE=C         LC_MEASUREMENT=C.UTF-8 LC_IDENTIFICATION=C   
#> 
#> time zone: UTC
#> tzcode source: system (glibc)
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#> [1] targeted_0.5 lava_1.7.3  
#> 
#> loaded via a namespace (and not attached):
#>  [1] sass_0.4.8           future_1.33.1        futile.options_1.0.1
#>  [4] stringi_1.8.3        lattice_0.21-9       pracma_2.4.4        
#>  [7] listenv_0.9.1        digest_0.6.34        magrittr_2.0.3      
#> [10] evaluate_0.23        grid_4.3.2           mvtnorm_1.2-4       
#> [13] fastmap_1.1.1        jsonlite_1.8.8       Matrix_1.6-1.1      
#> [16] survival_3.5-7       formatR_1.14         purrr_1.0.2         
#> [19] codetools_0.2-19     numDeriv_2016.8-1.1  textshaping_0.3.7   
#> [22] jquerylib_0.1.4      cli_3.6.2            rlang_1.1.3         
#> [25] futile.logger_1.4.3  mets_1.3.4           parallelly_1.37.0   
#> [28] future.apply_1.11.1  splines_4.3.2        cachem_1.0.8        
#> [31] yaml_2.3.8           tools_4.3.2          parallel_4.3.2      
#> [34] memoise_2.0.1        nloptr_2.0.3         optimx_2023-10.21   
#> [37] lambda.r_1.2.4       globals_0.16.2       vctrs_0.6.5         
#> [40] R6_2.5.1             lifecycle_1.0.4      stringr_1.5.1       
#> [43] fs_1.6.3             ragg_1.2.7           desc_1.4.3          
#> [46] timereg_2.0.5        pkgdown_2.0.7        bslib_0.6.1         
#> [49] glue_1.7.0           data.table_1.15.0    Rcpp_1.0.12         
#> [52] systemfonts_1.0.5    xfun_0.42            knitr_1.45          
#> [55] htmltools_0.5.7      rmarkdown_2.25       compiler_4.3.2