knitr::opts_chunk$set(echo = TRUE)

The DGPs on which Figure 1 in the paper is based upon:

| Title of graph | $X$ | $Y(0)$ | $\tau$ | |----------------------------|----------------------------|-------------|--------| | Y:Linear, ITE:Linear | Linear | Linear | Linear | | Y:Linear, ITE:Sin | Linear | Linear | Sin | | Y:Linear, ITE:Square | Linear | Linear | Square | | Y:Linear, ITE:Square, p=10 | Linear, with 10 covariates | Linear | Square | | Y:Sundin, ITE: Linear | Linear | Sundin | Linear | | Y:Sundin, ITE:Square | Linear | Sundin | Square | | Y:Zaidi Higher, ITE: Athey | Zaidi Higher | Zaidi Lower | Athey | | Y:Zaidi Lower, ITE: Athey | Zaidi Lower | Zaidi Lower | Athey | | Y:Lu, ITE: Lu | Lu | Lu | Lu |

Results per dgp

knitr::include_graphics("./per_dgp_results.pdf")

Results for IHDP data

| Response Surface | ESS of B-EMCMITE (in \%) | |:----------------:|:------------------------:| | $D G P 3$ | 54.8 | | $D G P 2$ | 58.0 | | $D G P 4$ | 61.6 | | $D G P 7$ | 63.7 | | $D G P 1$ | 63.9 | | $D G P 8$ | 64.4 | | $D G P 6$ | 67.5 | | $D G P 5$ | 72.8 | | $D G P 10$ | 74.4 | | $D G P 9$ | 77.2 |

Package implementation of EMCITE algorithm

# Set up python
set.seed(123)
library(emcite)
use_python("/opt/anaconda3/bin/python")
N <- 1000
n1 <- 200
n2 <- 25
td <- dgp(list("N"=N,"p"=4, "covariate"="linear", "y_mean"="linear", "ite"="linear", "real"=F))
s.td <- split_data(td, n1=n1)
m1 <- train_model(s.td[["experimentation"]])
tau.train.preds <- predict_ite(s.td[["experimentation"]], m1)
tau.test.preds  <- predict_ite(s.td[["rollout"]], m1)

thetas <- fit_gradient_descent(X=s.td[["experimentation"]][["X"]],
                               tau_predictions=tau.train.preds$tau, 
                               weight_types = 5)
selections <-
  sapply(c("random", "variance", "type-s", "emcite"), function(x)
    af(
      s.td,
      tau_train = tau.train.preds$tau,
      tau_test = tau.test.preds$tau,
      theta = thetas,
      n2 = n2,
      type = x,
      weight_types = 5,
      parallel = F,R=F
    ), simplify = F, USE.NAMES = T)
# With assignment function "turned on"
results <- sapply(selections,
                  function(x)
                    retrain_and_metrics(
                      sampling_data(
                        s.td,
                        x,
                        active = T,
                        train_predictions = tau.train.preds,
                        test_predictions   = tau.test.preds
                      )
                    ), 
                       simplify = F, USE.NAMES = T)
res <- rbindlist(results)
res[, selection:=names(selections)]
print(res)


Nth-iteration-labs/emcite documentation built on Feb. 6, 2023, 9:07 a.m.