Skip to content

Commit 1978ffd

Browse files
committed
Updated vignettes
1 parent a68e81a commit 1978ffd

File tree

1 file changed

+50
-13
lines changed

1 file changed

+50
-13
lines changed

vignettes/CausalInference.Rmd

Lines changed: 50 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -803,15 +803,20 @@ We draw from a modified "demo 1" DGP
803803

804804
```{r}
805805
mu <- function(x) {1+g(x)+x[,1]*x[,3]-x[,2]+3*x[,3]}
806-
tau <- function(x) {1+0.5*abs(x[,1])-0.25*sin(2*x[,1])}
806+
tau <- function(x) {1+0.5*x[,1]}
807807
n <- 500
808808
snr <- 2
809809
x1 <- rnorm(n)
810810
x2 <- rnorm(n)
811811
x3 <- rnorm(n)
812812
x4 <- as.numeric(rbinom(n,1,0.5))
813813
x5 <- as.numeric(sample(1:3,n,replace=TRUE))
814-
X <- cbind(x1,x2,x3,x4,x5)
814+
x6 <- rnorm(n)
815+
x7 <- rnorm(n)
816+
x8 <- rnorm(n)
817+
x9 <- rnorm(n)
818+
x10 <- rnorm(n)
819+
X <- cbind(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10)
815820
p <- ncol(X)
816821
mu_x <- mu(X)
817822
tau_x <- tau(X)
@@ -852,7 +857,7 @@ Here we simulate from the model with the original MCMC sampler, using all of the
852857
```{r}
853858
num_gfr <- 0
854859
num_burnin <- 1000
855-
num_mcmc <- 1000
860+
num_mcmc <- 100
856861
num_samples <- num_gfr + num_burnin + num_mcmc
857862
bcf_model_mcmc <- bcf(
858863
X_train = X_train, Z_train = Z_train, y_train = y_train, pi_train = pi_train,
@@ -871,6 +876,12 @@ abline(0,1,col="red",lty=3,lwd=3)
871876
plot(rowMeans(bcf_model_mcmc$tau_hat_test), tau_test,
872877
xlab = "predicted", ylab = "actual", main = "Treatment effect")
873878
abline(0,1,col="red",lty=3,lwd=3)
879+
plot(rowMeans(bcf_model_mcmc$y_hat_test), y_test,
880+
xlab = "predicted", ylab = "actual", main = "Outcome")
881+
abline(0,1,col="red",lty=3,lwd=3)
882+
plot(rowMeans(bcf_model_mcmc$y_hat_test-bcf_model_mcmc$mu_hat_test), tau_test*Z_test,
883+
xlab = "predicted", ylab = "actual", main = "Treatment effect term")
884+
abline(0,1,col="red",lty=3,lwd=3)
874885
sigma_observed <- var(y-E_XZ)
875886
plot_bounds <- c(min(c(bcf_model_mcmc$sigma2_samples, sigma_observed)),
876887
max(c(bcf_model_mcmc$sigma2_samples, sigma_observed)))
@@ -894,8 +905,10 @@ mean(cover)
894905
And test set RMSE
895906

896907
```{r}
897-
test_mean <- rowMeans(bcf_model_mcmc$tau_hat_test)
898-
sqrt(mean((test_mean - tau_test)^2))
908+
test_tau_mean <- rowMeans(bcf_model_mcmc$tau_hat_test)
909+
sqrt(mean((test_tau_mean - tau_test)^2))
910+
test_outcome_mean <- rowMeans(bcf_model_mcmc$y_hat_test)
911+
sqrt(mean((test_outcome_mean - y_test)^2))
899912
```
900913

901914
#### MCMC, covariate subset in $\tau(X)$
@@ -905,7 +918,7 @@ Here we simulate from the model with the original MCMC sampler, using only covar
905918
```{r}
906919
num_gfr <- 0
907920
num_burnin <- 1000
908-
num_mcmc <- 1000
921+
num_mcmc <- 100
909922
num_samples <- num_gfr + num_burnin + num_mcmc
910923
bcf_model_mcmc <- bcf(
911924
X_train = X_train, Z_train = Z_train, y_train = y_train, pi_train = pi_train,
@@ -925,6 +938,12 @@ abline(0,1,col="red",lty=3,lwd=3)
925938
plot(rowMeans(bcf_model_mcmc$tau_hat_test), tau_test,
926939
xlab = "predicted", ylab = "actual", main = "Treatment effect")
927940
abline(0,1,col="red",lty=3,lwd=3)
941+
plot(rowMeans(bcf_model_mcmc$y_hat_test), y_test,
942+
xlab = "predicted", ylab = "actual", main = "Outcome")
943+
abline(0,1,col="red",lty=3,lwd=3)
944+
plot(rowMeans(bcf_model_mcmc$y_hat_test-bcf_model_mcmc$mu_hat_test), tau_test*Z_test,
945+
xlab = "predicted", ylab = "actual", main = "Treatment effect term")
946+
abline(0,1,col="red",lty=3,lwd=3)
928947
sigma_observed <- var(y-E_XZ)
929948
plot_bounds <- c(min(c(bcf_model_mcmc$sigma2_samples, sigma_observed)),
930949
max(c(bcf_model_mcmc$sigma2_samples, sigma_observed)))
@@ -950,6 +969,8 @@ And test set RMSE
950969
```{r}
951970
test_mean <- rowMeans(bcf_model_mcmc$tau_hat_test)
952971
sqrt(mean((test_mean - tau_test)^2))
972+
test_outcome_mean <- rowMeans(bcf_model_mcmc$y_hat_test)
973+
sqrt(mean((test_outcome_mean - y_test)^2))
953974
```
954975

955976
#### Warmstart, full covariate set in $\tau(X)$
@@ -959,7 +980,7 @@ Here we simulate from the model with the warm-start sampler, using all of the co
959980
```{r}
960981
num_gfr <- 10
961982
num_burnin <- 0
962-
num_mcmc <- 1000
983+
num_mcmc <- 100
963984
num_samples <- num_gfr + num_burnin + num_mcmc
964985
bcf_model_warmstart <- bcf(
965986
X_train = X_train, Z_train = Z_train, y_train = y_train, pi_train = pi_train,
@@ -978,6 +999,12 @@ abline(0,1,col="red",lty=3,lwd=3)
978999
plot(rowMeans(bcf_model_warmstart$tau_hat_test), tau_test,
9791000
xlab = "predicted", ylab = "actual", main = "Treatment effect")
9801001
abline(0,1,col="red",lty=3,lwd=3)
1002+
plot(rowMeans(bcf_model_warmstart$y_hat_test), y_test,
1003+
xlab = "predicted", ylab = "actual", main = "Outcome")
1004+
abline(0,1,col="red",lty=3,lwd=3)
1005+
plot(rowMeans(bcf_model_warmstart$y_hat_test - bcf_model_warmstart$mu_hat_test), tau_test*Z_test,
1006+
xlab = "predicted", ylab = "actual", main = "Treatment effect term")
1007+
abline(0,1,col="red",lty=3,lwd=3)
9811008
sigma_observed <- var(y-E_XZ)
9821009
plot_bounds <- c(min(c(bcf_model_warmstart$sigma2_samples, sigma_observed)),
9831010
max(c(bcf_model_warmstart$sigma2_samples, sigma_observed)))
@@ -1001,8 +1028,10 @@ mean(cover)
10011028
And test set RMSE
10021029

10031030
```{r}
1004-
test_mean <- apply(bcf_model_warmstart$tau_hat_test, 1, mean)
1005-
sqrt(mean((tau_x[test_inds] - test_mean)^2))
1031+
test_tau_mean <- rowMeans(bcf_model_warmstart$tau_hat_test)
1032+
sqrt(mean((tau_test - test_tau_mean)^2))
1033+
test_outcome_mean <- rowMeans(bcf_model_warmstart$y_hat_test)
1034+
sqrt(mean((y_test - test_outcome_mean)^2))
10061035
```
10071036

10081037
#### Warmstart, covariate subset in $\tau(X)$
@@ -1012,14 +1041,14 @@ Here we simulate from the model with the warm-start sampler, using only covariat
10121041
```{r}
10131042
num_gfr <- 10
10141043
num_burnin <- 0
1015-
num_mcmc <- 1000
1044+
num_mcmc <- 100
10161045
num_samples <- num_gfr + num_burnin + num_mcmc
10171046
bcf_model_warmstart <- bcf(
10181047
X_train = X_train, Z_train = Z_train, y_train = y_train, pi_train = pi_train,
10191048
X_test = X_test, Z_test = Z_test, pi_test = pi_test,
10201049
num_gfr = num_gfr, num_burnin = num_burnin, num_mcmc = num_mcmc,
10211050
sample_sigma_leaf_mu = F, sample_sigma_leaf_tau = F,
1022-
keep_vars_tau = c("x1")
1051+
keep_vars_tau = c("x1"), random_seed = 2
10231052
)
10241053
```
10251054

@@ -1032,6 +1061,12 @@ abline(0,1,col="red",lty=3,lwd=3)
10321061
plot(rowMeans(bcf_model_warmstart$tau_hat_test), tau_test,
10331062
xlab = "predicted", ylab = "actual", main = "Treatment effect")
10341063
abline(0,1,col="red",lty=3,lwd=3)
1064+
plot(rowMeans(bcf_model_warmstart$y_hat_test), y_test,
1065+
xlab = "predicted", ylab = "actual", main = "Outcome")
1066+
abline(0,1,col="red",lty=3,lwd=3)
1067+
plot(rowMeans(bcf_model_warmstart$y_hat_test-bcf_model_warmstart$mu_hat_test), tau_test*Z_test,
1068+
xlab = "predicted", ylab = "actual", main = "Treatment effect term")
1069+
abline(0,1,col="red",lty=3,lwd=3)
10351070
sigma_observed <- var(y-E_XZ)
10361071
plot_bounds <- c(min(c(bcf_model_warmstart$sigma2_samples, sigma_observed)),
10371072
max(c(bcf_model_warmstart$sigma2_samples, sigma_observed)))
@@ -1055,8 +1090,10 @@ mean(cover)
10551090
And test set RMSE
10561091

10571092
```{r}
1058-
test_mean <- apply(bcf_model_warmstart$tau_hat_test, 1, mean)
1059-
sqrt(mean((tau_x[test_inds] - test_mean)^2))
1093+
test_tau_mean <- rowMeans(bcf_model_warmstart$tau_hat_test)
1094+
sqrt(mean((tau_test - test_tau_mean)^2))
1095+
test_outcome_mean <- rowMeans(bcf_model_warmstart$y_hat_test)
1096+
sqrt(mean((y_test - test_outcome_mean)^2))
10601097
```
10611098

10621099
# Continuous Treatment

0 commit comments

Comments
 (0)